diff --git a/DESIGN.md b/DESIGN.md index 70c9a8c..df0f948 100644 --- a/DESIGN.md +++ b/DESIGN.md @@ -22,7 +22,7 @@ node tree -> pure TP surface plan ``` -The owners are `ebox-tree.el` for Ebox identity and traversal, `ebox-style.el` for style semantics, `ebox-measure.el` for display-sensitive measurement, `ebox-layout.el`/`ebox-flex.el`/`ebox-grid.el` for geometry, `ebox-fragment.el` for fragment facts, `ebox-surface.el` for pure TP plan projection and retained publication, and `ebox-incremental.el` for dirty-owner planning. `ebox-buffer-backend.el` only builds and reshapes propertized render strings; all public live buffer publication routes through the TP surface boundary. +The owners are `ebox-child-range.el` for immutable child-sequence and key indexes, `ebox-tree.el` for Ebox identity and traversal, `ebox-style.el` for style semantics, `ebox-measure.el` for display-sensitive measurement, `ebox-layout.el`/`ebox-flex.el`/`ebox-grid.el` for geometry, `ebox-fragment.el` for fragment facts, `ebox-surface.el` for pure TP plan projection and retained publication, and `ebox-incremental.el` for dirty-owner planning. `ebox-buffer-backend.el` only builds and reshapes propertized render strings; all public live buffer publication routes through the TP surface boundary. ## Public boundary diff --git a/DESIGN.zh.md b/DESIGN.zh.md index cdf8e21..d959a4e 100644 --- a/DESIGN.zh.md +++ b/DESIGN.zh.md @@ -22,7 +22,7 @@ Ebox 是底层空间渲染引擎。它负责把声明式节点树转换为经过 -> 纯 TP surface plan ``` -各层 owner 是：`ebox-tree.el` 负责 Ebox identity 与遍历，`ebox-style.el` 负责样式语义，`ebox-measure.el` 负责 display 敏感测量，`ebox-layout.el`、`ebox-flex.el`、`ebox-grid.el` 负责几何，`ebox-fragment.el` 负责 fragment 事实，`ebox-surface.el` 负责纯 TP plan 投影与 retained 发布，`ebox-incremental.el` 负责 dirty owner 规划。`ebox-buffer-backend.el` 只构造和整形带文本属性的 render string；所有公共 live buffer 发布路径都经过 TP surface 边界。 +各层 owner 是：`ebox-child-range.el` 负责不可变 child sequence 与 key index，`ebox-tree.el` 负责 Ebox identity 与遍历，`ebox-style.el` 负责样式语义，`ebox-measure.el` 负责 display 敏感测量，`ebox-layout.el`、`ebox-flex.el`、`ebox-grid.el` 负责几何，`ebox-fragment.el` 负责 fragment 事实，`ebox-surface.el` 负责纯 TP plan 投影与 retained 发布，`ebox-incremental.el` 负责 dirty owner 规划。`ebox-buffer-backend.el` 只构造和整形带文本属性的 render string；所有公共 live buffer 发布路径都经过 TP surface 边界。 ## 公共边界 diff --git a/Makefile b/Makefile index 4051362..6bc7f55 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ EMACS ?= emacs CARGO ?= cargo TP_DIR ?= ../tp -ECSS_DIR ?= ../new-architecture/ecss +ECSS_DIR ?= ../ecss LOAD_EXTRA ?= EMACS_BATCH = $(EMACS) -Q --batch -L . -L $(ECSS_DIR) -L $(TP_DIR) $(LOAD_EXTRA) --eval '(setq load-prefer-newer t)' @@ -9,7 +9,7 @@ NATIVE_MANIFEST = native/Cargo.toml NATIVE_TARGET ?= $(shell $(EMACS_BATCH) -l ebox-native-reflow.el --eval '(princ (ebox-native-reflow--rust-target))') NATIVE_RELEASE_DIR = native/target/$(NATIVE_TARGET)/release -.PHONY: all check ci load compile test checkdoc core-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests docs-contract-tests ci-contract-tests performance-evaluator visual-check native-rust-tests native-build diff-check clean package-lint package-lint-install +.PHONY: all check ci load compile test checkdoc core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests docs-contract-tests ci-contract-tests performance-evaluator visual-check native-rust-tests native-build diff-check clean package-lint package-lint-install all: check @@ -24,11 +24,14 @@ compile: rm -f *.elc tests/*.elc scripts/*.elc $(EMACS_BATCH) --eval '(setq byte-compile-error-on-warn t)' -l ebox.el --eval '(ebox-byte-compile)' -test: core-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests docs-contract-tests ci-contract-tests +test: core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests docs-contract-tests ci-contract-tests core-tests: $(EMACS_BATCH) -l tests/ebox-core-render-tests.el -f ert-run-tests-batch-and-exit +child-range-tests: + $(EMACS_BATCH) -l tests/ebox-child-range-tests.el -f ert-run-tests-batch-and-exit + grid-tests: $(EMACS_BATCH) -l tests/ebox-grid-tests.el -f ert-run-tests-batch-and-exit diff --git a/README.md b/README.md index 6a2863c..48f48c1 100644 --- a/README.md +++ b/README.md @@ -24,6 +24,8 @@ ECSS and TP are independent packages and may be installed in either order. Insta The public model is a tree of Ebox nodes. `ebox-create` builds a leaf or wrapper node; `ebox-column`, `ebox-row`, `ebox-flex`, and `ebox-grid` compose nodes; `ebox-render` materializes propertized text without publishing buffer state (using isolated pure materialization when no cascade/inheritance dependency requires a TP object tree); `ebox-render-to-buffer` mounts a retained TP surface; `ebox-display-buffer` displays that same retained-surface path; and `ebox-commit` atomically updates the mount from a fresh root tree. Ebox copies declarative input before assigning runtime identity, so one source tree may be mounted in multiple buffers without transferring ownership. It exposes no separate public macro that erases a live buffer and evaluates arbitrary body forms. +Material child lists may contain `ebox-child-range` descriptors, and logical candidates update their base-bound addresses with `ebox-candidate-replace-range-ref`. Candidates may also replace the private mounted root with `ebox-candidate-replace-root`; the last root replacement absorbs descendant operations and never shares an address with `:host-ref`. Reports expose `:range-metrics`, framework participant diagnostics, and scroll finalization diagnostics as read-only snapshots. + CSS-like selector strings are compiled to ECSS's structured selector AST. Ebox supplies logical node relations and indexed candidates; ECSS is the only selector matcher and cascade engine for tree queries, rendered-buffer queries, and style rules. ## What belongs here @@ -41,7 +43,7 @@ ETAF belongs in the sibling package. Install it separately when you need the uni | Path | Responsibility | | --- | --- | | `ebox.el` | Public facade and package entry point. | -| `ebox-cache.el`, `ebox-style.el`, `ebox-tree.el`, `ebox-measure.el` | Cache, style, tree, and measurement models. | +| `ebox-cache.el`, `ebox-style.el`, `ebox-tree.el`, `ebox-child-range.el`, `ebox-measure.el` | Cache, style, tree, persistent child-sequence, and measurement models. | | `ebox-fragment.el`, `ebox-render-context.el` | Layout facts and render-local context. | | `ebox-layout.el`, `ebox-flex.el`, `ebox-grid.el` | Formatting contexts and layout algorithms. | | `ebox-surface.el` | Ebox candidate projection plus TP surface mount/update and atomic Ebox runtime-state participation. | diff --git a/README.zh-CN.md b/README.zh-CN.md index 77a118a..ae50376 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -24,6 +24,8 @@ ECSS 与 TP 是互相独立的包，安装顺序任意。两者都安装后再 公共模型是一棵 Ebox 节点树。`ebox-create` 构造叶子或包装节点；`ebox-column`、`ebox-row`、`ebox-flex` 和 `ebox-grid` 组合节点；`ebox-render` 生成带属性文本但不发布 buffer state（没有 cascade/inheritance 依赖时使用隔离的 pure materialization）；`ebox-render-to-buffer` 挂载 retained TP surface；`ebox-display-buffer` 展示同一条 retained-surface 路径；`ebox-commit` 使用新的根树原子更新该 mount。Ebox 会在分配 runtime identity 前复制声明式输入，因此同一 source tree 可以挂载到多个 buffer，而不转移所有权。公共 API 不再提供另一套擦除 live buffer 后执行任意 BODY 的宏。 +Material child list 可包含 `ebox-child-range` descriptor，logical candidate 用 `ebox-candidate-replace-range-ref` 更新其 base-bound 地址。Candidate 也可用 `ebox-candidate-replace-root` 替换私有 mounted root；最后一次 root replacement 会吸收 descendant operation，并且不会与 `:host-ref` 共用地址。报告通过 `:range-metrics`、framework participant diagnostics 和 scroll finalization diagnostics 暴露只读快照。 + CSS-like selector 字符串会编译为 ECSS 的 structured selector AST。Ebox 提供逻辑节点关系与索引候选；对于 tree query、rendered-buffer query 和样式规则，ECSS 是唯一 selector matcher 与 cascade engine。 ## 本包负责什么 @@ -41,7 +43,7 @@ ETAF 属于同级独立包。当你需要统一 View 语法、Component、响应 | 路径 | 职责 | | --- | --- | | `ebox.el` | 公共门面与包入口。 | -| `ebox-cache.el`、`ebox-style.el`、`ebox-tree.el`、`ebox-measure.el` | 缓存、样式、树和测量模型。 | +| `ebox-cache.el`、`ebox-style.el`、`ebox-tree.el`、`ebox-child-range.el`、`ebox-measure.el` | 缓存、样式、树、持久 child sequence 和测量模型。 | | `ebox-fragment.el`、`ebox-render-context.el` | 布局事实与 render-local context。 | | `ebox-layout.el`、`ebox-flex.el`、`ebox-grid.el` | Formatting Context 与布局算法。 | | `ebox-surface.el` | 将 Ebox runtime/layout 投影为 TP surface plan，并负责 retained mount/update 与原子 runtime-state 参与。 | diff --git a/docs/maintainer/ebox-current-implementation-reference.en.md b/docs/maintainer/ebox-current-implementation-reference.en.md index 8144cfa..ba573da 100644 --- a/docs/maintainer/ebox-current-implementation-reference.en.md +++ b/docs/maintainer/ebox-current-implementation-reference.en.md @@ -1,6 +1,6 @@ # Ebox current implementation reference -This is the maintainer entry point for the standalone Ebox repository. It describes the package boundary, active files, runtime model, invariants, and verification commands. The historical `emacs-box` checkout is a separate legacy source tree; it is not a dependency of this package. ETAF is the sibling higher-level package. +This is the maintainer entry point for the standalone Ebox repository. It describes the package boundary, active files, runtime model, invariants, and verification commands. The historical Ebox checkout is a separate legacy source tree; it is not a dependency of this package. ETAF is the sibling higher-level package. ## Reading order @@ -20,6 +20,7 @@ This is the maintainer entry point for the standalone Ebox repository. It descri | `ebox-cache.el` | Measurement/render cache records, invalidation, and cache reports. | | `ebox-style.el` | ECSS property schemas, declarations and cascade, shorthand expansion, computed style, colors, borders, and dirty effects. | | `ebox-tree.el` | Node traversal, logical child access, ECSS subject adaptation, identity, parent paths, keys, and tree snapshots. | +| `ebox-child-range.el` | Immutable weighted segment trie, sparse persistent key trie, Range replacement, and Gate A metrics. | | `ebox-measure.el` | Display-sensitive character/face/pixel measurement and measurement caches. | | `ebox-fragment.el` | Layout fragments, signatures, snapshots, spans, and dirty-kind facts. | | `ebox-render-context.el` | Render-local context and publication inputs. | @@ -35,7 +36,7 @@ This is the maintainer entry point for the standalone Ebox repository. It descri The package intentionally does not include application Components, UI controls, reactive data, or a playground implementation. Those are sibling-package responsibilities. -The active contract also covers `Makefile`, `.github/workflows/ci.yml`, `tests/ebox-core-render-tests.el`, `tests/ebox-grid-tests.el`, `tests/ebox-commit-tests.el`, `tests/ebox-surface-tests.el`, `tests/ebox-dsl-tests.el`, `tests/ebox-flex-tests.el`, `tests/ebox-selector-tests.el`, `tests/ebox-package-tests.el`, `tests/ebox-visual-check-tests.el`, `tests/ebox-docs-contract-tests.el`, `tests/ebox-ci-contract-tests.el`, `native/Cargo.toml`, `native/Cargo.lock`, `native/build.rs`, `native/vendor/emacs-30/emacs-module.h`, `native/src/lib.rs`, `native/src/layout.rs`, `native/c/ebox_module.c`, `scripts/ebox-package-lint.el`, `scripts/ebox-visual-check.el`, and `scripts/ebox-performance-evaluator.el`. +The active contract also covers `Makefile`, `.github/workflows/ci.yml`, `tests/ebox-core-render-tests.el`, `tests/ebox-child-range-tests.el`, `tests/ebox-grid-tests.el`, `tests/ebox-commit-tests.el`, `tests/ebox-surface-tests.el`, `tests/ebox-dsl-tests.el`, `tests/ebox-flex-tests.el`, `tests/ebox-selector-tests.el`, `tests/ebox-package-tests.el`, `tests/ebox-visual-check-tests.el`, `tests/ebox-docs-contract-tests.el`, `tests/ebox-ci-contract-tests.el`, `native/Cargo.toml`, `native/Cargo.lock`, `native/build.rs`, `native/vendor/emacs-30/emacs-module.h`, `native/src/lib.rs`, `native/src/layout.rs`, `native/c/ebox_module.c`, `scripts/ebox-package-lint.el`, `scripts/ebox-visual-check.el`, and `scripts/ebox-performance-evaluator.el`. ## Runtime model @@ -58,7 +59,7 @@ Caller-owned Source Tree | Model | Owner | Must not own | | --- | --- | --- | -| Source/Element Tree | `ebox-tree.el`, `ebox-dsl.el` | Published buffer mutation. | +| Source/Element Tree | `ebox-child-range.el`, `ebox-tree.el`, `ebox-dsl.el` | Published buffer mutation. | | Computed Style | `ebox-style.el` | Layout identity or patch execution. | | Measurement | `ebox-measure.el` | Application state or dirty policy. | | Formatting Context | `ebox-layout.el`, `ebox-flex.el`, `ebox-grid.el` | Buffer edits. | @@ -100,6 +101,7 @@ make load make compile make check make core-tests +make child-range-tests make grid-tests make ebox-commit-tests make surface-tests diff --git a/docs/maintainer/ebox-current-implementation-reference.zh.md b/docs/maintainer/ebox-current-implementation-reference.zh.md index 9a29e2c..d01f8d3 100644 --- a/docs/maintainer/ebox-current-implementation-reference.zh.md +++ b/docs/maintainer/ebox-current-implementation-reference.zh.md @@ -1,6 +1,6 @@ # Ebox 当前实现参考 -本文是独立 Ebox 仓库的维护者入口，描述包边界、active 文件、运行时模型、不变量和验证命令。历史 `emacs-box` 是另一个旧架构源码树，不是本包依赖。ETAF 是同级高层包。 +本文是独立 Ebox 仓库的维护者入口，描述包边界、active 文件、运行时模型、不变量和验证命令。历史 Ebox checkout 是另一个旧架构源码树，不是本包依赖。ETAF 是同级高层包。 ## 阅读顺序 @@ -20,6 +20,7 @@ | `ebox-cache.el` | 测量/渲染缓存记录、失效和缓存报告。 | | `ebox-style.el` | ECSS property schema、declaration 与 cascade、shorthand 展开、computed style、颜色、border 和 dirty effect。 | | `ebox-tree.el` | 节点遍历、逻辑子节点访问、ECSS subject 适配、identity、父路径、key 和树 snapshot。 | +| `ebox-child-range.el` | 不可变 weighted segment trie、稀疏持久 key trie、Range replacement 与 Gate A metrics。 | | `ebox-measure.el` | display 敏感的字符、face、像素测量与测量缓存。 | | `ebox-fragment.el` | 布局 fragment、signature、snapshot、span 和 dirty kind 事实。 | | `ebox-render-context.el` | render-local context 与发布输入。 | @@ -35,7 +36,7 @@ 本包有意不包含应用 Component、UI control、响应式 data 或 playground 实现；它们属于同级包。历史应用性能记录器和 native reflow 评估器也不属于独立 Ebox 的发布边界；Ebox 只保留 native 模块本身、Rust 构建输入和可重复的构建检查。 -active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-core-render-tests.el`、`tests/ebox-grid-tests.el`、`tests/ebox-commit-tests.el`、`tests/ebox-surface-tests.el`、`tests/ebox-dsl-tests.el`、`tests/ebox-flex-tests.el`、`tests/ebox-selector-tests.el`、`tests/ebox-package-tests.el`、`tests/ebox-visual-check-tests.el`、`tests/ebox-docs-contract-tests.el`、`tests/ebox-ci-contract-tests.el`、`native/Cargo.toml`、`native/Cargo.lock`、`native/build.rs`、`native/vendor/emacs-30/emacs-module.h`、`native/src/lib.rs`、`native/src/layout.rs`、`native/c/ebox_module.c`、`scripts/ebox-package-lint.el`、`scripts/ebox-visual-check.el` 和 `scripts/ebox-performance-evaluator.el`。 +active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-core-render-tests.el`、`tests/ebox-child-range-tests.el`、`tests/ebox-grid-tests.el`、`tests/ebox-commit-tests.el`、`tests/ebox-surface-tests.el`、`tests/ebox-dsl-tests.el`、`tests/ebox-flex-tests.el`、`tests/ebox-selector-tests.el`、`tests/ebox-package-tests.el`、`tests/ebox-visual-check-tests.el`、`tests/ebox-docs-contract-tests.el`、`tests/ebox-ci-contract-tests.el`、`native/Cargo.toml`、`native/Cargo.lock`、`native/build.rs`、`native/vendor/emacs-30/emacs-module.h`、`native/src/lib.rs`、`native/src/layout.rs`、`native/c/ebox_module.c`、`scripts/ebox-package-lint.el`、`scripts/ebox-visual-check.el` 和 `scripts/ebox-performance-evaluator.el`。 ## 运行时模型 @@ -58,7 +59,7 @@ active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-cor | 模型 | Owner | 不得拥有 | | --- | --- | --- | -| Source/Element Tree | `ebox-tree.el`、`ebox-dsl.el` | 已发布 buffer 的变更。 | +| Source/Element Tree | `ebox-child-range.el`、`ebox-tree.el`、`ebox-dsl.el` | 已发布 buffer 的变更。 | | Computed Style | `ebox-style.el` | 布局 identity 或 patch 执行。 | | Measurement | `ebox-measure.el` | 应用状态或 dirty 策略。 | | Formatting Context | `ebox-layout.el`、`ebox-flex.el`、`ebox-grid.el` | Buffer 编辑。 | @@ -98,6 +99,7 @@ active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-cor ```sh make check make core-tests +make child-range-tests make grid-tests make ebox-commit-tests make surface-tests diff --git a/docs/maintainer/ebox-incremental-update-contract.en.md b/docs/maintainer/ebox-incremental-update-contract.en.md index 0e9aac5..740a2d1 100644 --- a/docs/maintainer/ebox-incremental-update-contract.en.md +++ b/docs/maintainer/ebox-incremental-update-contract.en.md @@ -43,6 +43,20 @@ When selected, the candidate keeps the published Ebox topology and reuses the re If any proof condition fails, the update uses the ordinary safe projection path. That fallback may do broader node projection and TP reconciliation, but it preserves the same output, identity, publication, and rollback contract. Tests in `tests/ebox-surface-tests.el` cover the retained width/height/both-axis path, each unsafe fallback trigger, and publication failure after candidate preparation. +## Retained scroll window + +For a chrome-free root scroll owner whose cached rendered lines cover the +current visible window (the lazy prefix may remain incomplete), +the scroll patch joins the staged visible window directly instead of entering +the full candidate layout. It reuses the published cascade, viewport axes, +object maps, and descendant `region-box-table`; it only advances the scroll +offset and installs the root `ebox-scroll-window` property. The proof is +conservative: a cache miss, chrome, active style dependency, topology change, +or incomplete window falls back to the ordinary retained path. Scroll +publication still goes through TP and the Ebox participant, so a failure after +TP client-state publication restores text, offsets, indexes, objects, mounts, +and report together. + ## Identity and coordinates Keys are local to a sibling collection. Declarative source trees never own live TP objects, markers, or buffer coordinates. A live logical `:id` resolves through `ebox-region-resolve` to an opaque handle tied to one TP surface object; mounting the same source in two buffers therefore yields distinct handles. Region and host-ref positions are generation-bound; after a buffer mutation, callers must obtain fresh positions from the public accessor. Buffer markers, display spans, and text properties are publication facts, not source-tree identity. diff --git a/docs/maintainer/ebox-incremental-update-contract.zh.md b/docs/maintainer/ebox-incremental-update-contract.zh.md index 0cac0fa..6fd06ef 100644 --- a/docs/maintainer/ebox-incremental-update-contract.zh.md +++ b/docs/maintainer/ebox-incremental-update-contract.zh.md @@ -43,6 +43,17 @@ 任意 proof 条件失败时，更新必须使用普通安全 projection 路径。该 fallback 可以执行更宽的 node projection 和 TP reconciliation，但必须保持相同的输出、identity、publication 和 rollback 合同。`tests/ebox-surface-tests.el` 覆盖 retained width/height/both-axis 路径、每个不安全 fallback 触发条件，以及 candidate preparation 之后的 publication failure。 +## 保留式 scroll window + +对于 chrome-free、缓存 rendered lines 已覆盖当前可见窗口的 root scroll owner +（lazy prefix 可以仍未完整 materialize），scroll patch 会 +直接从 staged visible window 拼接输出，不再进入完整 candidate layout。它复用已 +发布的 cascade、viewport axes、object maps 和 descendant `region-box-table`，只推进 +scroll offset 并安装 root `ebox-scroll-window` 属性。证明保持保守：cache miss、 +chrome、active style dependency、topology 变化或窗口不完整时，回退到普通 retained +路径。Scroll publication 仍经过 TP 与 Ebox participant；即使 TP client-state 发布 +之后失败，也会一起恢复文本、offset、index、object、mount 和 report。 + ## Identity 与坐标 Key 只在同级兄弟集合内有效。声明式 source tree 不拥有 live TP object、marker 或 buffer 坐标。live 逻辑 `:id` 通过 `ebox-region-resolve` 解析为绑定某个 TP surface object 的不透明 handle；同一 source 挂载到两个 buffer 时会得到不同 handle。Region 与 host-ref 位置绑定于 generation；buffer 变更后调用者必须通过公共 accessor 重新获得位置。Buffer marker、display span 和 text property 是发布事实，不是 source tree identity。 diff --git a/docs/maintainer/ebox-performance-architecture-analysis.en.md b/docs/maintainer/ebox-performance-architecture-analysis.en.md index b1e4c49..3dfcb1c 100644 --- a/docs/maintainer/ebox-performance-architecture-analysis.en.md +++ b/docs/maintainer/ebox-performance-architecture-analysis.en.md @@ -1,6 +1,6 @@ # Ebox Performance Architecture Diagnosis and Redesign Direction -> Status: Architecture diagnosis and implementation checkpoint. This document records the performance gap between the current refactored `ebox` and the historical `emacs-box`, the evidence boundary, and the high-level redesign direction. Five narrow slices are implemented; the retained mounted-update architecture is not yet considered generally repaired. +> Status: Architecture diagnosis and implementation checkpoint. This document records the performance gap between the current refactored `ebox` and the historical Ebox checkout, the evidence boundary, and the high-level redesign direction. Five narrow slices are implemented; the retained mounted-update architecture is not yet considered generally repaired. > > Date: 2026-08-07 > @@ -8,7 +8,7 @@ ## Question -Why does the current refactored Ebox fail to match the performance of the pre-refactor `emacs-box` during dynamic content updates, viewport resize, and pure `ebox-render`? The data-flow and ownership causes must be established before optimizing individual functions. +Why does the current refactored Ebox fail to match the performance of the pre-refactor historical Ebox checkout during dynamic content updates, viewport resize, and pure `ebox-render`? The data-flow and ownership causes must be established before optimizing individual functions. ## Conclusion @@ -21,7 +21,7 @@ The key distinction is that current’s “local patch” describes publication ## Scope and terminology - “current” means the standalone refactored `ebox` repository. -- “legacy” means the sibling historical `emacs-box` source tree. +- “legacy” means the sibling historical Ebox checkout. - “pure materialization” means producing a propertized render string from a source tree without a live buffer, stable retained identity, or rollback requirement. - “retained publication” means publishing a candidate to a mounted TP surface with stable identity, ownership, scope proof, revision, and rollback semantics. - Absolute timings come from one local measurement environment. The architecture conclusion relies on stage proportions, call counts, and identical outputs rather than on one absolute threshold. @@ -208,9 +208,9 @@ The current retained data flow crosses these boundaries: The corresponding legacy path is closer to “computation scope equals modification scope”: -- `emacs-box/ebox.el:7195` directly modifies the target region box and enters the local dirty/patch path. -- `emacs-box/ebox.el:7399` formats only the target content before applying the local patch. -- `emacs-box/ebox.el:7578` directly renders, inserts, and refreshes markers/spans. +- The historical checkout's `ebox.el:7195` directly modifies the target region box and enters the local dirty/patch path. +- The historical checkout's `ebox.el:7399` formats only the target content before applying the local patch. +- The historical checkout's `ebox.el:7578` directly renders, inserts, and refreshes markers/spans. - Legacy `ebox-style.el` mainly expands local properties and classifies dirty work; it has no equivalent current ECSS stylesheet/reactive per-node cascade. ## Evidence versus inference diff --git a/docs/maintainer/ebox-performance-architecture-analysis.zh.md b/docs/maintainer/ebox-performance-architecture-analysis.zh.md index 4a2fe2d..1ee015c 100644 --- a/docs/maintainer/ebox-performance-architecture-analysis.zh.md +++ b/docs/maintainer/ebox-performance-architecture-analysis.zh.md @@ -1,6 +1,6 @@ # Ebox 性能架构诊断与重构方向 -> 状态：架构诊断与实现 checkpoint。本文记录 current refactored Ebox 相比历史 `emacs-box` 的性能差异、证据边界和高层重构方向。五个范围很窄的 slice 已经实现；mounted retained-update 架构尚不能认为已经普遍修复。 +> 状态：架构诊断与实现 checkpoint。本文记录 current refactored Ebox 相比历史 Ebox checkout 的性能差异、证据边界和高层重构方向。五个范围很窄的 slice 已经实现；mounted retained-update 架构尚不能认为已经普遍修复。 > > 日期：2026-08-07 > @@ -8,7 +8,7 @@ ## 问题 -为什么 current refactored Ebox 在动态内容更新、viewport resize 和纯 `ebox-render` 场景下，性能达不到重构前的 `emacs-box`？需要先确定数据流和 ownership 层面的主因，而不是继续优化某个具体函数。 +为什么 current refactored Ebox 在动态内容更新、viewport resize 和纯 `ebox-render` 场景下，性能达不到历史 Ebox checkout？需要先确定数据流和 ownership 层面的主因，而不是继续优化某个具体函数。 ## 结论 @@ -21,7 +21,7 @@ ## 比较范围与术语 - “current”指独立重构版 `ebox` 仓库。 -- “legacy”指同级历史 `emacs-box` 源码树。 +- “legacy”指同级历史 Ebox checkout。 - “pure materialization”指从 source tree 产生带文本属性的渲染字符串，不需要 live buffer、稳定 retained identity 或 rollback。 - “retained publication”指向已挂载 TP surface 发布候选状态，包含稳定 identity、ownership、scope proof、revision 和 rollback 语义。 - 文中的绝对耗时来自同一个本地测量环境；架构判断依赖阶段占比、调用次数和相同输出结果，不依赖某一个绝对时间阈值。 @@ -208,9 +208,9 @@ current 的 retained 数据流由以下边界组成： legacy 的对应路径更接近“计算范围等于修改范围”： -- `emacs-box/ebox.el:7195` 直接修改目标 region box，并进入局部 dirty/patch 路径。 -- `emacs-box/ebox.el:7399` 只格式化目标内容后执行局部 patch。 -- `emacs-box/ebox.el:7578` 直接 render、insert 并刷新 marker/span。 +- 历史 checkout 的 `ebox.el:7195` 直接修改目标 region box，并进入局部 dirty/patch 路径。 +- 历史 checkout 的 `ebox.el:7399` 只格式化目标内容后执行局部 patch。 +- 历史 checkout 的 `ebox.el:7578` 直接 render、insert 并刷新 marker/span。 - legacy 的 `ebox-style.el` 主要做本地属性展开和 dirty 分类，没有 current 的 ECSS stylesheet/reactive per-node cascade。 ## Evidence 与 Inference 的边界 diff --git a/docs/user/ebox-api-reference.en.md b/docs/user/ebox-api-reference.en.md index 6099a40..88d60ba 100644 --- a/docs/user/ebox-api-reference.en.md +++ b/docs/user/ebox-api-reference.en.md @@ -76,8 +76,8 @@ use `ebox-render-to-buffer` when the caller owns window selection. (ebox-create &rest properties) (ebox-concat node-1 node-2) ; two nodes side by side (ebox-stack node-1 node-2) ; two nodes vertically -(ebox-row &rest nodes) ; many nodes side by side -(ebox-column &rest nodes) ; many nodes vertically +(ebox-row &rest nodes) ; many nodes side by side; a sole Range keeps its row parent +(ebox-column &rest nodes) ; many nodes vertically; a sole Range keeps its column parent (ebox-spacer &rest properties) ; blank box ``` @@ -332,12 +332,29 @@ one commit: (ebox-commit buffer candidate)) ``` +Frameworks that retain semantic owners separately from backend anchors can +use `ebox-range-ref-present-p` as a read-only check before choosing a wider +published owner. It returns nil when the semantic Range is nested inside a +material anchor and therefore is not independently addressable in the current +Ebox publication. + `ebox-candidate-replace-host-ref` uses an application-owned `:host-ref` instead of a runtime node id. Both replacement functions accept optional `old-semantic-key` and `new-semantic-key` pairs for bounded detached identity reuse. A candidate is sealed by commit and cannot be reused; it also becomes stale if the captured buffer runtime or buffer tick changes. +`ebox-candidate-replace-root` targets a private candidate-bound root address. +It accepts exactly one declarative node, clears caller runtime identities, and +is last-wins. The final root replacement absorbs descendant node and host-ref +operations recorded before or after it, with no wrapper or public reference. + +`ebox-child-range` creates a non-node segment descriptor in a material child +list. Its non-nil ref is root-global and its items participate directly in the +parent's key, selector, style, and layout scope. Use +`ebox-candidate-replace-range-ref` with a proper declarative node list to +replace that base payload. Empty payloads remain addressable. + ### Host-reference positions ```elisp @@ -359,6 +376,13 @@ mount has no update report until its first update. Reports include the Ebox strategy and publication scope plus TP surface revision and physical operation/reconciliation facts. +The complete commit signature is `(ebox-commit BUFFER NEXT-ROOT &optional +FRAMEWORK-PUBLISH FRAMEWORK-ROLLBACK)`. Publish receives the report after the +buffer, TP surface, and Ebox runtime agree. If a later phase fails, rollback +receives that same report at most once; rollback errors and quits are contained. +`:framework-participant-state`, `:framework-participant-diagnostics`, and +`:scroll-finalization-diagnostics` are read-only outcome fields. + Use `ebox-rerender-buffer-with-context` when a root depends on a new viewport: ```elisp @@ -455,9 +479,9 @@ The main customization variables are: | Group | Variables and defaults | | --- | --- | | Render cache | `ebox-render-cache-max-entries` 2048; `ebox-render-cache-max-bytes` 32 MiB; `ebox-render-root-cache-max-entries` 16; `ebox-render-root-cache-max-bytes` 8 MiB | -| Keyboard/mouse scroll | `ebox-scroll-step` 1; `ebox-wheel-scroll-step` 16; `ebox-wheel-smooth-scroll` t; `ebox-wheel-smooth-scroll-interval` 0.016; `ebox-wheel-smooth-scroll-lines-per-tick` 4; `ebox-wheel-smooth-scroll-target-ticks` 8 | +| Keyboard/mouse scroll | `ebox-scroll-step` 1; `ebox-wheel-scroll-step` 1; `ebox-wheel-smooth-scroll` nil; `ebox-wheel-smooth-scroll-interval` 0.016; `ebox-wheel-smooth-scroll-lines-per-tick` 4; `ebox-wheel-smooth-scroll-target-ticks` 8. Keyboard uses point; wheel uses event position; residual lines bubble through nested owners. An interactive complete, chrome-free root document owner may be idle-materialized once and then use Emacs's native window line start; ordinary updates/resizes only warm retained indexes and never start a second native publication; nested/lazy/chrome owners retain transactional Ebox publication. | | Lazy scroll | `ebox-scroll-lazy-prefix-lookahead-lines` 8; `ebox-scroll-lazy-idle-prefetch-lines` 128; `ebox-scroll-lazy-idle-prefetch-slice-lines` 16; `ebox-scroll-lazy-idle-prefetch-delay` 0.15 | -| Runtime prewarm | `ebox-runtime-idle-prewarm` t; `ebox-runtime-idle-prewarm-delay` 0.1; `ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0; `ebox-runtime-idle-prewarm-slice-size` 32 | +| Runtime prewarm | `ebox-runtime-idle-prewarm` t; `ebox-runtime-idle-prewarm-delay` 0.1; `ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0; `ebox-runtime-idle-prewarm-slice-size` 32; `ebox-native-buffer-scroll` t (initial/visible-window handoff only; strict root-owner proof) | | Predicted reflow | `ebox-runtime-idle-reflow-cache-prewarm` t; `ebox-runtime-idle-reflow-cache-prewarm-delay` 0.15 | | Reflow GC | `ebox-reflow-cache-prewarm-gc-cons-threshold` `auto`; `ebox-reflow-cache-prewarm-gc-auto-frame-budget` 0.2; `ebox-reflow-cache-prewarm-gc-auto-min-threshold` 64 MiB; `ebox-reflow-cache-prewarm-gc-auto-max-threshold` 1 GiB; `ebox-reflow-cache-prewarm-gc-auto-initial-threshold` 512 MiB; `ebox-reflow-cache-prewarm-gc-auto-target-layouts` 24; `ebox-reflow-cache-prewarm-gc-cons-percentage` 0.1 | | Visual verification | `ebox-visual-check-output-dir` points to the temporary directory used for optional screenshots and reports. | @@ -528,7 +552,7 @@ style-rule functions immediately below are public module-level style APIs. | `ebox-render`, `ebox-render-to-buffer`, `ebox-display-buffer` | Pure materialization, retained mount, and display wrapper. | | `ebox-commit`, `ebox-buffer-update-report`, `ebox-rerender-buffer-with-context` | Atomic root commit, report lookup, and viewport-context rerender. | | `ebox-region-ids`, `ebox-region-resolve`, `ebox-region-update` | Region mapping, logical handle lookup, and direct update. | -| `ebox-candidate-begin`, `ebox-candidate-replace`, `ebox-candidate-replace-host-ref` | One-shot logical candidate transactions. | +| `ebox-child-range`, `ebox-range-ref-present-p`, `ebox-candidate-begin`, `ebox-candidate-replace`, `ebox-candidate-replace-range-ref`, `ebox-candidate-replace-root`, `ebox-candidate-replace-host-ref` | Persistent material child segments, backend-anchor lookup, and one-shot logical candidate transactions. | | `ebox-host-ref-bounds`, `ebox-host-ref-position` | Live host-reference bounds and first position. | | `ebox-selector-parse`, `ebox-selector-match-node-p`, `ebox-selector-query-all`, `ebox-selector-query-buffer`, `ebox-selector-update-buffer` | ECSS selector compilation, matching, querying, and batch update. | | `ebox-select-all`, `ebox-update-selector` | Compatibility aliases for the two buffer selector functions. | @@ -563,5 +587,5 @@ Focused targets include `make core-tests`, `make grid-tests`, `make flex-tests`, and `make visual-check-tests`. The sibling `ebox-playground` package owns runnable example fixtures; ETAF owns Components, state, controls, and application behavior. Do not call private -`ebox--*` functions or edit the historical `emacs-box` checkout as part of +`ebox--*` functions or edit the historical Ebox checkout as part of this package. diff --git a/docs/user/ebox-api-reference.zh.md b/docs/user/ebox-api-reference.zh.md index 286dea6..318f649 100644 --- a/docs/user/ebox-api-reference.zh.md +++ b/docs/user/ebox-api-reference.zh.md @@ -68,8 +68,8 @@ window，再切换到渲染后的 buffer。如果窗口选择由调用方负责 (ebox-create &rest properties) (ebox-concat node-1 node-2) ; 两个节点横向排列 (ebox-stack node-1 node-2) ; 两个节点纵向排列 -(ebox-row &rest nodes) ; 多个节点横向排列 -(ebox-column &rest nodes) ; 多个节点纵向排列 +(ebox-row &rest nodes) ; 多个节点横向排列；单个 Range 仍保留 row parent +(ebox-column &rest nodes) ; 多个节点纵向排列；单个 Range 仍保留 column parent (ebox-spacer &rest properties) ; 空白 box ``` @@ -304,11 +304,25 @@ Candidate 是基于当前已发布 runtime 的一次性 transaction。多个稳 (ebox-commit buffer candidate)) ``` +如果框架的 semantic owner 与 backend anchor 分离，可在选择更宽的发布 owner +之前使用只读函数 `ebox-range-ref-present-p`。当 semantic Range 嵌套在 material +anchor 内、当前 Ebox publication 没有独立地址时，它返回 nil。 + `ebox-candidate-replace-host-ref` 使用应用拥有的 `:host-ref`，不需要 runtime node id。两个 replacement 函数都接受可选的 `old-semantic-key` 与 `new-semantic-key`，用于有限的 detached identity 复用。Candidate 在 commit 时 sealed，不能复用；若捕获的 runtime 或 buffer tick 发生变化，它也会 stale。 +`ebox-candidate-replace-root` 使用私有且绑定 candidate 的 root 地址。它只接受 +一个声明式节点、清除调用方 runtime identity，并采用 last-wins 语义。最终 root +replacement 会吸收其前后记录的 descendant node/host-ref operation，不添加 +wrapper，也不暴露公共 reference。 + +`ebox-child-range` 在 material child list 中创建非节点 segment descriptor。 +其非 nil ref 在 root 内全局唯一，items 直接参与 parent 的 key、selector、style +与 layout scope。`ebox-candidate-replace-range-ref` 接受 proper declarative +node list，只替换该 base payload；empty payload 仍可寻址。 + ### Host-reference 位置 ```elisp @@ -328,6 +342,13 @@ copy；目标缺失或不是 Ebox runtime 时会报错。首次 mount 在第一 前没有 update report。报告包含 Ebox strategy、publication scope、TP surface revision、物理 operation 和 reconciliation 事实。 +完整签名是 `(ebox-commit BUFFER NEXT-ROOT &optional FRAMEWORK-PUBLISH +FRAMEWORK-ROLLBACK)`。buffer、TP surface 与 Ebox runtime 一致后，publish 接收 +report；若后续 phase 失败，rollback 最多一次接收同一个 report，其 error/quit +会被隔离。`:framework-participant-state`、 +`:framework-participant-diagnostics` 与 `:scroll-finalization-diagnostics` +是只读 outcome 字段。 + 当 root 依赖新的 viewport 时使用 `ebox-rerender-buffer-with-context`： ```elisp @@ -414,9 +435,9 @@ text scale 和固定 `display` space；它也是布局使用的公共测量原 | 分组 | 变量与默认值 | | --- | --- | | Render cache | `ebox-render-cache-max-entries` 2048；`ebox-render-cache-max-bytes` 32 MiB；`ebox-render-root-cache-max-entries` 16；`ebox-render-root-cache-max-bytes` 8 MiB | -| 键盘/鼠标滚动 | `ebox-scroll-step` 1；`ebox-wheel-scroll-step` 16；`ebox-wheel-smooth-scroll` t；`ebox-wheel-smooth-scroll-interval` 0.016；`ebox-wheel-smooth-scroll-lines-per-tick` 4；`ebox-wheel-smooth-scroll-target-ticks` 8 | +| 键盘/鼠标滚动 | `ebox-scroll-step` 1；`ebox-wheel-scroll-step` 1；`ebox-wheel-smooth-scroll` nil；`ebox-wheel-smooth-scroll-interval` 0.016；`ebox-wheel-smooth-scroll-lines-per-tick` 4；`ebox-wheel-smooth-scroll-target-ticks` 8。键盘以 point 为 anchor，滚轮以 event 位置为 anchor，剩余行沿嵌套 owner 向外冒泡。交互式、内容完整且无 chrome 的根 document owner 可在 idle 时一次 materialize，之后使用 Emacs 原生 window line start；普通更新/resize 只预热 retained index，不启动第二次 native publication；嵌套/lazy/chrome owner 继续走事务化 Ebox publication。 | | Lazy scroll | `ebox-scroll-lazy-prefix-lookahead-lines` 8；`ebox-scroll-lazy-idle-prefetch-lines` 128；`ebox-scroll-lazy-idle-prefetch-slice-lines` 16；`ebox-scroll-lazy-idle-prefetch-delay` 0.15 | -| Runtime prewarm | `ebox-runtime-idle-prewarm` t；`ebox-runtime-idle-prewarm-delay` 0.1；`ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0；`ebox-runtime-idle-prewarm-slice-size` 32 | +| Runtime prewarm | `ebox-runtime-idle-prewarm` t；`ebox-runtime-idle-prewarm-delay` 0.1；`ebox-runtime-idle-prewarm-prefix-resume-delay` 2.0；`ebox-runtime-idle-prewarm-slice-size` 32；`ebox-native-buffer-scroll` t（仅 initial/visible-window handoff；严格 root-owner proof） | | 预测 reflow | `ebox-runtime-idle-reflow-cache-prewarm` t；`ebox-runtime-idle-reflow-cache-prewarm-delay` 0.15 | | Reflow GC | `ebox-reflow-cache-prewarm-gc-cons-threshold` `auto`；`ebox-reflow-cache-prewarm-gc-auto-frame-budget` 0.2；`ebox-reflow-cache-prewarm-gc-auto-min-threshold` 64 MiB；`ebox-reflow-cache-prewarm-gc-auto-max-threshold` 1 GiB；`ebox-reflow-cache-prewarm-gc-auto-initial-threshold` 512 MiB；`ebox-reflow-cache-prewarm-gc-auto-target-layouts` 24；`ebox-reflow-cache-prewarm-gc-cons-percentage` 0.1 | | Visual verification | `ebox-visual-check-output-dir` 指向可选 screenshot/report 使用的临时目录。 | @@ -483,7 +504,7 @@ style API。 | `ebox-render`、`ebox-render-to-buffer`、`ebox-display-buffer` | 纯 materialization、retained mount 与展示包装。 | | `ebox-commit`、`ebox-buffer-update-report`、`ebox-rerender-buffer-with-context` | 原子根提交、报告查询和 viewport-context rerender。 | | `ebox-region-ids`、`ebox-region-resolve`、`ebox-region-update` | Region 映射、logical handle 查询与直接更新。 | -| `ebox-candidate-begin`、`ebox-candidate-replace`、`ebox-candidate-replace-host-ref` | 一次性 logical candidate transaction。 | +| `ebox-child-range`、`ebox-range-ref-present-p`、`ebox-candidate-begin`、`ebox-candidate-replace`、`ebox-candidate-replace-range-ref`、`ebox-candidate-replace-root`、`ebox-candidate-replace-host-ref` | 持久 material child segment、backend anchor 查询与一次性 logical candidate transaction。 | | `ebox-host-ref-bounds`、`ebox-host-ref-position` | Host-reference 的 live bounds 与首位置。 | | `ebox-selector-parse`、`ebox-selector-match-node-p`、`ebox-selector-query-all`、`ebox-selector-query-buffer`、`ebox-selector-update-buffer` | ECSS selector 编译、匹配、查询与批量更新。 | | `ebox-select-all`、`ebox-update-selector` | 两个 buffer selector 函数的兼容别名。 | @@ -516,4 +537,4 @@ make native-rust-tests `make selector-tests`、`make dsl-tests`、`make flex-tests` 和 `make visual-check-tests`。可运行的 `.ebox` 示例由同级 `ebox-playground` 包负责；ETAF 负责 Component、state、control 和应用行为。本包不要调用 -私有 `ebox--*` 函数，也不要在 Ebox 任务中编辑历史 `emacs-box` checkout。 +私有 `ebox--*` 函数，也不要在 Ebox 任务中编辑历史 Ebox checkout。 diff --git a/docs/user/ebox-user-guide.en.md b/docs/user/ebox-user-guide.en.md index 270e846..f4bf33d 100644 --- a/docs/user/ebox-user-guide.en.md +++ b/docs/user/ebox-user-guide.en.md @@ -147,7 +147,7 @@ Give a box `:overflow 'scroll` (the default) and a finite `:height` to create a :content (mapconcat #'identity lines "\n")) ``` -`ebox-scroll-down`, `ebox-scroll-up`, `ebox-scroll-page-down`, and `ebox-scroll-page-up` operate on the innermost Ebox scroll region at point and fall back to Emacs scrolling when no Ebox region can consume the command. `ebox-wheel-scroll-down` and `ebox-wheel-scroll-up` consume mouse events for Ebox regions and otherwise delegate to `mwheel-scroll`. `ebox-buffer-mode` installs `ebox-scroll-map` locally; `ebox-render-to-buffer` enables it on its returned buffer. `ebox-scroll-state` exposes read-only scroll facts for a numeric region id; use scroll commands or `ebox-region-update` with `:scroll-offset` to change position. +`ebox-scroll-down`, `ebox-scroll-up`, `ebox-scroll-page-down`, and `ebox-scroll-page-up` start at the innermost scroll owner under point. Keyboard line intent is allocated one line at a time through semantic scroll ancestors; any residual continues to the parent and then ordinary Emacs buffer scrolling. `ebox-wheel-scroll-down` and `ebox-wheel-scroll-up` anchor at the mouse event position (not point) and use the same inner-to-outer residual rule. When no Ebox region can consume the request they delegate to normal Emacs scrolling. `ebox-buffer-mode` installs `ebox-scroll-map` locally; `ebox-render-to-buffer` enables it on its returned buffer. `ebox-scroll-state` exposes read-only scroll facts for a numeric region id; use scroll commands or `ebox-region-update` with `:scroll-offset` to change position. Viewport-dependent values use `(viewport)` and `(viewport-height)`. Rerender a mounted buffer with an explicit context: @@ -155,7 +155,7 @@ Viewport-dependent values use `(viewport)` and `(viewport-height)`. Rerender a m (ebox-rerender-buffer-with-context (get-buffer "*Ebox Demo*") 800 30) ``` -The call preserves node and region identity. The [API reference](ebox-api-reference.en.md#8-scrolling-and-viewport-state) lists lazy prefix, idle prefetch, cache, and scroll customization variables. +The call preserves node and region identity. In an interactive preview, a complete chrome-free root document owner is idle-materialized once and then follows Emacs's native line-oriented window scrolling; nested or still-lazy owners keep the transactional retained-window path. The [API reference](ebox-api-reference.en.md#8-scrolling-and-viewport-state) lists lazy prefix, idle prefetch, cache, and scroll customization variables. ## 9. Standalone `.ebox` files diff --git a/docs/user/ebox-user-guide.zh.md b/docs/user/ebox-user-guide.zh.md index b7fa36a..565424f 100644 --- a/docs/user/ebox-user-guide.zh.md +++ b/docs/user/ebox-user-guide.zh.md @@ -147,7 +147,7 @@ Selector 查询已渲染的树并返回公共匹配记录，但不拥有应用 ``` `ebox-scroll-down`、`ebox-scroll-up`、`ebox-scroll-page-down` 和 -`ebox-scroll-page-up` 操作 point 所在的最内层 Ebox scroll region；没有可消费命令的 Ebox region 时回退到 Emacs scrolling。`ebox-wheel-scroll-down` 与 `ebox-wheel-scroll-up` 为 Ebox region 消费 mouse event，否则委托 `mwheel-scroll`。`ebox-buffer-mode` 本地安装 `ebox-scroll-map`；`ebox-render-to-buffer` 会在返回的 buffer 上启用它。`ebox-scroll-state` 为数字 region id 提供只读 scroll facts；使用滚动命令或 `ebox-region-update` 的 `:scroll-offset` 改变位置。 +`ebox-scroll-page-up`、`ebox-scroll-down` 等键盘命令从 point 所在的最内层 scroll owner 开始，默认按一行意图分配；内层不足的剩余量继续交给语义父盒子，最后才回退到普通 Emacs buffer scrolling。`ebox-wheel-scroll-down` 与 `ebox-wheel-scroll-up` 以 mouse event 位置为 anchor（不使用 point），采用同样的内到外 residual 路由；没有可消费的 Ebox region 时才委托普通 Emacs scrolling。`ebox-buffer-mode` 本地安装 `ebox-scroll-map`；`ebox-render-to-buffer` 会在返回的 buffer 上启用它。`ebox-scroll-state` 为数字 region id 提供只读 scroll facts；使用滚动命令或 `ebox-region-update` 的 `:scroll-offset` 改变位置。 Viewport 值使用 `(viewport)` 与 `(viewport-height)`。mounted buffer 要用显式 context 重排： @@ -155,7 +155,7 @@ Viewport 值使用 `(viewport)` 与 `(viewport-height)`。mounted buffer 要用 (ebox-rerender-buffer-with-context (get-buffer "*Ebox Demo*") 800 30) ``` -该调用保留 node 与 region identity。[公共 API 参考](ebox-api-reference.zh.md)列出了 lazy prefix、idle prefetch、cache 和滚动配置变量。 +该调用保留 node 与 region identity。交互式预览中，内容完整且无 chrome 的根 document owner 会在 idle 时一次 materialize，随后采用 Emacs 原生逐行 window scrolling；嵌套或仍处于 lazy 状态的 owner 继续使用事务化 retained-window 路径。[公共 API 参考](ebox-api-reference.zh.md)列出了 lazy prefix、idle prefetch、cache 和滚动配置变量。 ## 9. 独立 `.ebox` 文件 diff --git a/ebox-buffer-backend.el b/ebox-buffer-backend.el index c95f46c..8a24f2f 100644 --- a/ebox-buffer-backend.el +++ b/ebox-buffer-backend.el @@ -17,6 +17,8 @@ "ebox-render-context" (property value)) (declare-function ebox--register-render-owned-face-values "ebox-render-context" (source rendered)) +(declare-function ebox--add-render-face! + "ebox-render-context" (string start end face &optional append)) (declare-function ebox--string-repeat-lines "ebox" (string count)) (declare-function ebox-lines-join @@ -240,7 +242,7 @@ buffer-facing paint properties. Layout-only properties never pass through." "Apply STYLE's typography to one copy of STRING." (if-let ((face (ebox-buffer--font-face style))) (let ((copy (copy-sequence string))) - (add-face-text-property 0 (length copy) face t copy) + (ebox--add-render-face! copy 0 (length copy) face t) (ebox--register-render-owned-face-values string copy)) string)) @@ -259,9 +261,8 @@ buffer-facing paint properties. Layout-only properties never pass through." (display (ebox--register-render-owned-text-value 'display `(space :width (,pixel-width)))) - (line (propertize " " - 'face face - 'display display))) + (line (propertize " " 'display display))) + (ebox--add-render-face! line 0 (length line) face) (ebox--register-render-owned-text-value 'face face) (ebox--string-repeat-lines line height)))) @@ -270,7 +271,7 @@ buffer-facing paint properties. Layout-only properties never pass through." (let* ((source string) (string (copy-sequence source)) (length (length string))) - (add-face-text-property 0 length `(:background ,bgcolor) t string) + (ebox--add-render-face! string 0 length `(:background ,bgcolor) t) (ebox--register-render-owned-face-values source string))) (defun ebox--propertize-color (string color) @@ -278,12 +279,12 @@ buffer-facing paint properties. Layout-only properties never pass through." (let* ((source string) (string (copy-sequence source)) (length (length string))) - (add-face-text-property - 0 length + (ebox--add-render-face! + string 0 length (if (eq color 'ebox/default-foreground) '(:inherit default) `(:foreground ,color)) - t string) + t) (ebox--register-render-owned-face-values source string))) (defun ebox--propertize-colors (string color bgcolor) @@ -292,33 +293,33 @@ buffer-facing paint properties. Layout-only properties never pass through." (string (copy-sequence source)) (length (length string))) (when color - (add-face-text-property - 0 length + (ebox--add-render-face! + string 0 length (if (eq color 'ebox/default-foreground) '(:inherit default) `(:foreground ,color)) - t string)) + t)) (when bgcolor - (add-face-text-property - 0 length `(:background ,bgcolor) t string)) + (ebox--add-render-face! + string 0 length `(:background ,bgcolor) t)) (ebox--register-render-owned-face-values source string))) (defun ebox--propertize-overline (string &optional color) "Apply overline to STRING with optional COLOR." (let* ((source string) (string (copy-sequence source))) - (add-face-text-property - 0 (length string) `(:overline ,(or color t)) t string) + (ebox--add-render-face! + string 0 (length string) `(:overline ,(or color t)) t) (ebox--register-render-owned-face-values source string))) (defun ebox--propertize-underline (string &optional color) "Apply underline to STRING with optional COLOR." (let* ((source string) (string (copy-sequence source))) - (add-face-text-property - 0 (length string) + (ebox--add-render-face! + string 0 (length string) `(:underline (:position t ,@(when color `(:color ,color)))) - t string) + t) (ebox--register-render-owned-face-values source string))) (defun ebox--propertize-region (string property region-id) diff --git a/ebox-child-range.el b/ebox-child-range.el new file mode 100644 index 0000000..a352195 --- /dev/null +++ b/ebox-child-range.el @@ -0,0 +1,471 @@ +;;; ebox-child-range.el --- Persistent child sequence core -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Immutable weighted segment and key tries for future child Range integration. + +;;; Code: + +(require 'cl-lib) +(require 'subr-x) + +(cl-defstruct (ebox-child-range--metrics + (:constructor ebox-child-range--make-metrics)) + (segment-visits 0) (segment-copies 0) (ref-index-visits 0) + (ref-index-copies 0) (key-visits 0) (key-copies 0) + (collision-visits 0) (collision-copies 0) + (old-affected-payload-visits 0) (new-payload-validations 0) + (new-payload-copies 0) (new-payload-visits 0) + (unaffected-payload-visits 0) (unaffected-payload-validations 0) + (unaffected-payload-copies 0)) + +(cl-defstruct (ebox-child-range--segment + (:constructor ebox-child-range--make-segment)) + ref payload) + +(cl-defstruct (ebox-child-range--segment-node + (:constructor ebox-child-range--make-segment-node)) + children value weight segment-count) + +(cl-defstruct (ebox-child-range--hash-node + (:constructor ebox-child-range--make-hash-node)) + children bucket) + +(cl-defstruct (ebox-child-range--sequence + (:constructor ebox-child-range--make-sequence)) + root height count ref-index key-root hash-function) + +(cl-defstruct (ebox-child-range--descriptor + (:constructor ebox-child-range--make-descriptor)) + ref items) + +(defun ebox-child-range--metric-add (metrics slot &optional amount) + "Increment METRICS SLOT by AMOUNT, defaulting to one." + (setf (cl-struct-slot-value 'ebox-child-range--metrics slot metrics) + (+ (or (cl-struct-slot-value 'ebox-child-range--metrics slot metrics) 0) + (or amount 1)))) + +(defun ebox-child-range--height (count) + "Return the base-32 trie height needed for COUNT segments." + (let ((height 0) (capacity 1)) + (while (> count capacity) + (setq height (1+ height) capacity (* capacity 32))) + height)) + +(defun ebox-child-range--digit (index level) + "Return INDEX's five-bit digit at LEVEL." + (logand 31 (ash index (* -5 level)))) + +(defun ebox-child-range--segment-insert (node height index value) + "Persistently insert VALUE at INDEX below NODE of HEIGHT." + (if (= height 0) + (ebox-child-range--make-segment-node + :value value :weight (length (ebox-child-range--segment-payload value)) + :segment-count 1) + (let* ((slot (ebox-child-range--digit index (1- height))) + (children (copy-sequence + (or (and node (ebox-child-range--segment-node-children node)) + (make-vector 32 nil)))) + (old (aref children slot)) + (new (if (= height 1) + (ebox-child-range--make-segment-node + :value value :weight (length (ebox-child-range--segment-payload value)) + :segment-count 1) + (ebox-child-range--segment-insert old (1- height) index value)))) + (aset children slot new) + (ebox-child-range--make-segment-node + :children children + :weight (cl-loop for child across children when child + sum (ebox-child-range--segment-node-weight child)) + :segment-count (cl-loop for child across children when child + sum (ebox-child-range--segment-node-segment-count child)))))) + +(defun ebox-child-range--segment-at (sequence index) + "Return SEQUENCE segment at INDEX." + (unless (and (integerp index) (<= 0 index) + (< index (ebox-child-range--sequence-count sequence))) + (signal 'args-out-of-range (list index))) + (let ((node (ebox-child-range--sequence-root sequence)) + (height (ebox-child-range--sequence-height sequence))) + (while (> height 0) + (setq node (aref (ebox-child-range--segment-node-children node) + (ebox-child-range--digit index (1- height))) + height (1- height))) + (ebox-child-range--segment-node-value node))) + +(defun ebox-child-range--segment-replace (node height index value metrics) + "Return `(NEW-NODE . OLD-SEGMENT)' below NODE of HEIGHT at INDEX. +VALUE is the replacement segment and METRICS records all path work." + (ebox-child-range--metric-add metrics 'segment-visits) + (ebox-child-range--metric-add metrics 'segment-copies) + (if (= height 0) + (cons (ebox-child-range--make-segment-node + :value value + :weight (length (ebox-child-range--segment-payload value)) + :segment-count 1) + (ebox-child-range--segment-node-value node)) + (let* ((slot (ebox-child-range--digit index (1- height))) + (children (copy-sequence + (ebox-child-range--segment-node-children node))) + (old (aref children slot)) + result new old-segment) + (if (= height 1) + (progn + (ebox-child-range--metric-add metrics 'segment-visits) + (ebox-child-range--metric-add metrics 'segment-copies) + (setq old-segment (ebox-child-range--segment-node-value old) + new (ebox-child-range--make-segment-node + :value value + :weight (length (ebox-child-range--segment-payload value)) + :segment-count 1))) + (setq result (ebox-child-range--segment-replace + old (1- height) index value metrics) + new (car result) + old-segment (cdr result))) + (aset children slot new) + (cons + (ebox-child-range--make-segment-node + :children children + :weight (cl-loop for child across children when child + sum (ebox-child-range--segment-node-weight child)) + :segment-count (ebox-child-range--segment-node-segment-count node)) + old-segment)))) + +(defun ebox-child-range--stable-hash (key) + "Return KEY's stable unsigned 32-bit hash." + (logand #xffffffff (sxhash-equal key))) + +(defun ebox-child-range--bucket-find (bucket key metrics) + "Return KEY entry in collision BUCKET and count METRICS comparisons." + (let (found) + (while bucket + (ebox-child-range--metric-add metrics 'collision-visits) + (when (equal key (caar bucket)) (setq found (car bucket))) + (setq bucket (cdr bucket))) + found)) + +(defun ebox-child-range--hash-change + (node key value hash depth remove-p metrics) + "Persistently change KEY in sparse hash NODE using HASH at DEPTH." + (if (= depth 7) + (let* ((source (and node (ebox-child-range--hash-node-bucket node))) + (found (ebox-child-range--bucket-find source key metrics)) + (bucket (copy-sequence source))) + (ebox-child-range--metric-add metrics 'collision-copies + (length source)) + (cond + (remove-p + (ebox-child-range--make-hash-node + :bucket (cl-delete key bucket :key #'car :test #'equal))) + (found (error "Ebox child key is not unique: %S" key)) + (t (ebox-child-range--make-hash-node + :bucket (cons (cons key value) bucket))))) + (ebox-child-range--metric-add metrics 'key-visits) + (ebox-child-range--metric-add metrics 'key-copies) + (let* ((slot (logand 31 (ash hash (* -5 depth)))) + (children (copy-sequence (and node + (ebox-child-range--hash-node-children + node)))) + (old (cdr (assq slot children))) + (new (ebox-child-range--hash-change + old key value hash (1+ depth) remove-p metrics))) + (setq children (cons (cons slot new) (assq-delete-all slot children))) + (ebox-child-range--make-hash-node :children children)))) + +(defun ebox-child-range--hash-lookup (root key hash) + "Look up KEY with HASH in ROOT." + (let ((node root) (depth 0)) + (while (< depth 7) + (setq node (and node + (cdr (assq (logand 31 (ash hash (* -5 depth))) + (ebox-child-range--hash-node-children node)))) + depth (1+ depth))) + (cdr (assoc key (and node (ebox-child-range--hash-node-bucket node)) + #'equal)))) + +(defun ebox-child-range--item-copy (item metrics) + "Validate and copy declarative ITEM while recording METRICS." + (when (ebox-child-range--descriptor-p item) + (error "Nested child Range descriptors are reserved")) + (unless (and (listp item) (not (stringp item))) + (error "Ebox child Range item must be one declarative node")) + (ebox-child-range--metric-add metrics 'new-payload-validations) + (ebox-child-range--metric-add metrics 'new-payload-visits) + (ebox-child-range--metric-add metrics 'new-payload-copies) + (copy-sequence item)) + +(defun ebox-child-range--descriptor-create (ref items) + "Return a reserved Range descriptor for non-nil REF and list ITEMS." + (unless ref (error "Ebox child Range ref must be non-nil")) + (unless (proper-list-p items) + (signal 'wrong-type-argument (list 'proper-list-p items))) + (ebox-child-range--make-descriptor :ref ref :items items)) + +(defun ebox-child-range--build (segments &optional hash-function) + "Build an immutable child sequence from SEGMENTS. +Each entry is `(REF . ITEMS)'; nil REF denotes one static child item. +HASH-FUNCTION optionally supplies the stable key hash." + (unless (proper-list-p segments) + (signal 'wrong-type-argument (list 'proper-list-p segments))) + (let* ((count (length segments)) + (height (ebox-child-range--height count)) + (hash-function (or hash-function #'ebox-child-range--stable-hash)) + (metrics (ebox-child-range--make-metrics)) + root key-root (refs (make-hash-table :test #'equal)) (index 0)) + (when (zerop count) (error "Ebox child sequence requires a segment")) + (dolist (entry segments) + (let* ((ref (car entry)) + (items (cdr entry))) + (unless (proper-list-p items) + (signal 'wrong-type-argument (list 'proper-list-p items))) + (when (and (null ref) (/= (length items) 1)) + (error "Ebox static child segment requires exactly one item")) + (when (and ref (gethash ref refs)) + (error "Ebox child Range ref is not unique: %S" ref)) + (when ref (puthash ref index refs)) + (let ((payload (vconcat + (mapcar (lambda (item) + (ebox-child-range--item-copy item metrics)) + items)))) + (setq root (ebox-child-range--segment-insert + root height index + (ebox-child-range--make-segment :ref ref :payload payload))) + (dotimes (offset (length payload)) + (let* ((item (aref payload offset)) (key (plist-get item :key))) + (when key + (setq key-root + (ebox-child-range--hash-change + key-root key (cons index offset) + (funcall hash-function key) 0 nil metrics))))))) + (setq index (1+ index))) + (ebox-child-range--make-sequence + :root root :height height :count count :ref-index refs + :key-root key-root :hash-function hash-function))) + +(defun ebox-child-range--replace (sequence ref items) + "Return `(NEW-SEQUENCE . METRICS)' for SEQUENCE after replacing REF ITEMS." + (ebox-child-range--replace-many sequence (list (cons ref items)))) + +(defun ebox-child-range--replace-many (sequence replacements) + "Replace RANGE REPLACEMENTS in SEQUENCE with one two-phase transaction." + (let ((metrics (ebox-child-range--make-metrics)) + (missing (make-symbol "missing-range-ref")) + (seen (make-hash-table :test #'equal)) records) + (unless (proper-list-p replacements) + (signal 'wrong-type-argument (list 'proper-list-p replacements))) + (dolist (entry replacements) + (unless (proper-list-p (cdr entry)) + (signal 'wrong-type-argument (list 'proper-list-p (cdr entry)))) + (when (gethash (car entry) seen) + (error "Ebox child Range replacement ref repeats: %S" (car entry))) + (puthash (car entry) t seen) + (ebox-child-range--metric-add metrics 'ref-index-visits) + (let ((index (gethash (car entry) + (ebox-child-range--sequence-ref-index sequence) + missing))) + (when (eq index missing) + (error "Ebox child Range ref does not exist: %S" (car entry))) + (push (list (car entry) index + (vconcat (mapcar + (lambda (item) + (ebox-child-range--item-copy item metrics)) + (cdr entry)))) + records))) + (setq records (nreverse records)) + (let ((key-root (ebox-child-range--sequence-key-root sequence)) + (hash-function (ebox-child-range--sequence-hash-function sequence)) + (root (ebox-child-range--sequence-root sequence))) + ;; Each affected ref performs exactly one measured segment path copy; + ;; the returned old leaf supplies phase-one key removal. + (setq records + (mapcar + (lambda (record) + (let* ((result + (ebox-child-range--segment-replace + root (ebox-child-range--sequence-height sequence) + (nth 1 record) + (ebox-child-range--make-segment + :ref (car record) :payload (nth 2 record)) + metrics))) + (setq root (car result)) + (list (car record) (nth 1 record) (cdr result) + (nth 2 record)))) + records)) + (dolist (record records) + (let ((payload (ebox-child-range--segment-payload (nth 2 record)))) + (dotimes (offset (length payload)) + (ebox-child-range--metric-add metrics 'old-affected-payload-visits) + (when-let ((key (plist-get (aref payload offset) :key))) + (setq key-root + (ebox-child-range--hash-change + key-root key nil (funcall hash-function key) 0 t metrics)))))) + (dolist (record records) + (let ((index (nth 1 record)) (payload (nth 3 record))) + (dotimes (offset (length payload)) + (when-let ((key (plist-get (aref payload offset) :key))) + (setq key-root + (ebox-child-range--hash-change + key-root key (cons index offset) + (funcall hash-function key) 0 nil metrics)))))) + (cons (ebox-child-range--make-sequence + :root root :height (ebox-child-range--sequence-height sequence) + :count (ebox-child-range--sequence-count sequence) + :ref-index (ebox-child-range--sequence-ref-index sequence) + :key-root key-root :hash-function hash-function) + metrics)))) + +(defun ebox-child-range--replace-item-at + (sequence segment-index offset old-item new-item) + "Persistently replace OLD-ITEM by NEW-ITEM in SEQUENCE. +SEGMENT-INDEX and OFFSET identify its exact material-child location." + (let* ((segment (ebox-child-range--segment-at sequence segment-index)) + (payload (copy-sequence (ebox-child-range--segment-payload segment))) + (key-root (ebox-child-range--sequence-key-root sequence)) + (hash-function (ebox-child-range--sequence-hash-function sequence)) + (metrics (ebox-child-range--make-metrics)) + (old-key (plist-get old-item :key)) + (new-key (plist-get new-item :key))) + (unless (eq (aref payload offset) old-item) + (error "Ebox child sequence location is stale")) + (when old-key + (setq key-root (ebox-child-range--hash-change + key-root old-key nil (funcall hash-function old-key) + 0 t metrics))) + (when new-key + (setq key-root (ebox-child-range--hash-change + key-root new-key (cons segment-index offset) + (funcall hash-function new-key) 0 nil metrics))) + (aset payload offset new-item) + (let ((result + (ebox-child-range--segment-replace + (ebox-child-range--sequence-root sequence) + (ebox-child-range--sequence-height sequence) segment-index + (ebox-child-range--make-segment + :ref (ebox-child-range--segment-ref segment) :payload payload) + metrics))) + (ebox-child-range--make-sequence + :root (car result) :height (ebox-child-range--sequence-height sequence) + :count (ebox-child-range--sequence-count sequence) + :ref-index (ebox-child-range--sequence-ref-index sequence) + :key-root key-root :hash-function hash-function)))) + +(defun ebox-child-range--prefix-weight (sequence index) + "Return flattened item weight before segment INDEX in SEQUENCE." + (let ((node (ebox-child-range--sequence-root sequence)) + (height (ebox-child-range--sequence-height sequence)) + (weight 0)) + (while (> height 0) + (let* ((children (ebox-child-range--segment-node-children node)) + (slot (ebox-child-range--digit index (1- height)))) + (dotimes (cursor slot) + (when-let ((child (aref children cursor))) + (setq weight (+ weight + (ebox-child-range--segment-node-weight child))))) + (setq node (aref children slot) + height (1- height)))) + weight)) + +(defun ebox-child-range--rank (sequence index) + "Return the flattened child rank of segment INDEX in SEQUENCE." + (ebox-child-range--prefix-weight sequence index)) + +(defun ebox-child-range--lookup-ref (sequence ref) + "Return SEQUENCE's segment addressed by non-nil REF." + (let ((missing (make-symbol "missing-range-ref"))) + (let ((index (gethash ref (ebox-child-range--sequence-ref-index sequence) + missing))) + (unless (eq index missing) + (ebox-child-range--segment-at sequence index))))) + +(defun ebox-child-range--range-records (sequence) + "Return stable `(REF INDEX)' records for SEQUENCE ranges." + (let (records) + (dotimes (index (ebox-child-range--sequence-count sequence)) + (let ((segment (ebox-child-range--segment-at sequence index))) + (when-let ((ref (ebox-child-range--segment-ref segment))) + (push (list ref index) records)))) + (nreverse records))) + +(defun ebox-child-range--segment-memory (sequence) + "Return `(NODES . EDGES)' used by SEQUENCE's fixed-vector segment trie." + (let ((nodes 0) (edges 0)) + (cl-labels ((walk (node) + (setq nodes (1+ nodes)) + (when-let ((children + (ebox-child-range--segment-node-children node))) + (dotimes (slot 32) + (when-let ((child (aref children slot))) + (setq edges (1+ edges)) + (walk child)))))) + (walk (ebox-child-range--sequence-root sequence))) + (cons nodes edges))) + +(defun ebox-child-range--segment-vector-memory (sequence) + "Return `(VECTORS . SLOTS)' allocated by SEQUENCE's segment trie." + (let ((vectors 0)) + (cl-labels ((walk (node) + (when-let ((children + (ebox-child-range--segment-node-children node))) + (setq vectors (1+ vectors)) + (dotimes (slot 32) + (when-let ((child (aref children slot))) (walk child)))))) + (walk (ebox-child-range--sequence-root sequence))) + (cons vectors (* 32 vectors)))) + +(defun ebox-child-range--hash-memory (root) + "Return `(NODES . EDGES)' for sparse persistent hash ROOT." + (let ((nodes 0) (edges 0)) + (cl-labels ((walk (node) + (when node + (setq nodes (1+ nodes)) + (dolist (entry (ebox-child-range--hash-node-children node)) + (setq edges (1+ edges)) + (walk (cdr entry)))))) + (walk root)) + (cons nodes edges))) + +(defun ebox-child-range--metrics-plist (metrics) + "Return a read-only plist snapshot of METRICS." + (list :segment-visits (ebox-child-range--metrics-segment-visits metrics) + :segment-copies (ebox-child-range--metrics-segment-copies metrics) + :ref-index-visits (ebox-child-range--metrics-ref-index-visits metrics) + :ref-index-copies (ebox-child-range--metrics-ref-index-copies metrics) + :key-visits (ebox-child-range--metrics-key-visits metrics) + :key-copies (ebox-child-range--metrics-key-copies metrics) + :collision-visits (ebox-child-range--metrics-collision-visits metrics) + :collision-copies (ebox-child-range--metrics-collision-copies metrics) + :old-affected-payload-visits + (ebox-child-range--metrics-old-affected-payload-visits metrics) + :new-payload-validations + (ebox-child-range--metrics-new-payload-validations metrics) + :new-payload-copies (ebox-child-range--metrics-new-payload-copies metrics) + :new-payload-visits (ebox-child-range--metrics-new-payload-visits metrics) + :unaffected-payload-visits + (ebox-child-range--metrics-unaffected-payload-visits metrics) + :unaffected-payload-validations + (ebox-child-range--metrics-unaffected-payload-validations metrics) + :unaffected-payload-copies + (ebox-child-range--metrics-unaffected-payload-copies metrics))) + +(defun ebox-child-range--fold (sequence function initial) + "Fold SEQUENCE payloads in stable order with FUNCTION and INITIAL." + (let ((value initial) + (index 0)) + (while (< index (ebox-child-range--sequence-count sequence)) + (let ((payload (ebox-child-range--segment-payload + (ebox-child-range--segment-at sequence index)))) + (dotimes (offset (length payload)) + (setq value (funcall function value (aref payload offset))))) + (setq index (1+ index))) + value)) + +(defun ebox-child-range--flatten (sequence) + "Return SEQUENCE's explicit debug-only flat item list." + (nreverse + (ebox-child-range--fold + sequence (lambda (items item) (cons item items)) nil))) + +(provide 'ebox-child-range) +;;; ebox-child-range.el ends here diff --git a/ebox-dsl.el b/ebox-dsl.el index d4853f7..9b7435b 100644 --- a/ebox-dsl.el +++ b/ebox-dsl.el @@ -123,7 +123,13 @@ The first value is string content. The second value is a lazy child node." (let* ((split (ebox--build-split-attrs items)) (props (car split)) (children (cdr split)) - (layout (apply constructor (mapcar #'ebox-dsl-build (delq nil children))))) + (layout + (apply constructor + (mapcar (lambda (child) + (if (ebox-child-range--descriptor-p child) + child + (ebox-dsl-build child))) + (delq nil children))))) (ebox--build-wrap-layout tag props layout))) (defun ebox--build-flex (items) diff --git a/ebox-flex.el b/ebox-flex.el index 41cc974..94c242c 100644 --- a/ebox-flex.el +++ b/ebox-flex.el @@ -485,7 +485,7 @@ grapheme." (dolist (child (ebox--layout-children node)) (ebox--flex-recache-source-boxes child))) ('flex - (dolist (child (plist-get node :children)) + (dolist (child (ebox-tree-layout-children node)) (ebox--flex-recache-source-boxes child))) ('flex-item (ebox--flex-recache-source-boxes (plist-get node :node))))))) @@ -1468,7 +1468,7 @@ its child." (plist-get node :raw-props) (plist-get node :box))) (axis (ebox--flex-axis props)) - (children (plist-get node :children)) + (children (ebox-tree-layout-children node)) (main-size (if (eq axis 'row) (ebox--flex-horizontal-value (plist-get props :width)) (ebox--flex-line-value (plist-get props :height)))) @@ -1512,7 +1512,7 @@ assembles already-rendered items." (plist-get node :raw-props) (plist-get node :box))) (axis (ebox--flex-axis props)) - (children (plist-get node :children)) + (children (ebox-tree-layout-children node)) (main-size (ebox--flex-main-value axis (plist-get props (if (eq axis 'row) @@ -2186,7 +2186,7 @@ Return nil when the flex container needs the normal full renderer." (plist-get node :raw-props) (plist-get node :box))) (axis (ebox--flex-axis props)) - (children (plist-get node :children)) + (children (ebox-tree-layout-children node)) (main-size (if (eq axis 'row) (ebox--flex-horizontal-value (plist-get props :width)) @@ -2333,7 +2333,7 @@ known-row render is used only if the new item footprint is not smaller." (memq wrap '(wrap nowrap)) (null (ebox--flex-line-value (plist-get props :height))) (not (ebox--flex-reverse-p props))) - (let* ((children (plist-get node :children)) + (let* ((children (ebox-tree-layout-children node)) (inline-viewport (ebox--flex-inline-viewport axis main-size cross-size)) (row-gap (or (ebox--flex-line-value @@ -2384,7 +2384,7 @@ Return nil when NODE's flex configuration needs a full rerender." (memq wrap '(wrap nowrap)) main-size (null (ebox--flex-line-value (plist-get props :height)))) - (let* ((children (plist-get node :children)) + (let* ((children (ebox-tree-layout-children node)) (cross-size nil) (inline-viewport (ebox--flex-inline-viewport axis main-size cross-size)) diff --git a/ebox-grid.el b/ebox-grid.el index 2182f6f..3a87641 100644 --- a/ebox-grid.el +++ b/ebox-grid.el @@ -446,7 +446,10 @@ Supported properties are `:grid-column', `:grid-row', (defun ebox-grid--auto-width-node-p (node) "Return non-nil when NODE derives its width from the active viewport." (let ((width (plist-get node :width))) - (or (null width) (eq width 'auto)))) + ;; `stretch' and `contain' are containing-block widths. Treating them + ;; as intrinsic leaves fractional Grid tracks empty and makes composite + ;; cards hug their natural width instead of filling the assigned track. + (or (null width) (memq width '(auto stretch contain))))) (defun ebox-grid--entry-source (entry rendered width props) "Return ENTRY's content rendered within WIDTH when it is auto-sized. @@ -610,7 +613,7 @@ size for start/center/end alignment unless it would overflow its track." (defun ebox--render-grid (node) "Render GRID NODE to a propertized string." (let* ((props (plist-get node :raw-props)) - (children (plist-get node :children)) + (children (ebox-tree-layout-children node)) (columns (ebox-grid--normalize-tracks (plist-get props :grid-template-columns) 'columns)) (rows (ebox-grid--normalize-tracks diff --git a/ebox-incremental.el b/ebox-incremental.el index 9107da9..1f9148f 100644 --- a/ebox-incremental.el +++ b/ebox-incremental.el @@ -39,6 +39,12 @@ "ebox-tree" (root)) (declare-function ebox-surface-region-mounts "ebox-surface" (buffer region-id &optional roles)) +(declare-function ebox-surface-region-bounds + "ebox-surface" (buffer region-id &optional roles)) +(declare-function tp-object-mounts + "tp-surface" (object)) +(declare-function ebox-surface--cascade-local-owner-proof-p + "ebox-surface" (state candidate-state dirty-set)) (declare-function ebox-string-lines "ebox" (string)) (declare-function ebox-get "ebox" (box key)) (declare-function ebox--ensure-node-id "ebox" (node)) @@ -139,6 +145,8 @@ arguments.") base-revision base-buffer-tick replacements + range-replacements + range-metrics sealed-p) (cl-defstruct @@ -151,6 +159,13 @@ arguments.") old-semantic-key new-semantic-key) +(cl-defstruct + (ebox-incremental--candidate-range-replacement + (:constructor ebox-incremental--make-candidate-range-replacement) + (:conc-name ebox-incremental--candidate-range-replacement-)) + "One base-addressed child Range payload replacement." + ref items) + (cl-defstruct (ebox-incremental--detached-history (:constructor ebox-incremental--make-detached-history) @@ -181,6 +196,15 @@ this transaction-local map keeps every successive copy recorded under the original published identity. Candidate-only nodes with no base origin map to themselves.") +(defvar ebox-incremental--candidate-range-index-deltas nil + "Transaction-local Range parent and affected payload index deltas.") + +(defvar ebox-incremental--candidate-state-for-slot-proof nil + "Candidate runtime used by bounded allocated-slot impact proofs.") + +(defvar ebox-incremental--allocated-slot-proof-cache nil + "Transaction-local cache of candidate allocated-slot proof results.") + (defvar ebox-incremental--after-declarative-publication nil "Internal callback run inside declarative publication's quit-free boundary. @@ -979,8 +1003,9 @@ same traversal in complete-render overwrite order." (and collect-region-boxes (make-hash-table :test 'equal))) (region-box-count-table (make-hash-table :test 'equal)) (host-ref-table (make-hash-table :test 'equal)) + (range-ref-table (make-hash-table :test 'equal)) (runtime-type-count-table (make-hash-table :test 'eq)) - native-node-postorder) + native-node-postorder range-sequence-p) (cl-labels ((index-host-ref (node node-id) (when-let ((host-ref (plist-get node :host-ref))) (let ((count (hash-table-count host-ref-table))) @@ -1039,6 +1064,31 @@ same traversal in complete-render overwrite order." (puthash node-id parent-id parent-table)) (index-region-id node node-id) (index-host-ref node node-id) + (when-let ((sequence (plist-get node :ebox-child-sequence))) + (setq range-sequence-p t) + (dotimes + (segment-index + (ebox-child-range--sequence-count sequence)) + (let ((payload + (ebox-child-range--segment-payload + (ebox-child-range--segment-at + sequence segment-index)))) + (dotimes (offset (length payload)) + (let ((child (aref payload offset))) + (ebox--ensure-node-id child) + (plist-put child :ebox-sequence-location + (list :parent-node-id node-id + :segment-index segment-index + :offset offset)))))) + (dolist (record + (ebox-child-range--range-records sequence)) + (pcase-let ((`(,ref ,segment-index) record)) + (when (gethash ref range-ref-table) + (error "Ebox child Range ref is not unique: %S" ref)) + (puthash ref + (list :parent-node-id node-id + :segment-index segment-index) + range-ref-table)))) (dolist (child (ebox--node-children node)) (visit child node-id @@ -1063,6 +1113,7 @@ same traversal in complete-render overwrite order." :region-box-table region-box-table :region-box-count-table region-box-count-table :host-ref-table host-ref-table + :range-ref-table range-ref-table :selector-id-table (plist-get selector-index :selector-id-table) :selector-class-table (plist-get selector-index :selector-class-table) @@ -1070,7 +1121,8 @@ same traversal in complete-render overwrite order." (plist-get selector-index :selector-type-table) :runtime-type-count-table runtime-type-count-table :native-node-postorder - (vconcat (nreverse native-node-postorder)))))) + (if range-sequence-p [] + (vconcat (nreverse native-node-postorder))))))) (defun ebox-incremental--ensure-buffer-selector-indexes (buffer) "Return BUFFER's state after materializing deferred selector indexes." @@ -1111,6 +1163,7 @@ same traversal in complete-render overwrite order." "Install runtime INDEX tables into candidate STATE and return STATE." (dolist (key '(:node-table :parent-table :region-id-set :region-node-table :region-box-count-table :region-box-table :host-ref-table + :range-ref-table :selector-id-table :selector-class-table :selector-type-table :runtime-type-count-table :native-node-postorder)) @@ -1153,6 +1206,17 @@ same traversal in complete-render overwrite order." "Return BUFFER's opaque host reference to runtime node id table." (plist-get (ebox--buffer-render-state buffer) :host-ref-table)) +(defun ebox-incremental--range-ref-resolve (state ref) + "Resolve REF in STATE to its parent, sequence, segment index, and rank." + (when-let* ((record (gethash ref (plist-get state :range-ref-table))) + (parent (gethash (plist-get record :parent-node-id) + (plist-get state :node-table))) + (sequence (plist-get parent :ebox-child-sequence))) + (list :parent parent :sequence sequence + :segment-index (plist-get record :segment-index) + :rank (ebox-child-range--rank + sequence (plist-get record :segment-index))))) + (defun ebox--buffer-region-render-owner-node-id (buffer region-id) "Return REGION-ID's smallest render-owner node id in BUFFER. Use the persistent runtime index when available. Legacy runtime states that @@ -1262,6 +1326,23 @@ while validating one predicted root-width mutation against the new revision." :overflow-signature :detail-generation) "Expensive layout snapshot detail keys that depend on current buffer spans.") +(defun ebox--layout-snapshot-buffer-spans-valid-p (buffer snapshot) + "Return non-nil when SNAPSHOT spans still fit BUFFER's live range." + (let ((spans (plist-get snapshot :buffer-spans))) + (or (null spans) + (and (buffer-live-p buffer) + (let ((minimum (with-current-buffer buffer (point-min))) + (maximum (with-current-buffer buffer (point-max)))) + (cl-every + (lambda (span) + (and (consp span) + (integerp (car span)) + (integerp (cdr span)) + (<= minimum (car span)) + (<= (car span) (cdr span)) + (<= (cdr span) maximum))) + spans)))))) + (defun ebox--buffer-layout-snapshot-detail-generation (buffer) "Return BUFFER's current layout snapshot detail generation." (or (plist-get (ebox--buffer-render-state buffer) @@ -1272,8 +1353,9 @@ while validating one predicted root-width mutation against the new revision." "Return non-nil when SNAPSHOT's buffer-dependent detail fields are current." (or (not (cl-some (lambda (key) (plist-member snapshot key)) ebox--layout-snapshot-detail-keys)) - (= (or (plist-get snapshot :detail-generation) -1) - (ebox--buffer-layout-snapshot-detail-generation buffer)))) + (and (= (or (plist-get snapshot :detail-generation) -1) + (ebox--buffer-layout-snapshot-detail-generation buffer)) + (ebox--layout-snapshot-buffer-spans-valid-p buffer snapshot)))) (defun ebox--layout-snapshot (buffer node-id) "Return BUFFER's layout snapshot for NODE-ID." @@ -2443,6 +2525,33 @@ outer width and height are definite and still contain their inner chrome." (dolist (key (plist-get entry :changed-keys)) (dolist (impact (ebox--changed-key-impact key style-node)) (cl-pushnew impact impacts))) + ;; An auto-width content box contributes its intrinsic width to the + ;; enclosing stack. Its text change can therefore move every later + ;; sibling even when the local box remains span-patchable. Equal-length + ;; candidates may reach the final footprint proof; that proof still + ;; rejects pixel-width, wrapping, or unstable parent-allocation changes. + (when (and style-node + (memq :content (plist-get entry :changed-keys)) + (not (ebox--span-patch-definite-size-value-p + (ebox-get style-node :width))) + (not (let ((old-content + (plist-get (plist-get entry :old-signature) + :content)) + (new-content + (plist-get (plist-get entry :new-signature) + :content))) + (and (stringp old-content) + (stringp new-content) + (= (length old-content) (length new-content))))) + (not (and ebox-incremental--candidate-state-for-slot-proof + (or + (ebox-incremental--fast-grid-slot-evidence + buffer entry + ebox-incremental--candidate-state-for-slot-proof) + (ebox-incremental--allocated-parent-slot-stable-p + buffer entry + ebox-incremental--candidate-state-for-slot-proof))))) + (cl-pushnew 'parent-layout impacts)) (nreverse impacts))) (defun ebox--dirty-entry-requires-owned-overflow-coverage-p (buffer entry) @@ -2780,7 +2889,7 @@ cross-axis keys change its row footprint, exactly the pair (lambda (child) (when-let ((source (ebox--flex-item-source-node child))) (equal (plist-get source :node-id) node-id))) - (plist-get flex-node :children))) + (ebox-tree-layout-children flex-node))) (defun ebox--flex-cross-axis (axis) "Return the axis perpendicular to flex AXIS." @@ -2940,12 +3049,16 @@ tolerable only while the slot is anchored at the item's own declared main size: a descendant's size-family change flows into the item's content minimum, and an allocation decided by that minimum (or by grow/shrink) legitimately changes with it, so a slot-preserving -publication would freeze stale sibling geometry." + publication would freeze stale sibling geometry." + (ignore own-change) (and (ebox--direct-flex-parent-p buffer node-id) (or (not (ebox--flex-item-footprint-keys-p buffer node-id changed-keys)) - (and (not own-change) - (ebox--flex-item-slot-at-declared-main-p buffer node-id))) + ;; A definite item whose published slot equals its declared main + ;; size remains allocation-stable even when its own content changes. + ;; The following slot-footprint proof still renders the candidate + ;; in that size and rejects wrapping/overflow/parent-slot misses. + (ebox--flex-item-slot-at-declared-main-p buffer node-id)) (ebox--cached-flex-item-slot-footprint-safe-p buffer node-id changed-keys))) @@ -3029,11 +3142,22 @@ running expensive span and snapshot checks." (defun ebox--span-patchable-owner-p (buffer node-id) "Return non-nil when NODE-ID can attempt verified span patching." - (when-let* ((node (ebox--buffer-runtime-node buffer node-id)) - (snapshot (ebox--ensure-layout-snapshot-spans buffer node-id)) - (spans (plist-get snapshot :buffer-spans))) - (and spans - (not (ebox--node-visible-overflow-p node))))) + (when-let ((node (ebox--buffer-runtime-node buffer node-id))) + (and ;; Planning only needs to reject an explicitly visible overflow + ;; owner. Content-dependent overflow remains part of the final + ;; span/role validator; formatting it here for every ancestor made + ;; owner selection pay the expensive proof twice. + (not (eq (ebox-get node :overflow) 'visible)) + (or + ;; Allocation shape is coordinate-independent and survives a + ;; detail-generation bump. The later owner/surface proof still + ;; resolves exact current spans before publication. + (when-let ((snapshot (ebox--layout-snapshot buffer node-id))) + (plist-get snapshot :allocation-shape)) + (when-let* ((snapshot + (ebox--ensure-layout-snapshot-spans buffer node-id)) + (spans (plist-get snapshot :buffer-spans))) + spans))))) (defun ebox--promote-to-patchable-owner (buffer node-id &optional dirty-kind changed-keys impact-vector) @@ -3147,6 +3271,8 @@ running expensive span and snapshot checks." (unless (ebox--impact-vector-requires-conservative-owner-p impact-vector) (cond ((and (ebox--dirty-entry-span-patch-candidate-p buffer entry) + (not (ebox--impact-vector-requires-parent-promotion-p + impact-vector)) (not (cl-some (lambda (key) (memq key ebox--span-patch-border-box-block-keys)) @@ -3726,8 +3852,48 @@ during `ebox-incremental-flush'." :base-buffer-tick (with-current-buffer buffer (buffer-modified-tick)) :replacements nil + :range-replacements nil + :range-metrics nil :sealed-p nil))) +(defun ebox-incremental-candidate-replace-range-ref (candidate ref next-items) + "Record a last-wins base Range REF replacement with NEXT-ITEMS." + (unless (ebox-candidate-p candidate) + (error "Ebox Range replacement requires an Ebox candidate")) + (when (ebox-candidate--sealed-p candidate) + (error "Ebox candidate is already sealed")) + (unless (proper-list-p next-items) + (signal 'wrong-type-argument (list 'proper-list-p next-items))) + (unless (gethash ref (plist-get (ebox-candidate--base-state candidate) + :range-ref-table)) + (error "Ebox candidate Range ref does not exist in its base: %S" ref)) + (dolist (item next-items) + (unless (and (listp item) (not (stringp item))) + (error "Ebox child Range item must be a declarative node")) + (cl-labels ((reject-range + (node) + (when (ebox-child-range--descriptor-p node) + (error "Range replacement payload cannot introduce a Range")) + (when (and (listp node) (not (stringp node))) + (dolist (child (ebox-tree--children-raw node)) + (reject-range child))))) + (reject-range item))) + (ebox-tree-validate-declarative-root + (list :ebox-type 'stack :display '(block column) :children next-items)) + (let ((owned + (mapcar (lambda (item) + (ebox-tree-clear-runtime-identities + (ebox-tree-copy-node-structure item))) + next-items))) + (setf (ebox-candidate--range-replacements candidate) + (append + (cl-remove ref (ebox-candidate--range-replacements candidate) + :key #'ebox-incremental--candidate-range-replacement-ref + :test #'equal) + (list (ebox-incremental--make-candidate-range-replacement + :ref ref :items owned))))) + candidate) + (defun ebox-incremental--candidate-ancestor-p (candidate ancestor-id descendant-id) "Return non-nil when ANCESTOR-ID contains DESCENDANT-ID in CANDIDATE's base." @@ -3779,17 +3945,36 @@ detached semantic variants of this stable anchor for bounded identity reuse." (ebox-incremental--candidate-ancestor-p candidate node-id existing-id)) (push entry retained)))) - (setf (ebox-candidate--replacements candidate) - (append - (nreverse retained) - (list - (ebox-incremental--make-candidate-replacement - :anchor-id node-id - :subtree replacement - :old-semantic-key old-semantic-key - :new-semantic-key new-semantic-key))))) + (let* ((root-id (plist-get (ebox-candidate--base-root candidate) + :node-id)) + (root-replaced-p + (cl-find root-id (ebox-candidate--replacements candidate) + :key + #'ebox-incremental--candidate-replacement-anchor-id + :test #'equal))) + (unless (and root-replaced-p (not (equal node-id root-id))) + (setf (ebox-candidate--replacements candidate) + (append + (nreverse retained) + (list + (ebox-incremental--make-candidate-replacement + :anchor-id node-id + :subtree replacement + :old-semantic-key old-semantic-key + :new-semantic-key new-semantic-key))))))) candidate)) +(defun ebox-incremental-candidate-replace-root (candidate next-root) + "Replace CANDIDATE's implicit base root with declarative NEXT-ROOT. +The root address is candidate-local and cannot collide with host references. +Root replacement is last-wins and absorbs every descendant replacement." + (unless (ebox-candidate-p candidate) + (error "Ebox root replacement requires an Ebox candidate")) + (ebox-incremental-candidate-replace + candidate + (plist-get (ebox-candidate--base-root candidate) :node-id) + next-root)) + (defun ebox-incremental-candidate-replace-host-ref (candidate host-ref next-subtree &optional old-semantic-key new-semantic-key) @@ -3947,6 +4132,117 @@ use their ordinary isolated-copy path." root owner-id replacement (list :node-table node-table :parent-table parent-table)))))) +(defun ebox-incremental--candidate-path-copy-overlap-many + (root index replacements) + "Return ROOT with possibly nested node-id REPLACEMENTS merged bottom-up. +Unlike `ebox-incremental--candidate-path-copy-many', this helper accepts an +ancestor and its descendant in the same replacement set. A node-local +replacement is applied first, then candidate-owned child paths are installed +into that local copy. Consequently one copied ancestor contains both its own +mutation and every nested mutation, while untouched sibling subtrees remain +shared with the published generation." + (let* ((node-table (plist-get index :node-table)) + (parent-table (plist-get index :parent-table)) + (affected (make-hash-table :test 'equal)) + (children (make-hash-table :test 'equal)) + affected-ids) + (maphash + (lambda (node-id _replacement) + (unless (gethash node-id node-table) + (error "Ebox candidate path-copy node is absent: %S" node-id)) + (let ((current node-id)) + (while current + (unless (gethash current affected) + (puthash current t affected) + (push current affected-ids)) + (setq current (gethash current parent-table))))) + replacements) + (let ((depths (make-hash-table :test 'equal))) + (cl-labels + ((depth + (node-id) + (or (gethash node-id depths) + (let ((current node-id) path (result -1)) + (while (and current (not (gethash current depths))) + (push current path) + (setq current (gethash current parent-table))) + (when current + (setq result (gethash current depths))) + (dolist (path-id path) + (puthash path-id (cl-incf result) depths)) + (gethash node-id depths))))) + (setq affected-ids + (sort affected-ids + (lambda (left right) + (> (depth left) (depth right))))))) + (let (result) + (dolist (node-id affected-ids) + (let* ((old-node (gethash node-id node-table)) + (local (or (gethash node-id replacements) old-node)) + (child-replacements (gethash node-id children)) + (candidate + (if child-replacements + (ebox-tree-copy-with-direct-child-replacements + local child-replacements) + local)) + (parent-id (gethash node-id parent-table))) + (ebox-incremental--candidate-record-path-copy + node-id candidate parent-id (gethash node-id replacements) nil) + (if parent-id + (puthash parent-id + (cons (cons old-node candidate) + (gethash parent-id children)) + children) + (setq result candidate)))) + (or result root)))) + +(defun ebox-incremental-surface-scroll-offsets-candidate-root + (buffer region-offsets) + "Return one path-copied BUFFER root carrying REGION-OFFSETS. +REGION-OFFSETS is an alist of region ids and canonical numeric offsets. The +regions may be nested; their owner paths are merged into one candidate root +without mutating the published generation. Return nil when any region cannot +be resolved through the retained runtime indexes." + (let* ((state (ebox--buffer-render-state buffer)) + (root (plist-get state :root-node)) + (node-table (plist-get state :node-table)) + (parent-table (plist-get state :parent-table)) + (region-node-table (plist-get state :region-node-table)) + (replacements (make-hash-table :test 'equal)) + valid) + (setq valid (and root (hash-table-p node-table) + (hash-table-p parent-table) + (hash-table-p region-node-table))) + (dolist (entry region-offsets) + (when valid + (let* ((region-id (car entry)) + (offset (cdr entry)) + (owner-id (gethash region-id region-node-table)) + (owner (and owner-id (gethash owner-id node-table))) + (box + (pcase (and owner (plist-get owner :ebox-type)) + ('box owner) + ((or 'flex 'grid) (plist-get owner :box))))) + (if (and owner-id owner box + (numberp offset) + (equal (plist-get box :region-id) region-id) + (not (gethash owner-id replacements))) + (let* ((candidate-box (copy-sequence box)) + (_ (ebox-put candidate-box :scroll-offset offset)) + (_ (plist-put candidate-box + :ebox-scroll-offset-controlled-p t)) + (replacement + (if (eq owner box) + candidate-box + (ebox-tree-copy-with-direct-child-replacements + owner (list (cons box candidate-box)))))) + (puthash owner-id replacement replacements)) + (setq valid nil))))) + (when (and valid (> (hash-table-count replacements) 0)) + (ebox-incremental--candidate-path-copy-overlap-many + root (list :node-table node-table :parent-table parent-table) + replacements)))) + (defun ebox-incremental--candidate-path-copy-many (root index replacements) "Return ROOT with node-id REPLACEMENTS applied by one bottom-up path copy." @@ -4078,7 +4374,13 @@ Cost is proportional to the replacements, never to the page." #'ebox-incremental--candidate-replacement-anchor-id entries))) (cl-labels - ((inside-replaced-anchor-p (node-id) + ((ancestor-p (ancestor descendant) + (let ((walk descendant) found) + (while (and walk (not found)) + (setq found (equal walk ancestor) + walk (and (not found) (gethash walk parent-table)))) + found)) + (inside-replaced-anchor-p (node-id) (let ((walk node-id)) (while (and walk (not (member walk anchor-ids))) (setq walk (gethash walk parent-table))) @@ -4120,12 +4422,13 @@ Cost is proportional to the replacements, never to the page." ;; Host refs must be fresh or freed by this same commit. (when host-ref-table (dolist (ref (collect-host-refs replacement nil)) - (let ((count (hash-table-count replacement-host-refs))) - (puthash ref t replacement-host-refs) - (when (= count (hash-table-count replacement-host-refs)) - (error - "Ebox declarative host reference %S is not unique" - ref))) + (when-let ((existing-anchor + (gethash ref replacement-host-refs))) + (unless (or (ancestor-p existing-anchor node-id) + (ancestor-p node-id existing-anchor)) + (error "Ebox declarative host reference %S is not unique" + ref))) + (puthash ref node-id replacement-host-refs) (when-let ((owner-id (gethash ref host-ref-table))) (unless (inside-replaced-anchor-p owner-id) (error @@ -4239,7 +4542,7 @@ Use candidate-owned HISTORY for detached identity reuse." (ebox-tree-reconcile-runtime old-anchor replacement)))))) (ebox-incremental--candidate-replacement-subtree entry)) -(defun ebox-incremental--candidate-logical-root +(defun ebox-incremental--candidate-node-logical-root (candidate &optional detached-history) "Return CANDIDATE's complete logical root without copying unchanged subtrees. DETACHED-HISTORY receives identity snapshots for semantic replacements." @@ -4308,6 +4611,279 @@ DETACHED-HISTORY receives identity snapshots for semantic replacements." root node-id replacement index)))) root))))) +(defun ebox-incremental--candidate-reconcile-range-items + (sequence ref items) + "Reconcile candidate ITEMS for REF against keyed/unkeyed SEQUENCE peers." + (let* ((segment (ebox-child-range--lookup-ref sequence ref)) + (old-payload (and segment (ebox-child-range--segment-payload segment))) + (key-root (ebox-child-range--sequence-key-root sequence)) + (hash-function (ebox-child-range--sequence-hash-function sequence))) + (cl-loop for item in items for offset from 0 do + (let* ((key (plist-get item :key)) + (location + (and key + (ebox-child-range--hash-lookup + key-root key (funcall hash-function key)))) + (old + (if location + (let ((peer (ebox-child-range--segment-at + sequence (car location)))) + (aref (ebox-child-range--segment-payload peer) + (cdr location))) + (and old-payload (< offset (length old-payload)) + (aref old-payload offset))))) + (when (and old key (null (plist-get old :key))) (setq old nil)) + (when (and old (null key) (plist-get old :key)) (setq old nil)) + (ebox-tree-reconcile-runtime old item))) + items)) + +(defun ebox-incremental--candidate-current-node (state node-id) + "Return current candidate NODE-ID from path trace or base STATE." + (or (plist-get (gethash node-id ebox-incremental--candidate-path-copy-trace) + :node) + (gethash node-id (plist-get state :node-table)))) + +(defun ebox-incremental--candidate-range-ref-overlay (old-state path-trace) + "Return Range ref table updated only for node anchors in PATH-TRACE." + (if (not (hash-table-p path-trace)) + (plist-get old-state :range-ref-table) + (let ((parent-table (plist-get old-state :parent-table)) anchors) + (maphash + (lambda (base-id trace) + (when (plist-get trace :anchor-p) + (push (cons base-id (plist-get trace :node)) anchors))) + path-trace) + (let ((anchor-set (make-hash-table :test #'equal))) + (dolist (anchor anchors) (puthash (car anchor) t anchor-set)) + (setq anchors + (cl-delete-if + (lambda (anchor) + (let ((walk (gethash (car anchor) parent-table)) found) + (while (and walk (not found)) + (setq found (gethash walk anchor-set) + walk (and (not found) (gethash walk parent-table)))) + found)) + anchors))) + (if (null anchors) + (plist-get old-state :range-ref-table) + (let ((table (copy-hash-table (plist-get old-state :range-ref-table)))) + (cl-labels + ((walk (node function) + (when-let ((sequence (plist-get node :ebox-child-sequence))) + (dolist (record (ebox-child-range--range-records sequence)) + (funcall function node record))) + (dolist (child (ebox-tree--children-raw node)) + (walk child function)))) + (dolist (anchor anchors) + (when-let ((old (gethash (car anchor) + (plist-get old-state :node-table)))) + (walk old + (lambda (_parent record) + (remhash (car record) table))))) + (dolist (anchor anchors) + (walk + (cdr anchor) + (lambda (parent record) + (let ((ref (car record))) + (when (gethash ref table) + (error "Ebox child Range ref is not unique: %S" ref)) + (puthash ref + (list :parent-node-id (plist-get parent :node-id) + :segment-index (nth 1 record)) + table)))))) + table))))) + +(defun ebox-incremental--candidate-path-copy-overlay + (root node-id replacement state) + "Path-copy NODE-ID in ROOT using STATE tables plus the candidate trace." + (let* ((parent-table (plist-get state :parent-table)) + (old-child (ebox-incremental--candidate-current-node state node-id)) + (new-child replacement) + (parent-id (gethash node-id parent-table))) + (ebox-incremental--candidate-record-path-copy + node-id replacement parent-id t t) + (while parent-id + (let* ((current-parent-id parent-id) + (old-parent + (ebox-incremental--candidate-current-node state current-parent-id)) + (sequence (plist-get old-parent :ebox-child-sequence)) + (location (and sequence + (plist-get old-child :ebox-sequence-location))) + (new-parent + (if location + (let ((copy (copy-sequence old-parent))) + (plist-put + copy :ebox-child-sequence + (ebox-child-range--replace-item-at + sequence (plist-get location :segment-index) + (plist-get location :offset) old-child new-child))) + (ebox-tree-copy-with-direct-child-replacements + old-parent (list (cons old-child new-child))))) + (grandparent-id (gethash current-parent-id parent-table))) + (ebox-incremental--candidate-record-path-copy + current-parent-id new-parent grandparent-id nil t) + (setq old-child old-parent new-child new-parent + parent-id grandparent-id))) + (if (equal node-id (plist-get root :node-id)) replacement new-child))) + +(defun ebox-incremental--candidate-apply-range-replacements (candidate root) + "Apply CANDIDATE Range replacements to ROOT without flattening a parent." + (let* ((entries (ebox-candidate--range-replacements candidate)) + (state (ebox-candidate--base-state candidate)) + (base-ranges (plist-get state :range-ref-table)) + (root-id (plist-get (ebox-candidate--base-root candidate) :node-id)) + (root-replaced + (cl-find root-id (ebox-candidate--replacements candidate) + :key #'ebox-incremental--candidate-replacement-anchor-id + :test #'equal)) + metrics) + (unless root-replaced + (let ((groups (make-hash-table :test #'equal)) order) + (dolist (entry entries) + (let* ((record (gethash + (ebox-incremental--candidate-range-replacement-ref entry) + base-ranges)) + (parent-id (plist-get record :parent-node-id)) + (absorbed + (cl-some + (lambda (node-entry) + (let ((anchor + (ebox-incremental--candidate-replacement-anchor-id + node-entry))) + (or (equal anchor parent-id) + (ebox-incremental--candidate-ancestor-p + candidate anchor parent-id)))) + (ebox-candidate--replacements candidate)))) + (unless absorbed + (unless (gethash parent-id groups) (push parent-id order)) + (push entry (gethash parent-id groups))))) + (dolist (parent-id (nreverse order)) + (let* ((parent (ebox-incremental--candidate-current-node + state parent-id)) + (base-parent (gethash parent-id (plist-get state :node-table))) + (base-sequence + (and base-parent + (plist-get base-parent :ebox-child-sequence))) + (sequence (and parent (plist-get parent :ebox-child-sequence))) + replacements) + ;; A node/Host ancestor replacement removes or supersedes the base + ;; Range address and therefore wins coalescing. + (when sequence + (dolist (entry (nreverse (gethash parent-id groups))) + (let ((ref + (ebox-incremental--candidate-range-replacement-ref entry))) + (when (ebox-child-range--lookup-ref sequence ref) + (let ((items + (ebox-incremental--candidate-range-replacement-items + entry))) + (ebox-incremental--candidate-reconcile-range-items + sequence ref items) + (let ((segment-index + (plist-get (gethash ref base-ranges) + :segment-index))) + (cl-loop for item in items for offset from 0 do + (plist-put + item :ebox-sequence-location + (list :parent-node-id parent-id + :segment-index segment-index + :offset offset)))) + (push (cons ref items) replacements))))) + (when replacements + (let* ((ordered-replacements (nreverse replacements)) + (old-payloads + (mapcar + (lambda (replacement) + (append + (ebox-child-range--segment-payload + (ebox-child-range--lookup-ref + base-sequence (car replacement))) nil)) + ordered-replacements)) + (result (ebox-child-range--replace-many + sequence ordered-replacements)) + (new-payloads + (mapcar + (lambda (replacement) + (append + (ebox-child-range--segment-payload + (ebox-child-range--lookup-ref + (car result) (car replacement))) nil)) + ordered-replacements)) + (new-parent (copy-sequence parent))) + (plist-put new-parent :ebox-child-sequence (car result)) + (push (ebox-child-range--metrics-plist (cdr result)) metrics) + (setq root + (ebox-incremental--candidate-path-copy-overlay + root parent-id new-parent state)) + (let ((trace (gethash parent-id + ebox-incremental--candidate-path-copy-trace))) + (plist-put trace :anchor-p nil)) + (push (list :old-parent base-parent :new-parent new-parent + :parent-id parent-id + :old-payloads old-payloads + :new-payloads new-payloads) + ebox-incremental--candidate-range-index-deltas)))))))) + (setf (ebox-candidate--range-metrics candidate) (nreverse metrics)) + root)) + +(defun ebox-incremental--candidate-logical-root + (candidate &optional detached-history) + "Return CANDIDATE root after node/Host and child Range coalescing." + (let* ((original-nodes (ebox-candidate--replacements candidate)) + (original-ranges (ebox-candidate--range-replacements candidate)) + surviving-ranges absorbed) + (dolist (range original-ranges) + (let* ((record + (gethash (ebox-incremental--candidate-range-replacement-ref range) + (plist-get (ebox-candidate--base-state candidate) + :range-ref-table))) + (parent-id (plist-get record :parent-node-id)) + (host-wins + (cl-some + (lambda (node-entry) + (let ((anchor + (ebox-incremental--candidate-replacement-anchor-id + node-entry))) + (or (equal anchor parent-id) + (ebox-incremental--candidate-ancestor-p + candidate anchor parent-id)))) + original-nodes))) + (unless host-wins (push range surviving-ranges)))) + (setq surviving-ranges (nreverse surviving-ranges)) + (dolist (range surviving-ranges) + (let* ((record + (gethash (ebox-incremental--candidate-range-replacement-ref range) + (plist-get (ebox-candidate--base-state candidate) + :range-ref-table))) + (parent (gethash (plist-get record :parent-node-id) + (plist-get (ebox-candidate--base-state candidate) + :node-table))) + (segment (and parent + (ebox-child-range--segment-at + (plist-get parent :ebox-child-sequence) + (plist-get record :segment-index))))) + (dolist (item (and segment + (append (ebox-child-range--segment-payload segment) + nil))) + (cl-labels ((collect (node) + (push (plist-get node :node-id) absorbed) + (dolist (child (ebox-tree--children-raw node)) + (collect child)))) + (collect item))))) + (setf (ebox-candidate--replacements candidate) + (cl-remove-if + (lambda (entry) + (member (ebox-incremental--candidate-replacement-anchor-id entry) + absorbed)) + original-nodes) + (ebox-candidate--range-replacements candidate) surviving-ranges) + (unwind-protect + (ebox-incremental--candidate-apply-range-replacements + candidate + (ebox-incremental--candidate-node-logical-root + candidate detached-history)) + (setf (ebox-candidate--replacements candidate) original-nodes + (ebox-candidate--range-replacements candidate) original-ranges)))) + (defun ebox-incremental-consume-candidate (buffer-or-name candidate) "Consume CANDIDATE for BUFFER-OR-NAME and return its pure surface input. The returned plist contains the prepared root, Ebox plan report, identity @@ -4586,6 +5162,7 @@ Return the same pure surface-input shape as :region-box-table (ebox-incremental--candidate-region-box-table state) :host-ref-table (plist-get state :host-ref-table) + :range-ref-table (plist-get state :range-ref-table) :selector-id-table (plist-get state :selector-id-table) :selector-class-table (plist-get state :selector-class-table) :selector-type-table (plist-get state :selector-type-table) @@ -4702,7 +5279,7 @@ complete preorder first-owner and postorder last-box semantics." nil))) (defun ebox-incremental--candidate-dirty-set-from-touched - (old-state candidate-root touched) + (old-state candidate-root touched &optional range-delta-table) "Return declarative dirty entries for path-local TOUCHED nodes." (let ((old-root (plist-get old-state :root-node)) dirty) @@ -4721,6 +5298,10 @@ complete preorder first-owner and postorder last-box semantics." (when old-node (let* ((changed-keys (ebox-tree-node-local-changed-keys old-node new-node)) + (range-delta + (and range-delta-table + (gethash (plist-get new-node :node-id) + range-delta-table))) (kind (cond (children-changed 'structure) @@ -4738,16 +5319,29 @@ complete preorder first-owner and postorder last-box semantics." changed-keys) :old-region-ids (and children-changed - (ebox--node-all-region-ids old-node)) + (if range-delta + (apply #'append + (mapcar #'ebox--node-all-region-ids + (apply #'append + (plist-get range-delta + :old-payloads)))) + (ebox--node-all-region-ids old-node))) :new-region-ids (and children-changed - (ebox--node-all-region-ids new-node)) + (if range-delta + (apply #'append + (mapcar #'ebox--node-all-region-ids + (apply #'append + (plist-get range-delta + :new-payloads)))) + (ebox--node-all-region-ids new-node))) :old-signature (ebox-tree-node-local-source-signature old-node) :new-signature (ebox-tree-node-local-source-signature new-node)) - (ebox-incremental--child-change-props - old-node new-node children-changed)) + (unless range-delta + (ebox-incremental--child-change-props + old-node new-node children-changed))) dirty)))))) (nreverse dirty)))) @@ -4775,7 +5369,7 @@ complete preorder first-owner and postorder last-box semantics." :removed-count (length removed)))) (defun ebox-incremental--candidate-local-index-delta - (old-state candidate-root &optional path-copy-trace) + (old-state candidate-root &optional path-copy-trace range-index-deltas) "Return local indexes and dirty entries for CANDIDATE-ROOT. Traversal stops at every node that is `eq' to OLD-STATE's indexed node. The @@ -4835,6 +5429,19 @@ replace those O(n) table copies without changing this delta contract." (remove-old-subtree old-child))))) (dolist (child (ebox--node-children node)) (visit-new child node-id))))))) + (dolist (delta range-index-deltas) + (let* ((old-parent (plist-get delta :old-parent)) + (new-parent (plist-get delta :new-parent)) + (parent-id (plist-get delta :parent-id))) + (puthash parent-id t visited-new) + (record-touched old-parent new-parent + (gethash parent-id + (plist-get old-state :parent-table)) + t) + (dolist (payload (plist-get delta :old-payloads)) + (dolist (node payload) (remove-old-subtree node))) + (dolist (payload (plist-get delta :new-payloads)) + (dolist (node payload) (visit-new node parent-id))))) (if (and (hash-table-p path-copy-trace) (> (hash-table-count path-copy-trace) 0)) (progn @@ -4881,7 +5488,8 @@ replace those O(n) table copies without changing this delta contract." (lambda (node) (gethash (plist-get node :node-id) visited-new)) (nreverse removed))) - (if (ebox-incremental--candidate-full-index-p old-state touched) + (if (and (null range-index-deltas) + (ebox-incremental--candidate-full-index-p old-state touched)) (ebox-incremental--candidate-full-index-preparation old-state candidate-root touched removed) (progn @@ -5034,20 +5642,27 @@ replace those O(n) table copies without changing this delta contract." (ebox-incremental--candidate-recompute-regions candidate-root ambiguous-region-ids region-id-set region-node-table region-box-table)) - (let* ((dirty-set + (let* ((range-delta-table (make-hash-table :test #'equal)) + (_range-deltas + (dolist (delta range-index-deltas) + (puthash (plist-get delta :parent-id) delta + range-delta-table))) + (dirty-set (ebox-incremental--candidate-dirty-set-from-touched - old-state candidate-root touched)) + old-state candidate-root touched range-delta-table)) (structure-p (cl-some (lambda (entry) (eq (plist-get entry :dirty-kind) 'structure)) dirty-set)) (native-node-postorder - (if structure-p + (if range-index-deltas + (plist-get old-state :native-node-postorder) + (if structure-p (ebox-incremental--candidate-native-postorder candidate-root) - (ebox-incremental--candidate-map-native-postorder - old-state node-table))) + (ebox-incremental--candidate-map-native-postorder + old-state node-table)))) (index (list :node-table node-table :parent-table parent-table @@ -5056,6 +5671,9 @@ replace those O(n) table copies without changing this delta contract." :region-box-count-table region-box-count-table :region-box-table region-box-table :host-ref-table host-ref-table + :range-ref-table + (ebox-incremental--candidate-range-ref-overlay + old-state path-copy-trace) ;; Paths contain ancestor objects, so a path copy makes ;; selector indexes stale even when selector metadata ;; itself did not change. Rebuild on first query. @@ -5189,7 +5807,8 @@ candidate therefore owns its cache tables until TP commits the generation." (:layout-snapshots ,(plist-get prepared :layout-snapshots)) (:layout-snapshots-complete-p nil) (:layout-snapshot-detail-generation - ,(or (plist-get old-state :layout-snapshot-detail-generation) + ,(or (plist-get prepared :layout-snapshot-detail-generation) + (plist-get old-state :layout-snapshot-detail-generation) 0)) (:runtime-revision ,(1+ (or (plist-get old-state :runtime-revision) 0))) @@ -5233,6 +5852,8 @@ candidate therefore owns its cache tables until TP commits the generation." ,(plist-get candidate-index :region-box-table)) (:host-ref-table ,(plist-get candidate-index :host-ref-table)) + (:range-ref-table + ,(plist-get candidate-index :range-ref-table)) (:selector-id-table ,(plist-get candidate-index :selector-id-table)) (:selector-class-table @@ -5327,7 +5948,7 @@ must be recomputed in the next publication." (defun ebox-incremental--prepare-declarative-runtime (buffer old-state candidate-root &optional logical-candidate-p - local-preparation) + local-preparation scroll-patch-p) "Prepare CANDIDATE-ROOT for BUFFER without mutating its published runtime." (let* ((old-root (plist-get old-state :root-node)) (render-cache @@ -5383,10 +6004,22 @@ must be recomputed in the next publication." (ebox-incremental--candidate-scroll-state-table buffer old-state candidate-index candidate-region-box-table)) (layout-snapshots - (ebox-incremental--candidate-layout-snapshots - old-state candidate-root candidate-index))) + (if scroll-patch-p + ;; Scroll changes every buffer-dependent span coordinate. + ;; Keep the candidate snapshot table empty and let the + ;; next non-scroll proof lazily recapture only the nodes it + ;; needs; carrying old detail plists would make hidden + ;; descendants point past the new visible buffer. + (make-hash-table :test 'equal) + (ebox-incremental--candidate-layout-snapshots + old-state candidate-root candidate-index)))) (list :root candidate-root :logical-candidate-p logical-candidate-p + :range-metrics (plist-get local-preparation :range-metrics) + :range-replacement-count + (plist-get local-preparation :range-replacement-count) + :runtime-index-complete-p + (plist-get local-preparation :runtime-index-complete-p) :index candidate-index :dirty-set dirty-set :display-signature current-display-signature @@ -5401,6 +6034,11 @@ must be recomputed in the next publication." :viewport-height-dependent-subtree-cache viewport-height-dependent-subtree-cache :layout-snapshots layout-snapshots + :layout-snapshot-detail-generation + (and scroll-patch-p + (1+ (or (plist-get old-state + :layout-snapshot-detail-generation) + 0))) :scroll-state-table candidate-scroll-state-table)))))) (defun ebox-incremental--prepare-declarative-root @@ -5426,14 +6064,18 @@ must be recomputed in the next publication." (let* ((path-copy-trace (make-hash-table :test 'equal)) (detached-history (ebox-incremental--copy-detached-history old-state)) + range-index-deltas (candidate-root - (let ((ebox-incremental--candidate-path-copy-trace - path-copy-trace)) - (ebox-incremental--candidate-logical-root - candidate detached-history))) + (let ((ebox-incremental--candidate-path-copy-trace path-copy-trace) + (ebox-incremental--candidate-range-index-deltas nil)) + (prog1 + (ebox-incremental--candidate-logical-root + candidate detached-history) + (setq range-index-deltas + ebox-incremental--candidate-range-index-deltas)))) (local-preparation (ebox-incremental--candidate-local-index-delta - old-state candidate-root path-copy-trace))) + old-state candidate-root path-copy-trace range-index-deltas))) ;; Replaced subtrees were validated when they were recorded; the ;; untouched published remainder was validated when it was itself ;; published, and path copying introduces no new sibling or ref @@ -5442,6 +6084,15 @@ must be recomputed in the next publication." (setq local-preparation (plist-put local-preparation :detached-identity-history detached-history)) + (setq local-preparation + (plist-put local-preparation :range-metrics + (copy-tree (ebox-candidate--range-metrics candidate)))) + (setq local-preparation + (plist-put local-preparation :range-replacement-count + (length (ebox-candidate--range-replacements candidate)))) + (when (ebox-candidate--range-replacements candidate) + (setq local-preparation + (plist-put local-preparation :runtime-index-complete-p t))) (ebox-incremental--prepare-declarative-runtime buffer old-state candidate-root t local-preparation))) @@ -5559,6 +6210,298 @@ render whose line count moved is unpublishable there by construction." (ebox--runtime-parent-id buffer ancestor-id)))) ancestor-id)) +(defun ebox-incremental--formatting-context-reflow-node-p (node) + "Return non-nil when NODE is a material local block context. +The first variable-line slice accepts a real column/stack node or a material +box whose child layout is a column. Flex/Grid allocation contexts remain +outside this proof and continue through the ordinary conservative owner path." + (or (eq (ebox-tree-display-inner node) 'column) + (and (eq (plist-get node :ebox-type) 'box) + (plist-get node :ebox-content-node) + (eq (ebox-tree-display-inner + (plist-get node :ebox-content-node)) + 'column)))) + +(defun ebox-incremental--formatting-context-reflow-fast-eligible-p + (buffer old-state _candidate-state candidate-id root-id) + "Return non-nil when a whole-line context proof is worth entering. +Use the already-published snapshot shape as a cheap negative filter. Partial +Grid/card slots are handled by the fixed-slot span proof; they must not pay +the expensive parent-context mount and role scan first." + (let ((parents (plist-get old-state :parent-table)) + (node-id candidate-id) + eligible) + (while (and node-id (not (equal node-id root-id)) (not eligible)) + (let* ((node (gethash node-id (plist-get old-state :node-table))) + (formatting-p + (and node + (ebox-incremental--formatting-context-reflow-node-p node))) + (snapshot + (and formatting-p + (ebox-incremental--cached-layout-snapshot-details + buffer node-id))) + (spans (and snapshot (plist-get snapshot :buffer-spans)))) + (if (not formatting-p) + ;; A Grid/Flex/row allocator between the dirty LCA and a whole + ;; line context is exactly the boundary this proof refuses. + (setq node-id nil) + (when (and spans + (with-current-buffer buffer + (ebox--line-spans-cover-whole-lines-p spans))) + (setq eligible t)) + (unless eligible + (setq node-id (gethash node-id parents))))) + ) + eligible)) + +(defun ebox-incremental--formatting-context-reflow-proof + (buffer old-state candidate-state prepared) + "Return a strict parent-formatting-context proof for PREPARED. +The proof is intentionally narrow: multiple geometry/content owners, stable +topology and parent allocation, no scroll/cascade/overflow, and a whole-line +material block under normal column flow. The returned owner may change block +line count; its outside siblings are shifted by the one scoped replacement." + (let* ((dirty-set (plist-get prepared :dirty-set)) + (node-ids + (delete-dups + (cl-mapcan #'ebox--dirty-provenance-node-ids dirty-set))) + (root-id (ebox--buffer-root-node-id buffer)) + (parents (plist-get old-state :parent-table)) + (candidate-parents (plist-get candidate-state :parent-table)) + (candidate-id + (and (>= (length dirty-set) 2) + (ebox-incremental--common-runtime-ancestor-id + buffer node-ids))) + proof) + (when (and candidate-id + (not (equal candidate-id root-id)) + (ebox-incremental--formatting-context-reflow-fast-eligible-p + buffer old-state candidate-state candidate-id root-id) + (null (plist-get old-state :scroll-region-ids)) + (not (plist-get old-state :cascade-active-p)) + (or (not (plist-get old-state :cascade-required-p)) + (ebox-surface--cascade-local-owner-proof-p + old-state candidate-state dirty-set)) + (cl-every + (lambda (entry) + (and (eq (plist-get entry :dirty-kind) 'geometry) + (not (plist-get entry :children)) + (null (plist-get entry :node-ids)) + (cl-every + (lambda (key) + (or (eq key :content) + (eq key :surface-properties) + (memq key ebox--paint-style-signature-keys))) + (plist-get entry :changed-keys)))) + dirty-set)) + (while (and candidate-id (not proof) + (not (equal candidate-id root-id))) + (let* ((old-node (gethash candidate-id + (plist-get old-state :node-table))) + (new-node (gethash candidate-id + (plist-get candidate-state :node-table))) + (parent-id (gethash candidate-id parents)) + (snapshot + (and old-node + (ebox--ensure-layout-snapshot-details + buffer candidate-id))) + (spans (and snapshot (plist-get snapshot :buffer-spans))) + (block-span + (when-let* ((object-table + (plist-get old-state + :surface-node-object-table)) + (object (gethash candidate-id object-table)) + (mounts (tp-object-mounts object))) + (cons (apply #'min (mapcar (lambda (mount) + (plist-get mount :start)) + mounts)) + (apply #'max (mapcar (lambda (mount) + (plist-get mount :end)) + mounts))))) + (parent (and parent-id + (gethash parent-id + (plist-get old-state :node-table)))) + (parent-new (and parent-id + (gethash parent-id + (plist-get candidate-state :node-table)))) + (ancestors-stable-p t) + (walk parent-id)) + (while (and walk ancestors-stable-p (not (equal walk root-id))) + (let ((ancestor (gethash walk (plist-get old-state :node-table)))) + (when (or (not ancestor) + (memq (ebox-tree-display-inner ancestor) '(row flex grid)) + (ebox-tree-node-visible-overflow-p ancestor)) + (setq ancestors-stable-p nil))) + (setq walk (gethash walk parents))) + (when (and old-node new-node parent parent-new + (ebox-incremental--formatting-context-reflow-node-p + old-node) + (equal (gethash candidate-id parents) + (gethash candidate-id candidate-parents)) + (ebox-incremental--node-child-ids-equal-p + old-node new-node) + (equal (ebox-incremental--layout-slot-style-signature + old-node) + (ebox-incremental--layout-slot-style-signature + new-node)) + (numberp (ebox-get old-node :width)) + (= (ebox-get old-node :width) + (ebox-get new-node :width)) + (eq (ebox-tree-display-inner parent) 'column) + (eq (ebox-tree-display-inner parent-new) 'column) + ancestors-stable-p + spans + block-span + (with-current-buffer buffer + (ebox--line-spans-cover-whole-lines-p spans)) + (cl-every + (lambda (node-id) + (or (equal node-id candidate-id) + (ebox--runtime-ancestor-id-p + buffer candidate-id node-id))) + node-ids)) + (setq proof + (list :owner-id candidate-id + :parent-id parent-id + :dirty-set (copy-sequence dirty-set) + :snapshot snapshot + :old-spans spans + :old-block-span block-span + :region-ids (plist-get snapshot :region-ids) + :allocated-width (ebox-get old-node :width) + :layout-snapshot-detail-generation + (plist-get old-state + :layout-snapshot-detail-generation)))) + (unless proof + (setq candidate-id (gethash candidate-id parents)))))) + proof)) + +(defun ebox-incremental--mixed-owner-proof + (buffer old-state candidate-state prepared owner-plan) + "Return a strict mixed geometry/paint proof, or nil. +The geometry half reuses the existing variable-line formatting-context proof +with only geometry entries. Paint owners must be disjoint, retain their +layout/topology facts, and change only the first-slice color declarations. +This function is deliberately proof-only: it never widens a scope or +suppresses the ordinary fallback when any fact is missing." + (let* ((dirty-set (plist-get prepared :dirty-set)) + (geometry-dirty + (cl-remove-if-not + (lambda (entry) (eq (plist-get entry :dirty-kind) 'geometry)) + dirty-set)) + (paint-dirty + (cl-remove-if-not + (lambda (entry) (eq (plist-get entry :dirty-kind) 'paint)) + dirty-set)) + (geometry-prepared + (and geometry-dirty + (plist-put (copy-sequence prepared) + :dirty-set geometry-dirty))) + (geometry-context-proof + (and (>= (length geometry-dirty) 2) + (ebox-incremental--formatting-context-reflow-proof + buffer old-state candidate-state geometry-prepared))) + (geometry-plan + (and (not geometry-context-proof) + (>= (length geometry-dirty) 2) + (let ((ebox-incremental--candidate-state-for-slot-proof + candidate-state)) + (ebox-incremental--layout-owner-plan + buffer old-state candidate-state geometry-dirty)))) + (geometry-span-proof + (and geometry-plan + (ebox-incremental--span-patch-projection-proof + buffer old-state geometry-prepared candidate-state + geometry-plan))) + (geometry-proof (or geometry-context-proof geometry-span-proof)) + (geometry-kind (and geometry-proof + (if geometry-context-proof + 'formatting-context-reflow + 'span-patch))) + (geometry-owner-ids + (cond + (geometry-context-proof + (list (plist-get geometry-context-proof :owner-id))) + (geometry-span-proof + (copy-sequence (plist-get geometry-span-proof :owner-ids))))) + (geometry-owner-id (car geometry-owner-ids)) + (paint-owner-ids + (delete-dups + (cl-mapcan #'ebox--dirty-provenance-node-ids paint-dirty))) + (old-nodes (plist-get old-state :node-table)) + (new-nodes (plist-get candidate-state :node-table)) + (root-id (ebox--buffer-root-node-id buffer)) + (paint-valid-p + (and paint-dirty + (cl-every + (lambda (entry) + (and (plist-get entry :node-id) + (cl-every (lambda (key) + (memq key + '(:color :bgcolor + :border-left-color + :border-right-color + :border-top-color + :border-bottom-color))) + (plist-get entry :changed-keys)) + (let* ((node-id (plist-get entry :node-id)) + (old-node (gethash node-id old-nodes)) + (new-node (gethash node-id new-nodes))) + (and old-node new-node + (ebox-incremental--node-child-ids-equal-p + old-node new-node) + (equal (gethash node-id + (plist-get old-state :parent-table)) + (gethash node-id + (plist-get candidate-state + :parent-table))) + (equal (ebox-incremental--layout-slot-style-signature + old-node) + (ebox-incremental--layout-slot-style-signature + new-node)) + (equal (ebox-get old-node :width) + (ebox-get new-node :width)) + (equal (ebox-get old-node :height) + (ebox-get new-node :height)) + (equal (plist-get + (plist-get entry :old-signature) + :content) + (plist-get + (plist-get entry :new-signature) + :content)))))) + paint-dirty))) + (disjoint-p + (and geometry-owner-ids + (not (cl-some (lambda (geometry-id) + (member geometry-id paint-owner-ids)) + geometry-owner-ids)))) + (cascade-safe-p + (or (and (not (plist-get old-state :cascade-active-p)) + (not (plist-get old-state :cascade-required-p)) + (not (ebox-style-cascade-active-p))) + (ebox-surface--cascade-local-owner-proof-p + old-state candidate-state dirty-set)))) + (when (and geometry-proof paint-valid-p disjoint-p cascade-safe-p + (not (plist-get prepared :scroll-state-transaction)) + (not (plist-get prepared :scroll-patch-fast-p)) + root-id + (not (equal geometry-owner-id root-id)) + (> (hash-table-count old-nodes) + (length (delete-dups (append geometry-owner-ids + paint-owner-ids))))) + (list :geometry-proof geometry-proof + :geometry-kind geometry-kind + :geometry-owner-ids geometry-owner-ids + :geometry-owner-id geometry-owner-id + :paint-owner-ids paint-owner-ids + :owner-ids (append geometry-owner-ids paint-owner-ids) + :dirty-set (copy-sequence dirty-set) + :owner-plan (copy-tree owner-plan) + :outside-complement-count + (- (hash-table-count old-nodes) + (length (delete-dups (append geometry-owner-ids + paint-owner-ids)))))))) + (defun ebox-incremental--broad-dirty-owner-id (buffer node-ids) "Return one structurally safe broad owner for NODE-IDS in BUFFER." (let* ((root-id (ebox--buffer-root-node-id buffer)) @@ -5751,6 +6694,58 @@ render whose line count moved is unpublishable there by construction." (ebox-incremental--declarative-tentative-patch-set buffer render-dirty-set))))) +(defun ebox-incremental--cascade-root-owner-plan-p + (buffer old-state candidate-state dirty-set) + "Return non-nil when cascade makes a local proof unusable. +OLD-STATE and CANDIDATE-STATE bound the style evidence for DIRTY-SET. Dynamic +or changed cascade dependencies cannot use a local owner; a static binding +closure may still plan one for a later owner-scoped surface projection." + (and + (or (plist-get old-state :cascade-active-p) + (plist-get old-state :cascade-required-p) + (ebox-style-cascade-active-p)) + (cl-some (lambda (entry) + (not (eq (plist-get entry :dirty-kind) 'paint))) + dirty-set) + (not + (and + (cl-every + (lambda (entry) + (or + (eq (plist-get entry :dirty-kind) 'paint) + (let ((old-signature (plist-get entry :old-signature)) + (new-signature (plist-get entry :new-signature))) + (or + (and (plist-get old-signature :width) + (plist-get old-signature :height) + (equal (plist-get old-signature :width) + (plist-get new-signature :width)) + (equal (plist-get old-signature :height) + (plist-get new-signature :height))) + (and (memq :content (plist-get entry :changed-keys)) + (stringp (plist-get old-signature :content)) + (stringp (plist-get new-signature :content)) + (= (length (plist-get old-signature :content)) + (length (plist-get new-signature :content)))) + (ebox-incremental--fast-grid-slot-evidence + buffer entry candidate-state) + (ebox-incremental--allocated-parent-slot-stable-p + buffer entry candidate-state) + (ebox-incremental--content-slot-stable-p + buffer entry candidate-state))))) + dirty-set) + (ebox-surface--cascade-local-owner-proof-p + old-state candidate-state dirty-set))))) + +(defun ebox-incremental--root-owner-plan (buffer dirty-set) + "Return one conservative root owner operation for DIRTY-SET." + (when-let ((root-id (ebox--buffer-root-node-id buffer))) + (list + (ebox--patch-op + 'owner-rerender root-id + :dirty (ebox--merge-dirty-provenance-list dirty-set) + :proof-skipped-p t)))) + (defun ebox-incremental--layout-owner-report (prepared owner-plan candidate-state) "Return Ebox report for PREPARED, OWNER-PLAN, and CANDIDATE-STATE." @@ -5848,7 +6843,559 @@ the surface is allowed to reuse retained TP objects." (with-current-buffer buffer (length (ebox-string-lines (ebox--format-content node))))))) -(defun ebox-incremental--span-patch-projection-proof +(defun ebox-incremental--layout-slot-style-signature (node) + "Return NODE's layout-significant style, excluding paint-only fields. +Paint changes are validated by the static cascade proof; they must not make +an otherwise unchanged allocated ancestor look geometrically unstable." + (let ((signature (copy-sequence + (ebox-fragment-node-style-signature node)))) + (dolist (key ebox--paint-style-signature-keys) + (cl-remf signature key)) + signature)) + +(defun ebox-incremental--cached-layout-snapshot-details (buffer node-id) + "Return transaction-local detailed layout snapshot for NODE-ID." + (let* ((key (cons 'snapshot node-id)) + (missing (make-symbol "ebox-snapshot-proof-missing")) + (cached (and ebox-incremental--allocated-slot-proof-cache + (gethash key ebox-incremental--allocated-slot-proof-cache + missing)))) + (if (and cached (not (eq cached missing))) + (unless (eq cached 'no-snapshot) cached) + (let ((snapshot (ebox--ensure-layout-snapshot-details buffer node-id))) + (when ebox-incremental--allocated-slot-proof-cache + (puthash key (or snapshot 'no-snapshot) + ebox-incremental--allocated-slot-proof-cache)) + snapshot)))) + +(defun ebox-incremental--cached-allocation-snapshot (buffer node-id) + "Return lightweight allocation evidence for NODE-ID in BUFFER. +This path intentionally omits role topology, overflow, and mount scans; the +final owner output validator still requests the complete snapshot. Allocation +facts are written back to the published snapshot after they have been derived +from the current buffer. They are ordinary derived state, not authority: the +snapshot generation check in `ebox--layout-snapshot' strips them whenever +coordinates are invalidated, and the final owner validator still recomputes +the complete proof." + (let* ((key (cons 'allocation-snapshot node-id)) + (missing (make-symbol "ebox-allocation-snapshot-missing")) + (cached (and ebox-incremental--allocated-slot-proof-cache + (gethash key ebox-incremental--allocated-slot-proof-cache + missing)))) + (if (and cached (not (eq cached missing))) + (unless (eq cached 'no-snapshot) cached) + (let* ((snapshot (ebox--ensure-layout-snapshot-spans buffer node-id)) + (spans (and snapshot (plist-get snapshot :buffer-spans))) + (footprint nil) + (external nil) + (parent-slot nil) + (allocation-shape nil) + (generation + (ebox--buffer-layout-snapshot-detail-generation buffer))) + ;; A previous proof may already have materialized these facts. + ;; Reusing them avoids rescanning every character on each owner path. + (setq footprint + (or (and snapshot + (plist-get snapshot :span-footprint-signature)) + (and spans + (with-current-buffer buffer + (ebox--spans-span-footprint-signature spans))))) + (setq external + (or (and snapshot + (plist-get snapshot :external-footprint-signature)) + (and footprint + (ebox--external-footprint-signature-from-span-footprint + footprint)))) + (setq parent-slot + (or (and snapshot + (plist-get snapshot :parent-slot-signature)) + (and spans + (with-current-buffer buffer + (ebox--spans-parent-slot-signature spans))))) + (setq allocation-shape + (and footprint + (list :span-count (plist-get footprint :span-count) + :whole-line-flags + (plist-get footprint :whole-line-flags) + :contiguous-lines + (plist-get footprint :contiguous-lines)))) + (let ((allocation + (and footprint + (list :buffer-spans spans + :span-footprint-signature footprint + :external-footprint-signature external + :parent-slot-signature parent-slot + :allocation-shape allocation-shape + :detail-generation generation)))) + ;; Keep the allocation facts with the snapshot table so the next + ;; logical turn can consume them without repeating the scan. These + ;; are derived facts only; publication authority stays unchanged. + (when (and snapshot allocation + (or (null (plist-get snapshot + :span-footprint-signature)) + (null (plist-get snapshot + :external-footprint-signature)) + (null (plist-get snapshot + :parent-slot-signature)) + (null (plist-get snapshot :allocation-shape)) + (not (= (or (plist-get snapshot + :detail-generation) + -1) + generation)))) + (let ((updated (copy-sequence snapshot))) + (dolist (entry `((:span-footprint-signature . ,footprint) + (:external-footprint-signature . ,external) + (:parent-slot-signature . ,parent-slot) + (:allocation-shape . ,allocation-shape) + (:detail-generation . ,generation))) + (setq updated (plist-put updated (car entry) (cdr entry)))) + (ebox--put-layout-snapshot buffer node-id updated))) + (when ebox-incremental--allocated-slot-proof-cache + (puthash key (or allocation 'no-snapshot) + ebox-incremental--allocated-slot-proof-cache)) + allocation))))) + +(defun ebox-incremental--compute-ancestor-slot-signature + (buffer old-state candidate-state owner-id) + "Return stable allocated-slot evidence from OWNER-ID through the root. +Every retained ancestor must keep its parent edge and computed layout style. +Published snapshot footprints make the allocation proof independent of the +candidate's unrendered caches." + (let ((old-nodes (plist-get old-state :node-table)) + (new-nodes (plist-get candidate-state :node-table)) + (old-parents (plist-get old-state :parent-table)) + (new-parents (plist-get candidate-state :parent-table)) + (generation (plist-get old-state :layout-snapshot-detail-generation)) + (node-id owner-id) + signature valid) + (setq valid t) + (while (and valid node-id) + (let* ((old-node (gethash node-id old-nodes)) + (new-node (gethash node-id new-nodes)) + (old-parent (gethash node-id old-parents)) + (new-parent (gethash node-id new-parents)) + (snapshot (and old-node + (ebox-incremental--cached-allocation-snapshot + buffer node-id))) + (old-style (and old-node + (ebox-incremental--layout-slot-style-signature + old-node))) + (new-style (and new-node + (ebox-incremental--layout-slot-style-signature + new-node)))) + (if (and old-node new-node snapshot + (equal old-parent new-parent) + (if (equal node-id owner-id) + (and (equal (ebox-get old-node :width) + (ebox-get new-node :width)) + (equal (ebox-get old-node :height) + (ebox-get new-node :height))) + (equal old-style new-style)) + (plist-get snapshot :span-footprint-signature) + (plist-get snapshot :external-footprint-signature) + (or (null old-parent) + (plist-get snapshot :parent-slot-signature))) + (push (list :node-id node-id + :allocated-style old-style + :parent-slot-signature + (plist-get snapshot :parent-slot-signature) + :external-footprint-signature + (plist-get snapshot :external-footprint-signature) + :span-footprint-signature + (plist-get snapshot :span-footprint-signature) + :detail-generation generation) + signature) + (setq valid nil)) + (setq node-id old-parent))) + (and valid (nreverse signature)))) + +(defun ebox-incremental--ancestor-slot-signature + (buffer old-state candidate-state owner-id) + "Return candidate-local cached ancestor allocation evidence for OWNER-ID." + (let* ((key (cons 'ancestor owner-id)) + (missing (make-symbol "ebox-ancestor-proof-missing")) + (cached (and ebox-incremental--allocated-slot-proof-cache + (gethash key ebox-incremental--allocated-slot-proof-cache + missing)))) + (if (and cached (not (eq cached missing))) + (unless (eq cached 'no-signature) cached) + (let ((signature + (ebox-incremental--compute-ancestor-slot-signature + buffer old-state candidate-state owner-id))) + (when ebox-incremental--allocated-slot-proof-cache + (puthash key (or signature 'no-signature) + ebox-incremental--allocated-slot-proof-cache)) + signature)))) + +(defun ebox-incremental--stable-grid-track-p (track) + "Return non-nil when TRACK is fixed or a positive fractional track." + (or (numberp track) + (and (consp track) (null (cdr track)) (numberp (car track))) + (and (symbolp track) + (string-match-p + "\\`[0-9]+\\(?:\\.[0-9]+\\)?fr\\'" (symbol-name track))) + (and (consp track) (eq (car track) 'fr) + (numberp (cadr track)) (> (cadr track) 0) + (null (cddr track))))) + +(defun ebox-incremental--fixed-grid-track-p (track) + "Return non-nil when TRACK has a definite numeric size. +The fast variable-content proof deliberately excludes fractional tracks; their +allocation remains on the full ancestor-slot proof path." + (or (numberp track) + (and (consp track) (null (cdr track)) (numberp (car track))))) + +(defun ebox-incremental--compute-allocated-parent-slot-stable-p + (buffer entry candidate-state) + "Return non-nil when ENTRY keeps a fixed parent allocation in CANDIDATE-STATE. +This bounded proof accepts an auto-width one-line child only when its nearest +unchanged Grid ancestor uses fixed or positive fractional columns and the +complete published ancestor slot chain remains identical." + (let* ((old-state (ebox--buffer-render-state buffer)) + (node-id (plist-get entry :node-id)) + (old-node (and node-id + (gethash node-id (plist-get old-state :node-table)))) + (new-node (and node-id + (gethash node-id + (plist-get candidate-state :node-table)))) + (parent-table (plist-get old-state :parent-table)) + (candidate-parents (plist-get candidate-state :parent-table)) + (ancestor-id (and node-id (gethash node-id parent-table))) + grid-id old-grid new-grid) + (while (and ancestor-id (not grid-id)) + (let ((old-ancestor + (gethash ancestor-id (plist-get old-state :node-table))) + (new-ancestor + (gethash ancestor-id (plist-get candidate-state :node-table)))) + (if (and old-ancestor new-ancestor + (equal (gethash ancestor-id parent-table) + (gethash ancestor-id candidate-parents)) + (eq (ebox-tree-display-inner old-ancestor) 'grid) + (eq (ebox-tree-display-inner new-ancestor) 'grid)) + (setq grid-id ancestor-id + old-grid old-ancestor + new-grid new-ancestor) + (setq ancestor-id (gethash ancestor-id parent-table))))) + (let* ((old-props (and old-grid (plist-get old-grid :props))) + (new-props (and new-grid (plist-get new-grid :props))) + (tracks (and old-props + (plist-get old-props :grid-template-columns))) + (owner-snapshot + (and old-node + (ebox-incremental--cached-allocation-snapshot + buffer node-id))) + (old-content (plist-get (plist-get entry :old-signature) :content)) + (new-content (plist-get (plist-get entry :new-signature) :content))) + (and old-state old-node new-node old-grid new-grid + (memq :content (plist-get entry :changed-keys)) + (or (and (numberp (ebox-get old-node :height)) + (equal (ebox-get old-node :height) + (ebox-get new-node :height))) + (and (equal (plist-get + (plist-get owner-snapshot + :external-footprint-signature) + :block-lines) + 1) + (stringp old-content) (stringp new-content) + (not (string-match-p "\n" old-content)) + (not (string-match-p "\n" new-content)))) + (equal old-props new-props) + (proper-list-p tracks) + tracks + (cl-every #'ebox-incremental--stable-grid-track-p tracks) + (ebox-incremental--ancestor-slot-signature + buffer old-state candidate-state node-id))))) + +(defun ebox-incremental--content-slot-stable-p + (buffer entry candidate-state) + "Return strict evidence that a one-line auto-width owner is local. +The owner may have no declared width when its nearest unchanged formatting +context has a stable allocated slot. A column parent is safe when its own +layout facts and child topology are unchanged; a row parent is accepted only +for the final child, so changing that child's intrinsic width cannot shift a +following sibling. The surface footprint validator remains the final gate." + (let* ((old-state (ebox--buffer-render-state buffer)) + (node-id (plist-get entry :node-id)) + (old-node (and node-id + (gethash node-id (plist-get old-state :node-table)))) + (new-node (and node-id + (gethash node-id (plist-get candidate-state :node-table)))) + (parents (plist-get old-state :parent-table)) + (candidate-parents (plist-get candidate-state :parent-table)) + (parent-id (and node-id (gethash node-id parents))) + (old-parent (and parent-id + (gethash parent-id (plist-get old-state :node-table)))) + (new-parent (and parent-id + (gethash parent-id (plist-get candidate-state :node-table)))) + (old-children (and old-parent (ebox-tree--children-raw old-parent))) + (position (and old-children + (cl-position-if + (lambda (child) + (= node-id (plist-get child :node-id))) + old-children))) + (parent-kind (and old-parent (ebox-tree-display-inner old-parent))) + (snapshot (and old-node + (ebox-incremental--cached-allocation-snapshot + buffer node-id))) + (old-content (plist-get (plist-get entry :old-signature) :content)) + (new-content (plist-get (plist-get entry :new-signature) :content)) + (ancestor-signature + (and node-id + (ebox-incremental--ancestor-slot-signature + buffer old-state candidate-state node-id)))) + (and old-state old-node new-node old-parent new-parent + (equal (gethash parent-id parents) + (gethash parent-id candidate-parents)) + (ebox-incremental--node-child-ids-equal-p old-parent new-parent) + (equal (ebox-incremental--layout-slot-style-signature old-parent) + (ebox-incremental--layout-slot-style-signature new-parent)) + (equal (ebox-get old-parent :width) (ebox-get new-parent :width)) + (equal (ebox-get old-parent :height) (ebox-get new-parent :height)) + (memq parent-kind '(row column)) + (or (eq parent-kind 'column) + (and (integerp position) + (= position (1- (length old-children))) + (not (ebox-get old-node :flex-grow)) + (not (ebox-get old-node :flex-shrink)))) + (memq :content (plist-get entry :changed-keys)) + (stringp old-content) (stringp new-content) + (not (string-match-p "\n" old-content)) + (not (string-match-p "\n" new-content)) + snapshot + (equal (plist-get + (plist-get snapshot :external-footprint-signature) + :block-lines) + 1) + ancestor-signature))) + +(defun ebox-incremental--allocated-parent-slot-stable-p + (buffer entry candidate-state) + "Return cached allocated-slot evidence for ENTRY in CANDIDATE-STATE." + (let* ((key (cons 'allocated (plist-get entry :node-id))) + (missing (make-symbol "ebox-slot-proof-missing")) + (cached (and ebox-incremental--allocated-slot-proof-cache + (gethash key ebox-incremental--allocated-slot-proof-cache + missing)))) + (if (and cached (not (eq cached missing))) + (eq cached 'stable) + (let ((stable + (ebox-incremental--compute-allocated-parent-slot-stable-p + buffer entry candidate-state))) + (when ebox-incremental--allocated-slot-proof-cache + (puthash key (if stable 'stable 'unstable) + ebox-incremental--allocated-slot-proof-cache)) + stable)))) + +(defun ebox-incremental--fixed-content-slot-stable-p + (buffer entry candidate-state) + "Return strict evidence for one-line content in a definite flex/row slot. +Unlike the auto-width row proof, a definite non-growing child cannot change +its parent's allocation when its glyph string changes. Parent topology, +style, and the published ancestor slot chain remain mandatory." + (let* ((old-state (ebox--buffer-render-state buffer)) + (node-id (plist-get entry :node-id)) + (old-node (and node-id + (gethash node-id (plist-get old-state :node-table)))) + (new-node (and node-id + (gethash node-id (plist-get candidate-state + :node-table)))) + (parents (plist-get old-state :parent-table)) + (candidate-parents (plist-get candidate-state :parent-table)) + (parent-id (and node-id (gethash node-id parents))) + (old-parent (and parent-id + (gethash parent-id (plist-get old-state :node-table)))) + (new-parent (and parent-id + (gethash parent-id + (plist-get candidate-state :node-table)))) + (snapshot (and old-node + (ebox-incremental--cached-allocation-snapshot + buffer node-id))) + (old-content (plist-get (plist-get entry :old-signature) :content)) + (new-content (plist-get (plist-get entry :new-signature) :content))) + (and old-node new-node old-parent new-parent + (eq (ebox-tree-display-inner old-parent) + (ebox-tree-display-inner new-parent)) + (memq (ebox-tree-display-inner old-parent) '(row flex)) + (equal (gethash parent-id parents) + (gethash parent-id candidate-parents)) + (ebox-incremental--node-child-ids-equal-p old-parent new-parent) + (equal (ebox-incremental--layout-slot-style-signature old-parent) + (ebox-incremental--layout-slot-style-signature new-parent)) + (numberp (ebox-get old-node :width)) + (equal (ebox-get old-node :width) (ebox-get new-node :width)) + (not (ebox-get old-node :flex-grow)) + (not (ebox-get old-node :flex-shrink)) + (memq :content (plist-get entry :changed-keys)) + (stringp old-content) (stringp new-content) + (not (string-match-p "\n" old-content)) + (not (string-match-p "\n" new-content)) + snapshot + (equal (plist-get + (plist-get snapshot :external-footprint-signature) + :block-lines) + 1) + (ebox-incremental--ancestor-slot-signature + buffer old-state candidate-state node-id)))) + +(defun ebox-incremental--stable-grid-ancestor-slot-proof-p + (old-state candidate-state grid-id) + "Return non-nil for a stable fractional GRID allocation context. +This proof is deliberately narrower than a general ancestor snapshot proof: +GRID must be nested below at least one unchanged normal-flow ancestor, every +ancestor above it must remain a column/box flow with the same layout style and +parent edge, and no ancestor may expose visible overflow. Auto-sized +formatting contexts, row/flex/grid ancestors, and a root GRID continue through +the complete snapshot proof." + (let* ((old-nodes (plist-get old-state :node-table)) + (new-nodes (plist-get candidate-state :node-table)) + (old-parents (plist-get old-state :parent-table)) + (new-parents (plist-get candidate-state :parent-table)) + (node-id (gethash grid-id old-parents)) + (seen nil) + (valid (and node-id t))) + (while (and valid node-id) + (if (memq node-id seen) + (setq valid nil) + (push node-id seen) + (let* ((old-node (gethash node-id old-nodes)) + (new-node (gethash node-id new-nodes)) + (old-parent (gethash node-id old-parents)) + (new-parent (gethash node-id new-parents)) + (display (and old-node + (ebox-tree-display-inner old-node))) + (old-width (and old-node (ebox-get old-node :width))) + (new-width (and new-node (ebox-get new-node :width)))) + (unless (and old-node new-node + (equal old-parent new-parent) + (equal (ebox-incremental--layout-slot-style-signature + old-node) + (ebox-incremental--layout-slot-style-signature + new-node)) + (memq display '(column box flow)) + (not (ebox-tree-node-visible-overflow-p old-node)) + (not (ebox-tree-node-visible-overflow-p new-node)) + ;; A normal-flow column/box may inherit its width from + ;; its stable parent. Intrinsic width keywords are not + ;; allocation certificates and remain conservative. + (equal old-width new-width) + (not (memq old-width '(max-content min-content + fit-content auto)))) + (setq valid nil)) + (setq node-id old-parent)))) + valid)) + +(defun ebox-incremental--fast-grid-slot-evidence + (buffer entry candidate-state) + "Return minimal stable Grid-slot evidence for one variable owner. +This intentionally stops at the nearest unchanged Grid instead of rebuilding +every ancestor snapshot. The full proof remains available for all other +projection kinds and the surface output validator remains authoritative." + (let* ((old-state (ebox--buffer-render-state buffer)) + (node-id (plist-get entry :node-id)) + (old-node (and node-id + (gethash node-id (plist-get old-state :node-table)))) + (new-node (and node-id + (gethash node-id + (plist-get candidate-state :node-table)))) + (parents (plist-get old-state :parent-table)) + (candidate-parents (plist-get candidate-state :parent-table)) + (ancestor-id (and node-id (gethash node-id parents))) + (child-id node-id) + grid-id old-grid new-grid) + (while (and ancestor-id (not grid-id)) + (let* ((old-ancestor (gethash ancestor-id + (plist-get old-state :node-table))) + (new-ancestor (gethash ancestor-id + (plist-get candidate-state :node-table))) + (parent-id (gethash ancestor-id parents)) + (new-parent-id (gethash ancestor-id candidate-parents))) + (if (and old-ancestor new-ancestor + (equal parent-id new-parent-id) + (not (ebox-tree-node-visible-overflow-p old-ancestor))) + (pcase (ebox-tree-display-inner old-ancestor) + ('grid + (setq grid-id ancestor-id + old-grid old-ancestor + new-grid new-ancestor)) + ('flex + (let* ((children (ebox-tree--children-raw old-ancestor)) + (last-child (car (last children))) + (props (plist-get old-ancestor :props))) + (if (and last-child + (= child-id (plist-get last-child :node-id)) + (eq (plist-get props :flex-wrap) 'nowrap) + (not (ebox-get last-child :flex-grow)) + (not (ebox-get last-child :flex-shrink)) + (equal (ebox-incremental--layout-slot-style-signature + old-ancestor) + (ebox-incremental--layout-slot-style-signature + new-ancestor))) + (setq grid-id ancestor-id + old-grid old-ancestor + new-grid new-ancestor + ancestor-id nil) + (setq ancestor-id nil)))) + (_ + (setq child-id ancestor-id + ancestor-id parent-id))) + (setq ancestor-id nil)))) + (let* ((old-props (and old-grid (plist-get old-grid :props))) + (new-props (and new-grid (plist-get new-grid :props))) + (context-kind (and old-grid (ebox-tree-display-inner old-grid))) + (tracks (and old-props + (plist-get old-props :grid-template-columns))) + (snapshot (and old-node + (ebox-incremental--cached-allocation-snapshot + buffer node-id))) + (grid-snapshot (and grid-id + (ebox-incremental--cached-allocation-snapshot + buffer grid-id))) + (old-content + (plist-get (plist-get entry :old-signature) :content)) + (new-content + (plist-get (plist-get entry :new-signature) :content))) + (when (and old-node new-node old-grid new-grid + (equal old-props new-props) + (or (eq context-kind 'flex) + (and (eq context-kind 'grid) + (proper-list-p tracks) tracks + (cl-every #'ebox-incremental--stable-grid-track-p + tracks))) + snapshot grid-snapshot + (= 1 (plist-get + (plist-get snapshot :external-footprint-signature) + :block-lines)) + (stringp old-content) (stringp new-content) + (not (string-match-p "\n" old-content)) + (not (string-match-p "\n" new-content))) + (list :owner-id node-id :grid-id grid-id + :needs-full-ancestor-proof + (and (eq context-kind 'grid) + (not (cl-every #'ebox-incremental--fixed-grid-track-p + tracks)) + (not (ebox-incremental--stable-grid-ancestor-slot-proof-p + old-state candidate-state grid-id))) + :grid-snapshot grid-snapshot + :owner-snapshot snapshot))))) + +(defun ebox-incremental--variable-content-fits-slot-p + (snapshot content) + "Return non-nil when one-line CONTENT fits the retained owner slot. +This is a conservative pre-render guard for variable-content span patches; +the surface renderer and role/overflow validators remain the final proof." + (let ((slots (plist-get (plist-get snapshot :parent-slot-signature) + :slots))) + (and (stringp content) + (not (string-match-p "\n" content)) + slots + (<= (ebox--string-pixel-width content) + (apply #'min + (mapcar (lambda (slot) + (- (plist-get slot :end-pixel) + (plist-get slot :start-pixel))) + slots)))))) + +(defun ebox-incremental--single-span-patch-projection-proof (buffer old-state prepared candidate-state owner-plan &optional path-copied-p) "Return strict span projection metadata, or nil when it is unsafe. @@ -5863,24 +7410,87 @@ metadata; this predicate only authorizes the local attempt." (changed-keys (plist-get dirty :changed-keys)) (old-node (gethash owner-id (plist-get old-state :node-table))) (new-node (gethash owner-id (plist-get candidate-state :node-table))) + (slot-dirty + (plist-put (copy-sequence dirty) :node-id owner-id)) (snapshot (and old-node - (ebox--ensure-layout-snapshot-details buffer owner-id))) + (ebox-incremental--cached-layout-snapshot-details + buffer owner-id))) + (variable-grid-evidence + (and (memq :content changed-keys) + (ebox-incremental--fast-grid-slot-evidence + buffer slot-dirty candidate-state))) + (fixed-content-evidence + (and (memq :content changed-keys) + (ebox-incremental--fixed-content-slot-stable-p + buffer slot-dirty candidate-state))) (spans (and snapshot (plist-get snapshot :buffer-spans))) - (axes (plist-get old-state :viewport-dependent-node-id-axes))) - (when (and (eq (plist-get operation :op) 'span-patch) + (impact-vector + (let ((ebox-incremental--candidate-state-for-slot-proof + candidate-state)) + (plist-get + (ebox--dirty-entry-with-impact-vector buffer dirty) + :impact-vector))) + (ancestor-slot-signature + (if (and variable-grid-evidence + (not (plist-get variable-grid-evidence + :needs-full-ancestor-proof))) + (list (list :node-id owner-id + :variable-grid-id + (plist-get variable-grid-evidence :grid-id) + :parent-slot-signature + (plist-get snapshot :parent-slot-signature) + :external-footprint-signature + (plist-get snapshot + :external-footprint-signature) + :span-footprint-signature + (plist-get snapshot :span-footprint-signature) + :detail-generation + (plist-get old-state + :layout-snapshot-detail-generation))) + (ebox-incremental--ancestor-slot-signature + buffer old-state candidate-state owner-id)))) + (when (and (or (eq (plist-get operation :op) 'span-patch) + (and (eq (plist-get operation :op) 'owner-rerender) + (memq :content changed-keys) + variable-grid-evidence)) (eq (plist-get dirty :dirty-kind) 'geometry) - (equal changed-keys '(:content)) + ;; A declarative content update may also carry paint keys + ;; (for example a stylesheet-computed :color) in the dirty + ;; signature. The static cascade proof below establishes + ;; that those extra keys cannot affect geometry. Other + ;; local style keys remain on their existing conservative + ;; path. + (memq :content changed-keys) + (cl-every + (lambda (key) + (or (eq key :content) + (eq key :surface-properties) + (memq key ebox--paint-style-signature-keys))) + changed-keys) (not (plist-get dirty :children)) (null (plist-get dirty :node-ids)) - (not (plist-get old-state :cascade-active-p)) - (not (plist-get old-state :cascade-required-p)) + (or (not (memq 'parent-layout impact-vector)) + (ebox-incremental--content-slot-stable-p + buffer slot-dirty candidate-state) + fixed-content-evidence + variable-grid-evidence + (ebox-incremental--allocated-parent-slot-stable-p + buffer slot-dirty candidate-state)) + ancestor-slot-signature + (or (and (not (plist-get old-state :cascade-active-p)) + (not (plist-get old-state :cascade-required-p)) + (not (ebox-style-cascade-active-p))) + (and (memq :content changed-keys) + (ebox-surface--cascade-local-owner-proof-p + old-state candidate-state (list dirty)))) (null (plist-get old-state :scroll-region-ids)) (or (null (plist-get candidate-state :scroll-region-ids)) (null (ebox-incremental--hash-keys (plist-get candidate-state :scroll-state-table)))) - (not (cl-some #'identity (and axes (append (car axes) - (cdr axes))))) + ;; The ancestor allocation proof is tied to the published + ;; viewport slot. A declarative commit does not alter that + ;; context; final footprint validation still rejects a miss. old-node new-node (eq (plist-get old-node :ebox-type) (plist-get new-node :ebox-type)) @@ -5888,8 +7498,10 @@ metadata; this predicate only authorizes the local attempt." (plist-get new-node :key)) (ebox-incremental--node-child-ids-equal-p old-node new-node) - (equal (ebox-fragment-node-style-signature old-node) - (ebox-fragment-node-style-signature new-node)) + (equal (ebox-incremental--layout-slot-style-signature + old-node) + (ebox-incremental--layout-slot-style-signature + new-node)) (ebox-incremental--same-root-surface-identity-p (plist-get old-state :root-node) (plist-get candidate-state :root-node)) @@ -5899,7 +7511,12 @@ metadata; this predicate only authorizes the local attempt." spans (or (not path-copied-p) (ebox-incremental--path-span-line-count-stable-p - buffer new-node spans)) + buffer new-node spans) + (ebox-incremental--content-slot-stable-p + buffer slot-dirty candidate-state) + variable-grid-evidence + (ebox-incremental--allocated-parent-slot-stable-p + buffer slot-dirty candidate-state)) (plist-get snapshot :span-footprint-signature) (plist-get snapshot :external-footprint-signature) (plist-get snapshot :parent-slot-signature) @@ -5912,37 +7529,224 @@ metadata; this predicate only authorizes the local attempt." (ebox--spans-contiguous-lines-p spans))) (not (ebox--node-visible-overflow-p old-node)) (not (ebox--ancestor-own-overflow-visible-p buffer owner-id))) - (list :owner-id owner-id :dirty-set (list dirty)))))) + (list :owner-id owner-id :dirty-set (list dirty) + :snapshot snapshot + :ancestor-slot-signature ancestor-slot-signature + :variable-content-p + (and snapshot + (memq :content changed-keys) + (stringp + (plist-get (plist-get dirty :new-signature) :content)) + (not (string-match-p + "\n" + (plist-get (plist-get dirty :new-signature) + :content))) + (or variable-grid-evidence fixed-content-evidence)) + :variable-content-max-width + (and snapshot + (plist-get + (plist-get snapshot :external-footprint-signature) + :max-line-pixel-width)) + :allocated-width + (let* ((owner-slot (car ancestor-slot-signature)) + (slots (plist-get + (plist-get owner-slot :parent-slot-signature) + :slots)) + (slot (and (= (length slots) 1) (car slots)))) + (and slot + (- (plist-get slot :end-pixel) + (plist-get slot :start-pixel)))) + :layout-snapshot-detail-generation + (plist-get old-state :layout-snapshot-detail-generation) + :static-cascade-p + (and (memq :content changed-keys) + (or (plist-get old-state :cascade-active-p) + (plist-get old-state :cascade-required-p)) + (ebox-surface--cascade-local-owner-proof-p + old-state candidate-state (list dirty)))))))) + +(defun ebox-incremental--owner-proofs-disjoint-p (buffer proofs) + "Return non-nil when PROOFS own pairwise-disjoint published spans." + (let ((spans + (sort + (cl-mapcan + (lambda (proof) + (copy-sequence + (plist-get + (ebox-incremental--cached-layout-snapshot-details + buffer (plist-get proof :owner-id)) + :buffer-spans))) + proofs) + (lambda (left right) (< (car left) (car right))))) + valid previous-end) + (setq valid t) + (dolist (span spans) + (when (and previous-end (< (car span) previous-end)) + (setq valid nil)) + (setq previous-end (cdr span))) + valid)) + +(defun ebox-incremental--variable-span-proofs-safe-p + (_buffer proofs) + "Return non-nil when every variable owner fits its retained slot capacity." + (let (valid) + (setq valid t) + (dolist (proof proofs) + (when (and valid (plist-get proof :variable-content-p)) + (let* ((dirty (car (plist-get proof :dirty-set))) + (snapshot (plist-get proof :snapshot)) + (content (plist-get (plist-get dirty :new-signature) + :content)) + (fits (ebox-incremental--variable-content-fits-slot-p + snapshot content))) + (when (not fits) + (setq valid nil))))) + valid)) + +(defun ebox-incremental--span-patch-projection-proof + (buffer old-state prepared candidate-state owner-plan + &optional path-copied-p) + "Return one atomic single- or multi-owner projection proof, or nil." + (if (= (length owner-plan) 1) + (ebox-incremental--single-span-patch-projection-proof + buffer old-state prepared candidate-state owner-plan path-copied-p) + (let (proofs valid) + (setq valid (and owner-plan + (= (length owner-plan) + (length (plist-get prepared :dirty-set))))) + (dolist (operation owner-plan) + (when valid + (let* ((dirty (plist-get operation :dirty)) + (local-prepared (copy-sequence prepared)) + proof) + (setq local-prepared + (plist-put local-prepared :dirty-set (list dirty))) + (setq proof + (and dirty + (ebox-incremental--single-span-patch-projection-proof + buffer old-state local-prepared candidate-state + (list operation) path-copied-p))) + (if proof (push proof proofs) (setq valid nil))))) + (setq proofs (nreverse proofs)) + (when (and valid + ;; Variable content is admitted only when every owner has a + ;; stable allocated slot proof. The surface will shape the + ;; new line back into that retained slot before TP sees it; + ;; raw string length is not the geometry proof. + (cl-every (lambda (proof) + (or (plist-get proof :variable-content-p) + (let* ((dirty (car (plist-get proof :dirty-set))) + (old-content + (plist-get + (plist-get dirty :old-signature) + :content)) + (new-content + (plist-get + (plist-get dirty :new-signature) + :content))) + (and (stringp old-content) + (stringp new-content) + (= (length old-content) + (length new-content)))))) + proofs) + (ebox-incremental--variable-span-proofs-safe-p + buffer proofs) + (ebox-incremental--owner-proofs-disjoint-p buffer proofs)) + (let* ((owner-ids (mapcar (lambda (proof) + (plist-get proof :owner-id)) + proofs)) + (common-id + (ebox-incremental--common-runtime-ancestor-id + buffer owner-ids)) + (common-snapshot + (and common-id + (ebox-incremental--cached-layout-snapshot-details + buffer common-id))) + (common-max + (and common-snapshot + (plist-get + (plist-get common-snapshot + :external-footprint-signature) + :max-line-pixel-width))) + (variable-p + (cl-some (lambda (proof) + (plist-get proof :variable-content-p)) + proofs))) + (list :owner-ids owner-ids + :owner-proofs proofs + :variable-content-p + variable-p + :variable-content-max-width + (and variable-p common-max) + :dirty-set (copy-sequence (plist-get prepared :dirty-set)) + :ancestor-slot-signature + (cl-mapcan + (lambda (proof) + (copy-sequence + (plist-get proof :ancestor-slot-signature))) + proofs) + :layout-snapshot-detail-generation + (plist-get old-state :layout-snapshot-detail-generation) + :static-cascade-p + (cl-every (lambda (proof) + (plist-get proof :static-cascade-p)) + proofs))))))) (defun ebox-incremental--surface-state-overrides (old-state prepared candidate-state projection-kind - &optional span-proof source-path-copied-p) + &optional span-proof source-path-copied-p formatting-proof) "Return surface overrides for PREPARED CANDIDATE-STATE." - (let ((overrides + (let ((scroll-fast-p + (and (eq projection-kind 'scroll-patch) + (plist-get prepared :scroll-patch-fast-p))) + (overrides (list :viewport-width (plist-get old-state :viewport-width) :viewport-height (plist-get old-state :viewport-height) :display-signature (plist-get prepared :display-signature) :scroll-state-table (plist-get prepared :scroll-state-table) + :native-buffer-scroll-p + (plist-get candidate-state :native-buffer-scroll-p) :source-path-copied-p source-path-copied-p :runtime-index-prepared-p - (memq projection-kind '(span-patch viewport-reflow)) + (or (plist-get prepared :runtime-index-complete-p) + (memq projection-kind + '(span-patch owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow + viewport-reflow))) :logical-candidate-p (plist-get prepared :logical-candidate-p) :detached-identity-history (plist-get prepared :detached-identity-history)))) - (if (not (memq projection-kind '(paint span-patch))) + (if (and (not (memq projection-kind + '(paint span-patch owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow))) + (not (plist-get prepared :runtime-index-complete-p))) overrides (append overrides - (list :layout-snapshots (plist-get candidate-state :layout-snapshots) + (list :layout-snapshots + (cond + ((eq projection-kind 'owner-scoped) + (copy-hash-table (plist-get old-state :layout-snapshots))) + ((and scroll-fast-p + (eq projection-kind 'scroll-patch)) + ;; The candidate already owns a hash-spine copy. Its detail + ;; generation was advanced during preparation, so old buffer + ;; spans become lazily stale without copying 512 snapshot + ;; plists on every wheel event. + (plist-get candidate-state :layout-snapshots)) + (t (plist-get candidate-state :layout-snapshots))) :layout-snapshots-complete-p - (plist-get candidate-state :layout-snapshots-complete-p) + (and (not scroll-fast-p) + (plist-get candidate-state :layout-snapshots-complete-p)) :layout-snapshot-detail-generation (plist-get candidate-state :layout-snapshot-detail-generation) :render-cache (plist-get candidate-state :render-cache) :render-signature-cache (plist-get candidate-state :render-signature-cache) :flex-content-min-widths - (if (eq projection-kind 'span-patch) + (if (or (memq projection-kind + '(span-patch owner-scoped)) + scroll-fast-p) (plist-get candidate-state :flex-content-min-widths) (plist-get old-state :flex-content-min-widths)) :viewport-height-dependent-subtree-cache @@ -5963,6 +7767,7 @@ metadata; this predicate only authorizes the local attempt." (plist-get candidate-state :region-box-count-table) :region-box-table (plist-get candidate-state :region-box-table) :host-ref-table (plist-get candidate-state :host-ref-table) + :range-ref-table (plist-get candidate-state :range-ref-table) :selector-id-table (plist-get candidate-state :selector-id-table) :selector-class-table (plist-get candidate-state :selector-class-table) @@ -5975,15 +7780,66 @@ metadata; this predicate only authorizes the local attempt." :native-node-postorder (plist-get candidate-state :native-node-postorder) :surface-node-object-table - (and (eq projection-kind 'span-patch) + (and (memq projection-kind + '(span-patch owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow)) (plist-get old-state :surface-node-object-table)) + :region-surface-object-table + (and scroll-fast-p + (plist-get old-state :region-surface-object-table)) + :surface-object-region-table + (and scroll-fast-p + (plist-get old-state :surface-object-region-table)) + :logical-id-region-table + (and scroll-fast-p + (plist-get old-state :logical-id-region-table)) :paint-dirty-set (and (eq projection-kind 'paint) (plist-get prepared :dirty-set)) :span-patch-owner-id - (and span-proof (plist-get span-proof :owner-id)) + (or (and span-proof (plist-get span-proof :owner-id)) + (and formatting-proof + (plist-get formatting-proof :owner-id)) + (and (plist-get prepared :mixed-owner-proof) + (plist-get + (plist-get (plist-get prepared :mixed-owner-proof) + :geometry-proof) + :owner-id))) :span-patch-dirty-set - (and span-proof (plist-get span-proof :dirty-set))))))) + (or (and span-proof (plist-get span-proof :dirty-set)) + (and (eq projection-kind 'mixed-owner-reflow) + (plist-get (plist-get prepared :mixed-owner-proof) + :dirty-set))) + :owner-scoped-allocated-width + (and (eq projection-kind 'owner-scoped) + (plist-get span-proof :allocated-width)) + :owner-scoped-proofs + (or (and (memq projection-kind '(span-patch owner-scoped)) + (plist-get span-proof :owner-proofs)) + (and (eq projection-kind 'mixed-owner-reflow) + (eq (plist-get (plist-get prepared + :mixed-owner-proof) + :geometry-kind) + 'span-patch) + (plist-get + (plist-get (plist-get prepared :mixed-owner-proof) + :geometry-proof) + :owner-proofs))) + :formatting-context-reflow-proof + (and (or (eq projection-kind 'formatting-context-reflow) + (and (eq projection-kind 'mixed-owner-reflow) + (eq (plist-get (plist-get prepared + :mixed-owner-proof) + :geometry-kind) + 'formatting-context-reflow))) + (or formatting-proof + (plist-get (plist-get prepared :mixed-owner-proof) + :geometry-proof))) + :mixed-owner-proof + (and (eq projection-kind 'mixed-owner-reflow) + (plist-get prepared :mixed-owner-proof)) + :scroll-patch-region-id nil + :scroll-state-transaction nil))))) (defun ebox-incremental--same-root-surface-identity-p (old-root new-root) "Return non-nil when OLD-ROOT and NEW-ROOT retain one TP root object." @@ -5995,14 +7851,40 @@ metadata; this predicate only authorizes the local attempt." (defun ebox-incremental--surface-commit-input (buffer old-state prepared) "Return TP surface input for BUFFER from OLD-STATE and PREPARED runtime." - (let* ((candidate-state + (let* ((ebox-incremental--allocated-slot-proof-cache + (make-hash-table :test 'equal)) + (candidate-state (ebox-incremental--candidate-state old-state (plist-get prepared :root) (plist-get prepared :index) prepared)) + (formatting-proof + (and (not (cl-some + (lambda (entry) + (eq (plist-get entry :dirty-kind) 'paint)) + (plist-get prepared :dirty-set))) + (ebox-incremental--formatting-context-reflow-proof + buffer old-state candidate-state prepared))) (owner-plan - (ebox-incremental--layout-owner-plan - buffer old-state candidate-state - (plist-get prepared :dirty-set))) + (if formatting-proof + (list + (ebox--patch-op + 'formatting-context-reflow + (plist-get formatting-proof :owner-id) + :dirty (plist-get formatting-proof :dirty-set) + :proof formatting-proof)) + (let ((ebox-incremental--candidate-state-for-slot-proof + candidate-state)) + (if (ebox-incremental--cascade-root-owner-plan-p + buffer old-state candidate-state + (plist-get prepared :dirty-set)) + (ebox-incremental--root-owner-plan + buffer (plist-get prepared :dirty-set)) + (ebox-incremental--layout-owner-plan + buffer old-state candidate-state + (plist-get prepared :dirty-set)))))) + (mixed-proof + (ebox-incremental--mixed-owner-proof + buffer old-state candidate-state prepared owner-plan)) (same-root-identity-p (ebox-incremental--same-root-surface-identity-p (plist-get old-state :root-node) @@ -6020,17 +7902,53 @@ metadata; this predicate only authorizes the local attempt." (ebox-incremental--paint-projection-p old-state owner-plan (plist-get prepared :dirty-set))) (span-proof - (unless paint-p + (unless (or paint-p mixed-proof) (ebox-incremental--span-patch-projection-proof buffer old-state prepared candidate-state owner-plan))) (projection-kind - (cond + (cond + (mixed-proof 'mixed-owner-reflow) + (formatting-proof 'formatting-context-reflow) (paint-p 'paint) + ((and span-proof (plist-get span-proof :static-cascade-p)) + 'owner-scoped) (span-proof 'span-patch)))) + (when projection-kind + (setq report (plist-put report :projection-kind projection-kind))) + (when mixed-proof + (setq prepared (plist-put prepared :mixed-owner-proof mixed-proof)) + (setq report + (ebox-incremental--plist-overlay + report + (list :strategy 'mixed-owner-reflow + :owner-ids (plist-get mixed-proof :owner-ids) + :patch-count (length (plist-get mixed-proof :owner-ids)) + :publication-scope 'mixed-owner-union + :render-scope 'mixed-owner-union)))) + (when (eq projection-kind 'owner-scoped) + (setq report + (plist-put report :ancestor-slot-count + (length (plist-get span-proof + :ancestor-slot-signature)))) + (setq report + (plist-put report :ancestor-slot-generation + (plist-get span-proof + :layout-snapshot-detail-generation)))) (unless same-root-identity-p (setq report (plist-put report :strategy 'root-rerender)) (setq report (plist-put report :publication-scope 'root)) (setq report (plist-put report :root-rerender t))) + (when (> (or (plist-get prepared :range-replacement-count) 0) 0) + (let* ((range-metrics (copy-tree (plist-get prepared :range-metrics))) + (applied (cl-loop for entry in range-metrics + sum (plist-get entry :ref-index-visits))) + (requested (plist-get prepared :range-replacement-count))) + (setq report + (plist-put report :range-metrics + (list :parents range-metrics + :replacement-count requested + :applied-count applied + :coalesced-count (- requested applied)))))) (list :root (plist-get prepared :root) :scope-node-ids scope-node-ids :report-base report @@ -6038,7 +7956,8 @@ metadata; this predicate only authorizes the local attempt." :preserve-identities-p t :state-overrides (ebox-incremental--surface-state-overrides - old-state prepared candidate-state projection-kind span-proof)))) + old-state prepared candidate-state projection-kind span-proof + nil formatting-proof)))) (defun ebox-incremental--plist-overlay (base overrides) "Return BASE with every property in OVERRIDES replaced." @@ -6048,11 +7967,14 @@ metadata; this predicate only authorizes the local attempt." base) (defun ebox-incremental--prepare-scoped-candidate - (buffer old-state next-root isolated-candidate-p) + (buffer old-state next-root isolated-candidate-p + &optional skip-span-proof-p scroll-transaction-p) "Prepare NEXT-ROOT and its scoped owner plan for BUFFER. Return the intermediate candidate state, owner plan, projection proof, and whether NEXT-ROOT shares untouched published nodes." - (let* ((path-copied-p + (let* ((ebox-incremental--allocated-slot-proof-cache + (make-hash-table :test 'equal)) + (path-copied-p (and isolated-candidate-p (ebox-incremental--candidate-shares-published-node-p old-state next-root))) @@ -6063,17 +7985,40 @@ whether NEXT-ROOT shares untouched published nodes." (prepared (if isolated-candidate-p (ebox-incremental--prepare-declarative-runtime - buffer old-state next-root nil local-preparation) + buffer old-state next-root nil local-preparation + skip-span-proof-p) (ebox-incremental--prepare-declarative-root buffer old-state next-root))) (candidate-state (ebox-incremental--candidate-state old-state (plist-get prepared :root) (plist-get prepared :index) prepared)) + (formatting-proof + (and (not scroll-transaction-p) + (not (cl-some + (lambda (entry) + (eq (plist-get entry :dirty-kind) 'paint)) + (plist-get prepared :dirty-set))) + (ebox-incremental--formatting-context-reflow-proof + buffer old-state candidate-state prepared))) (owner-plan - (ebox-incremental--layout-owner-plan - buffer old-state candidate-state - (plist-get prepared :dirty-set))) + (if formatting-proof + (list + (ebox--patch-op + 'formatting-context-reflow + (plist-get formatting-proof :owner-id) + :dirty (plist-get formatting-proof :dirty-set) + :proof formatting-proof)) + (unless scroll-transaction-p + (let ((ebox-incremental--candidate-state-for-slot-proof + candidate-state)) + (ebox-incremental--layout-owner-plan + buffer old-state candidate-state + (plist-get prepared :dirty-set)))))) + (mixed-proof + (and (not scroll-transaction-p) + (ebox-incremental--mixed-owner-proof + buffer old-state candidate-state prepared owner-plan))) (scope-node-ids (delete-dups (or (mapcar (lambda (op) (plist-get op :owner-id)) owner-plan) @@ -6083,19 +8028,29 @@ whether NEXT-ROOT shares untouched published nodes." (ebox-incremental--paint-projection-p old-state owner-plan (plist-get prepared :dirty-set))) (span-proof - (unless paint-p + (unless (or paint-p mixed-proof skip-span-proof-p) (ebox-incremental--span-patch-projection-proof buffer old-state prepared candidate-state owner-plan path-copied-p))) (projection-kind - (cond + (cond + (mixed-proof 'mixed-owner-reflow) + (formatting-proof 'formatting-context-reflow) (paint-p 'paint) + ((and span-proof (plist-get span-proof :static-cascade-p)) + 'owner-scoped) (span-proof 'span-patch)))) + (setq prepared (plist-put prepared :scroll-patch-fast-p + skip-span-proof-p)) + (when mixed-proof + (setq prepared (plist-put prepared :mixed-owner-proof mixed-proof))) (list :prepared prepared :candidate-state candidate-state :owner-plan owner-plan :scope-node-ids scope-node-ids :span-proof span-proof + :mixed-proof mixed-proof + :formatting-proof formatting-proof :projection-kind projection-kind :path-copied-p path-copied-p))) @@ -6107,45 +8062,96 @@ contains the isolated candidate root, Ebox node identities, report, and runtime overrides; the surface layer resolves identities to opaque TP objects. When ISOLATED-CANDIDATE-P is non-nil, NEXT-ROOT is an internally copied runtime candidate whose identities already match the published root." - (let ((old-state (ebox--buffer-render-state buffer))) + (let ((old-state (ebox--buffer-render-state buffer)) + (scroll-transaction-p + (plist-get report-overrides :scroll-state-transaction)) + (scroll-patch-fast-p + (plist-get report-overrides :scroll-patch-fast-p))) (unless old-state (error "Ebox buffer has no rendered runtime: %S" buffer)) (let* ((candidate (ebox-incremental--prepare-scoped-candidate - buffer old-state next-root isolated-candidate-p))) + buffer old-state next-root isolated-candidate-p + scroll-patch-fast-p scroll-transaction-p))) ;; A path-copied candidate is safe to render in place only after the ;; strict span proof succeeds. Widened projection would mutate shared ;; layout nodes, so promote it to a private copy before the surface sees ;; it. The ordinary full-copy path remains the correctness fallback. (when (and (plist-get candidate :path-copied-p) - (not (eq (plist-get candidate :projection-kind) - 'span-patch))) + (not scroll-patch-fast-p) + (not (memq (plist-get candidate :projection-kind) + '(span-patch owner-scoped scroll-patch + mixed-owner-reflow)))) (setq candidate (ebox-incremental--prepare-scoped-candidate buffer old-state (ebox-tree-copy-node-structure (plist-get (plist-get candidate :prepared) :root)) - isolated-candidate-p))) + isolated-candidate-p scroll-patch-fast-p + scroll-transaction-p))) (let* ((prepared (plist-get candidate :prepared)) (candidate-state (plist-get candidate :candidate-state)) - (owner-plan (plist-get candidate :owner-plan)) - (scope-node-ids (plist-get candidate :scope-node-ids)) + (owner-plan + (or (plist-get candidate :owner-plan) + (and scroll-transaction-p + (list + (ebox--patch-op + 'span-patch + (plist-get report-overrides :owner-id) + :dirty (plist-get prepared :dirty-set) + :proof-skipped-p t))))) + (scope-node-ids + (if scroll-transaction-p + (list (plist-get report-overrides :owner-id)) + (plist-get candidate :scope-node-ids))) (span-proof (plist-get candidate :span-proof)) + (formatting-proof (plist-get candidate :formatting-proof)) (projection-kind (plist-get candidate :projection-kind)) (report (ebox-incremental--plist-overlay (ebox-incremental--layout-owner-report prepared owner-plan candidate-state) report-overrides))) - (list :root (plist-get prepared :root) + (when scroll-transaction-p + ;; Scroll changes already carry a bounded rendered window in the + ;; staged scroll state. Publish that window through the retained + ;; object scope instead of re-running the full root layout. + (setq projection-kind 'scroll-patch) + (setq report (plist-put report :projection-kind projection-kind))) + (when projection-kind + (setq report (plist-put report :projection-kind projection-kind))) + (when (eq projection-kind 'owner-scoped) + (setq report + (plist-put report :ancestor-slot-count + (length (plist-get span-proof + :ancestor-slot-signature)))) + (setq report + (plist-put report :ancestor-slot-generation + (plist-get span-proof + :layout-snapshot-detail-generation)))) + (let ((state-overrides + (ebox-incremental--surface-state-overrides + old-state prepared candidate-state projection-kind span-proof + (plist-get candidate :path-copied-p) formatting-proof))) + (when scroll-transaction-p + (setq state-overrides + (plist-put state-overrides :scroll-state-transaction t)) + (setq state-overrides + (plist-put state-overrides :scroll-patch-region-id + (plist-get report-overrides :region-id))) + (setq state-overrides + (plist-put state-overrides :span-patch-owner-id + (or (plist-get state-overrides :span-patch-owner-id) + (plist-get report-overrides :owner-id)))) + (setq state-overrides + (plist-put state-overrides :scroll-fast-window-p + scroll-patch-fast-p))) + (list :root (plist-get prepared :root) :scope-node-ids scope-node-ids :report-base report :projection-kind projection-kind :preserve-identities-p t - :state-overrides - (ebox-incremental--surface-state-overrides - old-state prepared candidate-state projection-kind span-proof - (plist-get candidate :path-copied-p))))))) + :state-overrides state-overrides)))))) (defun ebox-incremental--viewport-state-overrides (state) "Return surface overrides from viewport candidate STATE." @@ -6175,6 +8181,7 @@ runtime candidate whose identities already match the published root." :region-node-table (plist-get state :region-node-table) :region-box-count-table (plist-get state :region-box-count-table) :host-ref-table (plist-get state :host-ref-table) + :range-ref-table (plist-get state :range-ref-table) :selector-id-table (plist-get state :selector-id-table) :selector-class-table (plist-get state :selector-class-table) :selector-type-table (plist-get state :selector-type-table) @@ -6223,7 +8230,51 @@ runtime candidate whose identities already match the published root." This strict projection retains only viewport-independent scroll producers." (and (ebox-incremental--viewport-root-proof-p old-state candidate-state dirty-set owner-plan) - (ebox-incremental--stable-scroll-state-p old-state))) + (or (ebox-incremental--stable-scroll-state-p old-state) + (ebox-incremental--viewport-root-scroll-reflow-proof-p + old-state candidate-state)))) + +(defun ebox-incremental--viewport-root-scroll-reflow-proof-p + (old-state candidate-state) + "Return non-nil for one resizable root scroll owner. +The root itself is the only scroll producer, so its viewport-dependent +content is exactly the formatting context being reflowed. This proof does +not authorize nested scroll owners, visible overflow, cascade changes, or +topology changes; those continue to use the conservative full projection." + (let* ((old-root (plist-get old-state :root-node)) + (candidate-root (plist-get candidate-state :root-node)) + (root-id (and old-root (plist-get old-root :node-id))) + (scroll-ids (plist-get old-state :scroll-region-ids)) + (region-node-table (plist-get old-state :region-node-table)) + (scroll-table (plist-get old-state :scroll-state-table)) + (region-id (and (= (length scroll-ids) 1) + (car scroll-ids))) + (region-node-id (and region-id region-node-table + (gethash region-id region-node-table))) + (candidate-scroll-table + (plist-get candidate-state :scroll-state-table))) + (and old-root candidate-root + (eq old-root candidate-root) + root-id region-id + (equal region-node-id root-id) + (hash-table-p scroll-table) + (gethash region-id scroll-table) + (hash-table-p candidate-scroll-table) + (ebox-incremental--hash-key-set-equal-p + scroll-table candidate-scroll-table) + (not (ebox-tree-node-visible-overflow-p old-root)) + (not (plist-get old-state :cascade-active-p)) + (not (plist-get old-state :cascade-required-p)) + (not (ebox-style-cascade-active-p)) + (ebox-incremental--hash-key-set-equal-p + (plist-get old-state :node-table) + (plist-get candidate-state :node-table)) + (ebox-incremental--hash-key-set-equal-p + (plist-get old-state :region-id-set) + (plist-get candidate-state :region-id-set)) + (ebox-incremental--hash-key-set-equal-p + (plist-get old-state :parent-table) + (plist-get candidate-state :parent-table))))) (defun ebox-incremental--stable-scroll-state-p (state) "Return non-nil when STATE's scroll producers are safe to retain. @@ -6312,6 +8363,7 @@ fresh by the mixed projection." :region-box-count-table (plist-get candidate-state :region-box-count-table) :region-box-table (plist-get candidate-state :region-box-table) :host-ref-table (plist-get candidate-state :host-ref-table) + :range-ref-table (plist-get candidate-state :range-ref-table) :selector-id-table (plist-get candidate-state :selector-id-table) :selector-class-table (plist-get candidate-state :selector-class-table) :selector-type-table (plist-get candidate-state :selector-type-table) @@ -6444,14 +8496,30 @@ fresh by the mixed projection." (scroll-keys &optional prefetch-delay) "Retire stale scroll work and resume committed SCROLL-KEYS. PREFETCH-DELAY is forwarded when a live, inactive scroll region needs warming." - (dolist (region-id scroll-keys) - (ignore-errors (ebox--scroll-cancel-idle-prefetch region-id)) - (if (gethash region-id ebox--scroll-global-state) - (unless (gethash region-id ebox--smooth-scroll-state-table) - (ignore-errors - (ebox--scroll-schedule-idle-prefetch - region-id prefetch-delay))) - (ignore-errors (ebox--smooth-scroll-stop region-id))))) + (let (diagnostics) + (cl-labels + ((run (region-id action function) + (let ((inhibit-quit t) + (quit-flag nil)) + (condition-case failure + (funcall function) + ((error quit) + (push (list :region-id region-id :phase 'scroll-finalization + :action action + :condition failure) + diagnostics)))))) + (dolist (region-id scroll-keys) + (run region-id 'cancel-prefetch + (lambda () (ebox--scroll-cancel-idle-prefetch region-id))) + (if (gethash region-id ebox--scroll-global-state) + (unless (gethash region-id ebox--smooth-scroll-state-table) + (run region-id 'schedule-prefetch + (lambda () + (ebox--scroll-schedule-idle-prefetch + region-id prefetch-delay)))) + (run region-id 'stop-smooth-scroll + (lambda () (ebox--smooth-scroll-stop region-id)))))) + (nreverse diagnostics))) (defun ebox-incremental--commit-report (prepared patch-report state) "Return the declarative report for PREPARED, PATCH-REPORT, and STATE." diff --git a/ebox-layout.el b/ebox-layout.el index 7367ca7..0582d85 100644 --- a/ebox-layout.el +++ b/ebox-layout.el @@ -40,6 +40,9 @@ must not stretch their own outer width to that containing block.") (defvar ebox--flat-preformatted-box-fast-path-disabled nil "Non-nil disables one-pass preformatted wrapper rendering for diagnostics.") +(declare-function ebox--strip-paint-origins! + "ebox-render-context" (string)) + (defun ebox--record-rendered-uniform-width (rendered pixel-width) "Record that every line of RENDERED is exactly PIXEL-WIDTH wide." (when (and (stringp rendered) (numberp pixel-width)) @@ -203,18 +206,40 @@ and its formatted content exactly fills the used height." (ebox--format-content-string box content))) (lines (ebox-string-lines formatted)) (text-height (length lines)) - (content-height (ebox--content-height box text-height))) - (when (and (= text-height content-height) - (ebox--preformatted-content-lines-fit-p - lines (ebox--content-pixel box))) + (content-height (ebox--content-height box text-height)) + (content-pixel (ebox--content-pixel box)) + (lines-fit-p + (ebox--preformatted-content-lines-fit-p lines content-pixel)) + (underfilled-simple-scroll-p + (and lines-fit-p + (< text-height content-height) + (eq (ebox-get box :overflow) 'scroll) + (= (ebox-get box :padding-left-pixel) 0) + (= (ebox-get box :padding-right-pixel) 0) + (= (floor (ebox-get box :padding-top-height)) 0) + (= (floor (ebox-get box :padding-bottom-height)) 0) + (= (ebox-get box :border-left-pixel) 0) + (= (ebox-get box :border-right-pixel) 0) + (not (ebox-get box :border-top-p)) + (not (ebox-get box :border-bottom-p))))) + (when (and lines-fit-p + (or (= text-height content-height) + underfilled-simple-scroll-p)) (let* ((region-id (or ebox--render-region-id (ebox--ensure-region-id box))) - (content-pixel (ebox--content-pixel box)) (padding-line-filler (ebox-pixel-space content-pixel)) (rendered - (ebox-lines-join - (ebox--window-render-flat-wrapper-chunk-lines - box lines 0 region-id padding-line-filler t t)))) + (if underfilled-simple-scroll-p + (ebox-lines-join + (ebox--render-underfilled-simple-scroll-lines + lines region-id content-height padding-line-filler + (ebox-get box :color) (ebox-get box :bgcolor))) + (ebox-lines-join + (ebox--window-render-flat-wrapper-chunk-lines + box lines 0 region-id padding-line-filler t t))))) + (when underfilled-simple-scroll-p + (ebox--apply-surface-properties + rendered (ebox-get box :surface-properties))) (puthash region-id box ebox--region-box-table) (unless ebox--intrinsic-layout-measurement (ebox--scroll-clear-state region-id)) @@ -227,6 +252,15 @@ and its formatted content exactly fills the used height." (defvar ebox--scroll-window-render-result nil "Dynamic metadata for the current box's lazy scroll-window render.") +(defvar ebox--scroll-window-cached-state nil + "Dynamic staged scroll state used by a bounded cached-window projection.") + +(defvar ebox--scroll-window-cached-rendered-lines-p nil + "Non-nil when cached scroll lines already carry wrapper ownership.") + +(defvar ebox--scroll-window-skip-state-rebuild-p nil + "Non-nil when a scroll projection already staged its derived line indexes.") + (defvar ebox--scroll-rendered-content-lines-private-p nil "Non-nil when scroll content line inputs may receive ownership in place.") @@ -260,6 +294,8 @@ and its formatted content exactly fills the used height." (source preserve-identities-p)) (declare-function ebox-surface--inline-inheritance-required-p "ebox-surface" (root)) +(declare-function ebox--add-render-face! + "ebox-render-context" (string start end face &optional append)) (defun ebox--register-window-line-renderer (type function) "Register FUNCTION as TYPE's lazy window-line renderer. @@ -389,12 +425,12 @@ START-INDEX is the first source line index represented by LINES." ;; `ebox-string-lines' made these source lines private, and blank ;; normalization above creates a fresh filler. Apply the same face ;; properties in place instead of copying every viewport-wide line. - (when color - (add-face-text-property - 0 (length line) `(:foreground ,color) t line)) + (when color + (ebox--add-render-face! + line 0 (length line) `(:foreground ,color) t)) (when bgcolor - (add-face-text-property - 0 (length line) `(:background ,bgcolor) t line)) + (ebox--add-render-face! + line 0 (length line) `(:background ,bgcolor) t)) line)) (cl-loop for line in lines for index from 0 @@ -831,7 +867,9 @@ FALLBACK is used for nil, auto, or unavailable viewport-height values." (when (and content-viewport (not (eq (and (listp node) (plist-get node :ebox-type)) 'box)) - (not ebox--intrinsic-layout-measurement)) + (not ebox--intrinsic-layout-measurement) + (equal (gethash content ebox--rendered-uniform-width-table) + content-viewport)) (plist-put box :ebox-content-width-exact-p t)) content)) @@ -1210,10 +1248,16 @@ Internal implementation of `ebox-render' for box nodes." (= border-left-pixel 0) (= border-right-pixel 0) (eq (ebox-get box :vertical-align) 'top)) - (let ((ebox--scroll-rendered-content-lines-private-p - private-formatted-lines-p)) - (ebox--scroll-rendered-content-lines - box formatted-lines region-id 0)))) + (if (plist-get scroll-window-result + :cached-rendered-lines-p) + ;; The staged producer already applied content/owner + ;; properties. Re-running the generic ownership pass here + ;; was the dominant grid-scroll stall. + formatted-lines + (let ((ebox--scroll-rendered-content-lines-private-p + private-formatted-lines-p)) + (ebox--scroll-rendered-content-lines + box formatted-lines region-id 0))))) (simple-scroll-rendered-lines (or underfilled-simple-scroll-lines @@ -1315,7 +1359,8 @@ Internal implementation of `ebox-render' for box nodes." ;; Intrinsic measurement must leave published scroll state alone: its ;; placeholder content always looks fully visible and would clear the ;; live lazy producer state. - (unless ebox--intrinsic-layout-measurement + (unless (or ebox--intrinsic-layout-measurement + ebox--scroll-window-skip-state-rebuild-p) (if (and (eq overflow 'scroll) (> text-height content-height)) (ebox--scroll-set-state @@ -1520,21 +1565,25 @@ region/node identities and render side tables for this one materialization." "Render layout NODE to a multi-line string through a TP materialization. NODE accepts every layout node supported by `ebox--render-layout'. The materialized surface is ephemeral and creates no live buffer state." - (if (or ebox--surface-materialization-active - ebox--render-runtime-revision) - (ebox--render-layout node) - (require 'ebox-surface) - (if (and (not (stringp node)) - (not (ebox-style-cascade-active-p)) - (not (ebox-surface--inline-inheritance-required-p node))) - (let ((ebox--region-id-counter ebox--region-id-counter) - (ebox--runtime-node-id-counter ebox--runtime-node-id-counter)) - (ebox--render-ephemeral-static node)) - (let ((ebox--surface-materialization-active t) - (ebox--region-id-counter ebox--region-id-counter) - (ebox--runtime-node-id-counter ebox--runtime-node-id-counter)) - (tp-surface-materialize-string - (ebox-surface-producer node nil t)))))) + (let ((rendered + (if (or ebox--surface-materialization-active + ebox--render-runtime-revision) + (ebox--render-layout node) + (require 'ebox-surface) + (if (and (not (stringp node)) + (not (ebox-style-cascade-active-p)) + (not (ebox-surface--inline-inheritance-required-p node))) + (let ((ebox--region-id-counter ebox--region-id-counter) + (ebox--runtime-node-id-counter ebox--runtime-node-id-counter)) + (ebox--render-ephemeral-static node)) + (let ((ebox--surface-materialization-active t) + (ebox--region-id-counter ebox--region-id-counter) + (ebox--runtime-node-id-counter ebox--runtime-node-id-counter)) + (tp-surface-materialize-string + (ebox-surface-producer node nil t))))))) + (unless ebox--paint-origin-capture-p + (ebox--strip-paint-origins! rendered)) + rendered)) (defun ebox--width-pad (string extra-pixels) "Append a display-space of EXTRA-PIXELS to the right of every line in STRING. @@ -1583,11 +1632,14 @@ PLIST accepts the same properties as `ebox-create', such as :width, ;;;###autoload (defun ebox-row (&rest nodes) "Return a lazy horizontal layout node from NODES. -Nil entries are ignored. With zero non-nil nodes, return `ebox-spacer'." +Nil entries are ignored. With zero non-nil nodes, return `ebox-spacer'. +A sole child Range keeps a material row parent so the Range stays addressable." (setq nodes (delq nil nodes)) (cond ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) + ((and (null (cdr nodes)) + (not (ebox-child-range--descriptor-p (car nodes)))) + (car nodes)) (t (list :ebox-type 'concat :display '(block row) :children nodes)))) @@ -1598,13 +1650,17 @@ Children are rendered; shorter children are padded with blank lines so all reach the same height before horizontal concatenation." (let* ((rendered (mapcar #'ebox--render-with-cache (ebox--layout-children node))) - (max-h (apply #'max (mapcar #'ebox-string-height rendered))) + (max-h (if rendered + (apply #'max (mapcar #'ebox-string-height rendered)) + 0)) (line-lists (mapcar (lambda (string) (ebox-string-lines (ebox--height-pad string max-h))) rendered))) - (ebox-lines-join (apply #'cl-mapcar #'concat line-lists)))) + (if line-lists + (ebox-lines-join (apply #'cl-mapcar #'concat line-lists)) + ""))) ;;;###autoload (defun ebox-stack (node1 node2) @@ -1623,11 +1679,15 @@ is called. To stack more than two boxes, nest calls: ;;;###autoload (defun ebox-column (&rest nodes) "Return a lazy vertical layout node from NODES. -Nil entries are ignored. With zero non-nil nodes, return `ebox-spacer'." +Nil entries are ignored. With zero non-nil nodes, return `ebox-spacer'. +A sole child Range keeps a material column parent so the Range stays +addressable." (setq nodes (delq nil nodes)) (cond ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) + ((and (null (cdr nodes)) + (not (ebox-child-range--descriptor-p (car nodes)))) + (car nodes)) (t (list :ebox-type 'stack :display '(block column) :children nodes)))) @@ -2497,8 +2557,19 @@ no included vertical margin." for source-line in content-lines for idx from start-index collect - (let* ((blank-replacement-p + (let* ((child-ownership-uniform-p + (cl-every + (lambda (property) + (not + (text-property-not-all + 0 (length source-line) property + (get-text-property 0 property source-line) + source-line))) + '(ebox-content ebox-content-idx + ebox-content-owner ebox-content-owners))) + (blank-replacement-p (and (string-blank-p source-line) + child-ownership-uniform-p (not (ebox--line-has-non-content-properties-p source-line)))) (line @@ -2508,16 +2579,36 @@ no included vertical margin." 0 'ebox-content source-line)) (content-idx (get-text-property - 0 'ebox-content-idx source-line))) - (if content-id - (propertize padding-line-filler - 'ebox-content content-id - 'ebox-content-idx content-idx - 'ebox-content-owner region-id) - (propertize padding-line-filler - 'ebox-content region-id - 'ebox-content-idx idx - 'ebox-content-owner region-id))) + 0 'ebox-content-idx source-line)) + (content-owner + (get-text-property + 0 'ebox-content-owner source-line)) + (content-owners + (get-text-property + 0 'ebox-content-owners source-line))) + (if (or content-owner content-owners) + (ebox--propertize-content-line + (propertize + padding-line-filler + 'ebox-content content-id + 'ebox-content-idx content-idx + 'ebox-content-owner + (or content-owner content-id) + 'ebox-content-owners + (or content-owners + (list content-owner))) + region-id idx padding-line-filler) + (if content-id + (propertize + padding-line-filler + 'ebox-content content-id + 'ebox-content-idx content-idx + 'ebox-content-owner region-id) + (propertize + padding-line-filler + 'ebox-content region-id + 'ebox-content-idx idx + 'ebox-content-owner region-id)))) (let* ((colored-p (or color bgcolor)) (owned-source (if colored-p @@ -2833,6 +2924,36 @@ only used for incomplete lazy prefixes." (defun ebox--format-scroll-window-content (box) "Return a lazily rendered scroll content window for BOX, or nil." + (catch 'ebox-scroll-window-cached + (let* ((cached ebox--scroll-window-cached-state) + (cached-box (and cached (plist-get cached :box))) + (cached-id (and cached-box (plist-get cached-box :node-id))) + (box-id (and (listp box) (plist-get box :node-id))) + (cached-rendered-lines + (and cached (plist-get cached :rendered-content-lines))) + (use-cached-rendered-lines-p + (and ebox--scroll-window-skip-state-rebuild-p + cached-rendered-lines)) + (cached-lines (and cached + (or (and use-cached-rendered-lines-p + cached-rendered-lines) + (plist-get cached :content-lines))))) + (when (and cached cached-box cached-lines box-id + (equal box-id cached-id) + (eq (ebox-get box :overflow) 'scroll)) + (setq ebox--scroll-window-render-result + (list :complete (plist-get cached :content-lines-complete-p) + :content-height (plist-get cached :content-height) + :scroll-window-producer-spec + (plist-get cached :scroll-window-producer-spec) + :render-content-prefix + (plist-get cached :render-content-prefix) + :materialize-content-lines + (plist-get cached :materialize-content-lines) + :cached-rendered-lines-p + (and use-cached-rendered-lines-p t))) + (throw 'ebox-scroll-window-cached + (ebox-lines-join cached-lines)))) (let ((content-height (ebox--scroll-window-content-height box)) (scroll-offset (max 0 (or (ebox-get box :scroll-offset) 0))) (content-viewport (ebox--wrapper-content-viewport-pixel box)) @@ -2882,7 +3003,7 @@ only used for incomplete lazy prefixes." (ebox-lines-join (if (plist-get window :complete) formatted-lines - (seq-take formatted-lines target-lines))))))))) + (seq-take formatted-lines target-lines)))))))))) (defun ebox--render-stack (node) "Render a stack NODE to a string (internal, called by `ebox-render'). @@ -2898,7 +3019,9 @@ stack itself uses its natural max child width." (cons rendered (ebox--string-max-pixel-width rendered)))) (ebox--stack-leaves node))) - (max-w (apply #'max (mapcar #'cdr rendered-items))) + (max-w (if rendered-items + (apply #'max (mapcar #'cdr rendered-items)) + 0)) (target-w (if ebox--intrinsic-layout-measurement max-w (or (ebox--viewport-pixel-width nil) max-w)))) diff --git a/ebox-native-reflow.el b/ebox-native-reflow.el index 5c7f514..080f4ee 100644 --- a/ebox-native-reflow.el +++ b/ebox-native-reflow.el @@ -1812,7 +1812,7 @@ Rust still verifies the dynamic equal-width and nonempty-line proof per frame." content-min (not (eq content-min missing)))) (ebox-native-reflow--compile-flex-item item axis))) - (plist-get node :children)))))) + (ebox-tree-layout-children node)))))) (if wrapper (ebox-native-reflow--compile-box wrapper inner t) inner))) @@ -1842,6 +1842,7 @@ Grid deliberately stays on the ordinary Ebox renderer until the native backend has a matching two-dimensional layout contract." (cond ((or (null node) (stringp node) (not (listp node))) t) + ((plist-get node :ebox-child-sequence) nil) ((eq (plist-get node :ebox-type) 'grid) nil) ((eq (plist-get node :ebox-type) 'box) (ebox-native-reflow--native-node-supported-p @@ -1853,7 +1854,7 @@ backend has a matching two-dimensional layout contract." (cl-every #'ebox-native-reflow--native-node-supported-p (append (when-let ((box (plist-get node :box))) (list box)) - (plist-get node :children)))) + (ebox-tree-layout-children node)))) ((eq (plist-get node :ebox-type) 'flex-item) (ebox-native-reflow--native-node-supported-p (plist-get node :node))) (t nil))) diff --git a/ebox-render-context.el b/ebox-render-context.el index 0bc81fe..684d712 100644 --- a/ebox-render-context.el +++ b/ebox-render-context.el @@ -22,6 +22,17 @@ (defvar ebox--render-owned-text-values nil "Candidate-local text-property values explicitly created by Ebox.") +(cl-defstruct (ebox--paint-origin + (:constructor ebox--paint-origin-create)) + "Transient caller-face baseline captured before Ebox paint composition." + baseline) + +(defconst ebox--paint-origin-property 'ebox--paint-origin + "Private transient property carrying one render-time paint baseline.") + +(defvar ebox--paint-origin-capture-p nil + "Non-nil while production Ebox rendering captures paint origins.") + (defvar ebox--render-output-provenance-table (make-hash-table :test #'eq :weakness 'key) "Weak map from rendered strings to Ebox-owned property values.") @@ -50,6 +61,47 @@ REGISTRY defaults to the active render candidate." (when-let ((values (ebox--render-owned-text-values-for property))) (gethash value values)))) +(defun ebox--capture-paint-origins! (string start end) + "Capture caller FACE baselines on STRING between START and END. +Existing origins are preserved so nested Ebox contributions never replace the +original caller baseline. The property is stripped before a TP plan leaves +the render boundary." + (when (and ebox--paint-origin-capture-p + (stringp string) + (< start end)) + (let ((position start)) + (while (< position end) + (let* ((next (min end + (or (next-single-property-change + position ebox--paint-origin-property string end) + end))) + (origin (get-text-property + position ebox--paint-origin-property string))) + (unless origin + (put-text-property + position next ebox--paint-origin-property + (ebox--paint-origin-create + :baseline (copy-tree (get-text-property position 'face string))) + string)) + (setq position (max next (1+ position))))))) + string) + +(defun ebox--add-render-face! (string start end face &optional append) + "Add Ebox FACE to STRING after capturing its caller baseline." + (ebox--capture-paint-origins! string start end) + (add-face-text-property start end face append string)) + +(defun ebox--strip-paint-origins! (string) + "Remove transient caller-face carriers from STRING before it escapes. +The carrier is retained only while an active surface producer harvests its +baseline. Public/ephemeral renders must never expose this private property, +including strings returned from a render-cache hit." + (when (and (stringp string) + (> (length string) 0)) + (remove-text-properties + 0 (length string) (list ebox--paint-origin-property nil) string)) + string) + (defun ebox--register-render-owned-face-values (source rendered) "Register Ebox-generated face identities added to RENDERED from SOURCE." (when (and (stringp source) diff --git a/ebox-style.el b/ebox-style.el index 516ce1a..9ae6d79 100644 --- a/ebox-style.el +++ b/ebox-style.el @@ -227,6 +227,18 @@ (defvar ebox-style-schemas (ecss-schema-set-create) "ECSS property schemas for the isolated Ebox style domain.") +(defvar ebox-style--registered-schemas nil + "Schema-set object whose Ebox properties are already registered. +`ecss-schema-set-property' returns a detached schema copy, so probing it on +every `ebox-create' needlessly copies the entire property metadata domain.") + +(defconst ebox-style--declaration-cache-max-entries 512 + "Maximum canonical declaration compilations retained by Ebox.") + +(defvar ebox-style--declaration-cache + (make-hash-table :test 'equal) + "Bounded memo table for canonical Ebox declaration compilation.") + (defun ebox-style--ensure-property-table () "Return the canonical style property registry table." (or ebox-style--property-table @@ -590,12 +602,18 @@ (dolist (property ebox-style--property-definitions) (apply #'ecss-schema-set-define ebox-style-schemas (plist-get property :id) - (ebox-style--schema-options property)))) + (ebox-style--schema-options property))) + (setq ebox-style--registered-schemas ebox-style-schemas)) (defun ebox-style--ensure-properties () "Ensure Ebox property schemas exist in the isolated ECSS schema set." - (unless (ecss-schema-set-property ebox-style-schemas 'ebox/color) - (ebox-style-register-properties))) + (unless (eq ebox-style--registered-schemas ebox-style-schemas) + ;; Only the first call for a new schema-set needs to inspect/register the + ;; domain. Avoid the detached `ecss-schema-set-property' accessor on the + ;; hot `ebox-create' path; it recursively copies schema metadata. + (if (ecss-schema-set-property ebox-style-schemas 'ebox/color) + (setq ebox-style--registered-schemas ebox-style-schemas) + (ebox-style-register-properties)))) (defvar ebox-style-stylesheet (ecss-stylesheet-create) "Isolated ECSS stylesheet containing Ebox layout and paint rules.") @@ -628,6 +646,21 @@ cascade pass during its initial static projection." "Return non-nil when PLIST is a proper even-length list." (and (proper-list-p plist) (zerop (% (length plist) 2)))) +(defun ebox-style--declaration-cache-key (plist strict) + "Return a stable style-only cache key for PLIST and STRICT. +Non-style node properties such as content, Host references, and callbacks do +not affect declaration compilation and are intentionally excluded." + (let (canonical) + (cl-loop for (property value) on plist by #'cddr + for schema = (ebox-style-schema-id property) + if schema + do (setq canonical + (append canonical (list schema value))) + else if (ebox-style--custom-property-p property) + do (setq canonical + (append canonical (list property value)))) + (list strict canonical))) + (defun ebox-style--static-invalid-declaration-p (validator value) "Return non-nil when VALIDATOR rejects static VALUE." (pcase validator @@ -657,17 +690,29 @@ When STRICT is non-nil, reject properties outside the Ebox style domain." (ebox-style--ensure-properties) (unless (ebox-style--valid-plist-p plist) (user-error "Ebox style declarations must be an even property list")) - (let ((canonical - (cl-loop for (property value) on plist by #'cddr - for schema = (ebox-style-schema-id property) - if schema append (list schema value) - else if (ebox-style--custom-property-p property) - append (list property value) - else if strict - do (user-error "Unknown Ebox style property: %S" - property)))) - (ebox-style--validate-declaration-values - (ecss-merge-declarations ebox-style-schemas canonical)))) + (let* ((cache-key (ebox-style--declaration-cache-key plist strict)) + (missing (make-symbol "ebox-style-declaration-cache-missing")) + (cached (gethash cache-key ebox-style--declaration-cache missing))) + (if (not (eq cached missing)) + ;; Canonical declaration plists are immutable after compilation; + ;; return a fresh top-level plist so callers own their list spine + ;; without re-running ECSS's recursive boundary copier. + (copy-sequence cached) + (let ((canonical (cadr cache-key))) + (when strict + (cl-loop for (property _value) on plist by #'cddr + unless (or (ebox-style-schema-id property) + (ebox-style--custom-property-p property)) + do (user-error "Unknown Ebox style property: %S" + property))) + (let ((compiled + (ebox-style--validate-declaration-values + (ecss-merge-declarations ebox-style-schemas canonical)))) + (when (>= (hash-table-count ebox-style--declaration-cache) + ebox-style--declaration-cache-max-entries) + (clrhash ebox-style--declaration-cache)) + (puthash cache-key compiled ebox-style--declaration-cache) + (copy-sequence compiled)))))) (defun ebox-style-merge-declarations (base overrides) "Merge canonical BASE and OVERRIDES through ECSS property schemas." @@ -693,6 +738,177 @@ ORIGIN, LAYER, and SCOPE use ECSS cascade semantics." :stylesheet ebox-style-stylesheet :parent-style parent-style :value-resolver #'tp-resolve-value)) +(defconst ebox-style--theme-delta-properties + '(ebox/color ebox/background-color) + "Canonical paint properties eligible for a declaration-only Theme delta.") + +(defconst ebox-style--paint-delta-properties + '(ebox/color ebox/background-color + ebox/border-top-color ebox/border-right-color + ebox/border-bottom-color ebox/border-left-color) + "Canonical paint properties that may change without changing geometry.") + +(defun ebox-style--without-theme-delta-properties (declarations) + "Return DECLARATIONS without the canonical Theme paint properties." + (cl-loop for (property value) on declarations by #'cddr + unless (memq property ebox-style--theme-delta-properties) + append (list property value))) + +(defun ebox-style--without-paint-delta-properties (declarations) + "Return DECLARATIONS without canonical paint-only properties." + (cl-loop for (property value) on declarations by #'cddr + unless (memq property ebox-style--paint-delta-properties) + append (list property value))) + +(defun ebox-style--paint-declarations-equivalent-p (old new) + "Return non-nil when OLD and NEW differ only in paint declarations. +All paint properties retain presence parity; layout, structure, and typography +declarations must remain identical." + (and (equal (ebox-style--without-paint-delta-properties old) + (ebox-style--without-paint-delta-properties new)) + (cl-every + (lambda (property) + (= (if (plist-member old property) 1 0) + (if (plist-member new property) 1 0))) + ebox-style--paint-delta-properties))) + +(defun ebox-style--theme-declarations-equivalent-p (old new) + "Return non-nil when OLD and NEW differ only in explicit Theme paint values. +Both paint properties must retain presence parity and an explicit foreground +winner is required so parent inherited geometry/paint cannot be stale." + (and (equal (ebox-style--without-theme-delta-properties old) + (ebox-style--without-theme-delta-properties new)) + (cl-every + (lambda (property) + (= (if (plist-member old property) 1 0) + (if (plist-member new property) 1 0))) + ebox-style--theme-delta-properties) + (plist-member old 'ebox/color) + (plist-member new 'ebox/color))) + +(defconst ebox-style--inherited-properties + '(ebox/color ebox/font ebox/font-family ebox/font-height + ebox/font-weight ebox/font-slant) + "Inherited ECSS properties whose parent values guard Theme deltas.") + +(defun ebox-style--inherited-style-signature (style) + "Return the inherited-value fingerprint of computed STYLE, or nil. +The fingerprint deliberately contains only values that can flow from a +parent into a descendant, plus custom properties which can feed any +`var' expression. A Theme delta may reuse a computed style only when this +fingerprint is unchanged between the old and candidate parent." + (when (ecss-computed-style-p style) + (list + :inherited + (mapcar (lambda (property) + (cons property (ecss-computed-style-value style property))) + ebox-style--inherited-properties) + :custom-properties (ecss-computed-style-custom-properties style)))) + +(defun ebox-style--theme-delta-computed + (style old-declarations new-declarations + &optional old-parent-style new-parent-style) + "Return a cheap STYLE copy for a safe Theme paint-only declaration delta. +OLD-DECLARATIONS and NEW-DECLARATIONS are the canonical ECSS plists. +OLD-PARENT-STYLE and NEW-PARENT-STYLE are the previous and candidate +computed parent styles, when the subject has an inherited parent. + +The cascade selector facts and every non-Theme declaration must be unchanged; +both Theme properties must keep the same explicit-presence state, and the +inherited parent fingerprint must be unchanged. In that case only the +computed values and winner metadata for those properties change. Any other +shape returns nil so the caller uses the full ECSS computation." + (when (and (ecss-computed-style-p style) + (ebox-style--theme-declarations-equivalent-p + old-declarations new-declarations)) + (let ((changed-p + (cl-some + (lambda (property) + (and (plist-member old-declarations property) + (plist-member new-declarations property) + (not (equal (plist-get old-declarations property) + (plist-get new-declarations property))))) + ebox-style--theme-delta-properties))) + (when (and changed-p + (equal (ebox-style--inherited-style-signature + old-parent-style) + (ebox-style--inherited-style-signature + new-parent-style))) + (let ((values (copy-tree (ecss-computed-style-values style))) + (active (copy-sequence + (ecss-computed-style-active-properties style))) + (specified (copy-sequence + (ecss-computed-style-specified-properties style)))) + (dolist (property ebox-style--theme-delta-properties) + (let ((id (ebox-style-schema-id property))) + (when (plist-member new-declarations property) + (setf values + (plist-put values id + (copy-tree (plist-get new-declarations property)))) + (cl-pushnew id active) + (cl-pushnew id specified)))) + (ecss-computed-style-copy-with-values + style values :active-properties active :specified-properties specified)))))) + +(defun ebox-style--inherited-style-signature-without-theme-color (style) + "Return STYLE's inherited fingerprint excluding the Theme color value. +The caller uses this to prove that a parent update changes only the inherited +foreground value; fonts, custom properties, and all other inherited facts must + remain identical before a computed child style may be copied." + (when (ecss-computed-style-p style) + (list + :inherited + (mapcar + (lambda (property) + (cons property (ecss-computed-style-value style property))) + (delq 'ebox/color (copy-sequence ebox-style--inherited-properties))) + :custom-properties (ecss-computed-style-custom-properties style)))) + +(defun ebox-style--theme-parent-delta-computed + (style declarations old-parent-style new-parent-style) + "Return a copied STYLE when a static parent changes only Theme color. +For an explicit child color, STYLE is reusable unchanged. For an inherited +child color, the copied value follows NEW-PARENT-STYLE. OLD-PARENT-STYLE and +NEW-PARENT-STYLE must have identical non-color inherited fingerprints; any +provenance or parent-shape mismatch returns nil for normal ECSS computation." + (when (and (ecss-computed-style-p style) + (proper-list-p declarations) + (ecss-computed-style-p old-parent-style) + (ecss-computed-style-p new-parent-style) + (equal + (ebox-style--inherited-style-signature-without-theme-color + old-parent-style) + (ebox-style--inherited-style-signature-without-theme-color + new-parent-style))) + (if (ecss-computed-style-specified-p style 'ebox/color) + (ecss-computed-style-copy-with-values + style (ecss-computed-style-values style)) + (when (and (equal (ecss-computed-style-value + style 'ebox/color) + (ecss-computed-style-value + old-parent-style 'ebox/color)) + (not (equal (ecss-computed-style-value + old-parent-style 'ebox/color) + (ecss-computed-style-value + new-parent-style 'ebox/color)))) + (let ((values (copy-tree (ecss-computed-style-values style)))) + (setq values + (plist-put values 'ebox/color + (copy-tree + (ecss-computed-style-value + new-parent-style 'ebox/color)))) + (ecss-computed-style-copy-with-values style values)))))) + +(defun ebox-style--theme-inherited-delta-computed + (style declarations old-parent-style new-parent-style) + "Return a copied STYLE when only inherited Theme color changed. +This compatibility entry point requires STYLE to inherit its color; explicit +child colors are handled by `ebox-style--theme-parent-delta-computed'." + (when (and (ecss-computed-style-p style) + (not (ecss-computed-style-specified-p style 'ebox/color))) + (ebox-style--theme-parent-delta-computed + style declarations old-parent-style new-parent-style))) + (defun ebox-style--public-computed-values (style) "Return STYLE values using canonical public Ebox property names." (let ((values (ecss-computed-style-values style)) result) diff --git a/ebox-surface.el b/ebox-surface.el index 3be0d17..e7c4e9c 100644 --- a/ebox-surface.el +++ b/ebox-surface.el @@ -23,6 +23,9 @@ (defvar ebox-region-types) (defvar ebox--region-box-table) (defvar ebox--scroll-global-state) +(defvar ebox--paint-origin-property) +(declare-function ebox--paint-origin-baseline + "ebox-render-context" (origin)) (defvar ebox--scroll-idle-prefetch-timers) (defvar ebox--smooth-scroll-state-table) (defvar ebox--buffer-render-state-table) @@ -39,6 +42,7 @@ (defvar ebox-viewport-width) (defvar ebox-viewport-height) (defvar ebox--render-display-signature) +(defvar ebox-incremental--allocated-slot-proof-cache) (declare-function ebox--render-layout "ebox-layout" (node)) (declare-function ebox--record-render-output-provenance @@ -65,6 +69,18 @@ (declare-function ebox--smooth-scroll-stop "ebox" (region-id)) (declare-function ebox-put "ebox" (box property value)) (declare-function ebox-string-lines "ebox" (string)) +(declare-function ebox-lines-join "ebox" (lines)) +(declare-function ebox--scroll-state-rendered-visible-window + "ebox" (state)) +(declare-function ebox--scroll-state-retained-window-ready-p + "ebox" (state)) +(declare-function ebox--scroll-box-contains-grid-p + "ebox" (box)) +(declare-function ebox--scroll-line-region-span + "ebox" (line region-set)) +(declare-function ebox-buffer--span-slot-width + "ebox-buffer-backend" (span)) +(declare-function ebox-pixel-space "ebox" (pixel-width)) (declare-function tp-object-mounted-p "tp-surface" (object)) (declare-function tp-object-attach-content-ranges-owned "tp-surface" (context leaf ranges)) @@ -74,6 +90,10 @@ "tp-surface" (&rest arguments)) (declare-function tp-surface-result-create-owned "tp-surface" (context plan &optional client-state)) +(declare-function tp-surface-retained-content-result-create + "tp-surface" + (context plan rendered ranges &optional client-state + full-surface-p)) (declare-function tp-surface-report-summary "tp-surface" (surface)) (defvar-local ebox-surface--buffer-surface nil @@ -84,9 +104,79 @@ "TP signals carrying one mounted Ebox surface's host context." buffer viewport-width viewport-height display scroll) +(cl-defstruct (ebox-surface--framework-participant + (:constructor ebox-surface--make-framework-participant)) + "One Ebox-owned framework publication participant." + publish rollback state report diagnostics runtime-state scroll-keys + scroll-diagnostics) + (defvar-local ebox-surface--context-signals nil "Buffer-scoped TP signals consumed by the mounted Ebox producer.") +(defvar ebox-surface--scroll-line-fragment-cache + (make-hash-table :test #'eq :weakness 'key) + "Cached property-run templates for immutable rendered scroll lines.") + +(defun ebox-surface--scroll-line-fragment-template (line) + "Return a reusable fragment template for rendered LINE, or nil. +The cache is keyed by the immutable line string object retained by scroll +state. Lines whose ownership is only implied through a neighboring line are +left on the conservative full fragment scanner path." + (or (gethash line ebox-surface--scroll-line-fragment-cache) + (let ((fragments (ebox-surface--rendered-fragments line))) + (when (and fragments + (cl-every (lambda (fragment) + (plist-get fragment :role-ids)) + fragments)) + (puthash line fragments ebox-surface--scroll-line-fragment-cache) + fragments)))) + +(defun ebox-surface--scroll-fragment-data (lines rendered) + "Return offset fragments for visible LINES in RENDERED, or nil. +Each cached line template is copied only at the plist spine and points at the +single joined RENDERED string. The text and role values remain candidate +owned; no per-fragment substring is allocated." + (let ((offset 0) + (line-index 0) + result) + (dolist (line lines) + (let ((template (ebox-surface--scroll-line-fragment-template line))) + (unless template + (cl-return-from ebox-surface--scroll-fragment-data nil)) + (dolist (fragment template) + (let ((copy (copy-sequence fragment))) + (plist-put copy :text rendered) + (plist-put copy :start (+ offset (plist-get fragment :start))) + (plist-put copy :end (+ offset (plist-get fragment :end))) + (plist-put copy :line line-index) + (push copy result)))) + (setq offset (+ offset (length line) 1)) + (setq line-index (1+ line-index))) + (nreverse result))) + +(defun ebox-surface--style-state-table (previous-state) + "Copy retained style state from PREVIOUS-STATE into a weak table." + (let ((table (make-hash-table :test 'eq :weakness 'key))) + (when-let ((previous (plist-get previous-state :style-binding-states))) + (maphash (lambda (object state) (puthash object state table)) previous)) + table)) + +(defun ebox-surface--stylesheet-signature () + "Return one immutable snapshot of the active Ebox stylesheet." + (list (ecss-stylesheet-rules ebox-style-stylesheet) + (ecss-stylesheet-layers ebox-style-stylesheet))) + +(defun ebox-surface--subject-signature (subject) + "Return SUBJECT's complete selector subtree without retaining parent cycles." + (cl-labels + ((subtree (node) + (list (ecss-subject-type node) (ecss-subject-id node) + (ecss-subject-classes node) + (ecss-subject-attributes node) + (ecss-subject-states node) + (mapcar #'subtree (ecss-subject-children node))))) + (subtree subject))) + (defconst ebox-surface--root-key 'ebox/surface "Stable TP key for an Ebox surface projection root.") @@ -181,11 +271,28 @@ construction time and can use the static projection path." fallback)))) (let ((scroll-table (value :scroll-state-table - (plist-get old-state :scroll-state-table)))) + (plist-get old-state :scroll-state-table))) + ;; Prefer the window the user is actually interacting with. A + ;; buffer may also be visible in an older client frame; choosing + ;; that arbitrary window would silently resize a live surface on a + ;; later incremental commit. + (window + (or (and (window-live-p (selected-window)) + (eq (window-buffer (selected-window)) buffer) + (selected-window)) + (get-buffer-window buffer (selected-frame)) + (get-buffer-window buffer t) + (and (not noninteractive) (selected-window))))) (list :viewport-width - (value :viewport-width ebox-viewport-width) + (value :viewport-width + (or ebox-viewport-width + (and (window-live-p window) + (ebox-surface--window-content-width window)))) :viewport-height - (value :viewport-height ebox-viewport-height) + (value :viewport-height + (or ebox-viewport-height + (and (window-live-p window) + (window-body-height window)))) :display-signature (value :display-signature (with-current-buffer buffer @@ -193,6 +300,27 @@ construction time and can use the static projection path." :scroll-offsets (ebox-surface--scroll-offsets scroll-table))))) +(defun ebox-surface--window-content-width (window) + "Return a safe pixel content width for live WINDOW. +Some Emacs GUI builds return a column-like half-width even when +`window-body-width' is called with PIXELWISE non-nil. When the result is +clearly inconsistent with the outer pixel width, prefer the outer width and +keep a one-pixel exclusive boundary. Headless/test windows retain the body +width fallback." + (let ((body + (condition-case nil + (window-body-width window t) + (wrong-number-of-arguments nil))) + (outer + (condition-case nil + (window-pixel-width window) + (error nil)))) + (max 0 + (1- + (if (and body outer (> outer (* 1.8 body))) + outer + (or body outer 0)))))) + (defun ebox-surface--ensure-signals (buffer values) "Return BUFFER's context signals for VALUES and whether they were created." (let ((signals @@ -303,6 +431,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." (:tp-scope-range-count . ,(plist-get tp-report :scope-range-count)) (:tp-scope-fallback . ,(plist-get tp-report :scope-fallback)) + (:tp-retained-content . ,(plist-get tp-report :retained-content-p)) (:tp-operation-count . ,patch-count) (:tp-transaction-id . ,(plist-get tp-report :transaction-id)) (:tp-text-operations . ,text-operations) @@ -335,11 +464,78 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." (and (> patch-count 0) '(tp-surface))))) report)) +(defun ebox-surface--participant-report (participant report state) + "Attach PARTICIPANT's read-only STATE and diagnostics to REPORT." + (when participant + (setq report (plist-put report :framework-participant-state state)) + (setq report + (plist-put report :framework-participant-diagnostics + (copy-tree + (ebox-surface--framework-participant-diagnostics + participant)))) + (setq report + (plist-put report :scroll-finalization-diagnostics + (copy-tree + (ebox-surface--framework-participant-scroll-diagnostics + participant)))) + (setf (ebox-surface--framework-participant-report participant) report)) + report) + +(defun ebox-surface--participant-run-publish (participant report) + "Publish PARTICIPANT with REPORT exactly once and return updated REPORT." + (unless (eq (ebox-surface--framework-participant-state participant) + 'unpublished) + (error "Ebox framework participant is not unpublished")) + (setf (ebox-surface--framework-participant-state participant) 'published) + (setq report (ebox-surface--participant-report participant report 'published)) + (when-let ((publish (ebox-surface--framework-participant-publish participant))) + (funcall publish report)) + report) + +(defun ebox-surface--participant-run-rollback (participant) + "Run PARTICIPANT's paired rollback once without allowing failure to escape." + (when (and participant + (eq (ebox-surface--framework-participant-state participant) + 'published)) + (setf (ebox-surface--framework-participant-state participant) 'rolled-back) + (ebox-surface--participant-report + participant (ebox-surface--framework-participant-report participant) + 'rolled-back) + (when-let ((rollback + (ebox-surface--framework-participant-rollback participant))) + (let ((inhibit-quit t) + (quit-flag nil)) + (condition-case failure + (funcall rollback + (ebox-surface--framework-participant-report participant)) + ((error quit) + (push (list :phase 'framework-rollback :condition failure) + (ebox-surface--framework-participant-diagnostics + participant)))))) + (ebox-surface--participant-report + participant (ebox-surface--framework-participant-report participant) + 'rolled-back))) + +(defun ebox-surface--participant-complete (participant diagnostics) + "Complete PARTICIPANT after scroll DIAGNOSTICS are contained." + (when participant + (setf (ebox-surface--framework-participant-scroll-diagnostics participant) + diagnostics) + (let* ((state + (ebox-surface--framework-participant-runtime-state participant)) + (report (ebox-surface--framework-participant-report participant))) + (plist-put state :last-update-report + (ebox-surface--participant-report + participant report 'completed))) + (setf (ebox-surface--framework-participant-state participant) 'completed))) + (defun ebox-surface--publish-runtime-state - (buffer surface old-state report-base after-publication) + (buffer surface old-state report-base after-publication + &optional framework-participant) "Register BUFFER runtime publication for SURFACE after OLD-STATE. REPORT-BASE requests an Ebox commit report. AFTER-PUBLICATION, when non-nil, -runs after TP and Ebox point at the same candidate generation." +runs after TP and Ebox point at the same candidate generation. +FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil." (let (new-state region-snapshot scroll-snapshot old-surface old-mirror region-keys scroll-keys) (tp-transaction-participate @@ -363,10 +559,25 @@ runs after TP and Ebox point at the same candidate generation." scroll-snapshot (ebox-incremental--hash-snapshot ebox--scroll-global-state scroll-keys)) + (when framework-participant + (setf (ebox-surface--framework-participant-runtime-state + framework-participant) + new-state + (ebox-surface--framework-participant-scroll-keys + framework-participant) + scroll-keys)) (when new-state (plist-put new-state :surface surface) (plist-put new-state :runtime-revision (1- (tp-surface-revision surface))) + (when (plist-get report-base :scroll-state-transaction) + ;; Scroll changes invalidate every buffer-span coordinate. Keep + ;; the committed generation structurally snapshot-free so a later + ;; hidden-owner update recaptures spans from the current buffer, + ;; never from the pre-scroll marker positions. + (plist-put new-state :layout-snapshots + (make-hash-table :test 'equal)) + (plist-put new-state :layout-snapshots-complete-p nil)) (ebox-surface--bind-scroll-states-to-buffer new-state buffer) (when report-base (plist-put new-state :last-update-report @@ -383,39 +594,48 @@ runs after TP and Ebox point at the same candidate generation." (ebox-incremental--replace-hash-entries ebox--scroll-global-state scroll-keys (plist-get new-state :scroll-state-table)) - (when after-publication - (funcall after-publication - (plist-get new-state :last-update-report))) + (if framework-participant + (plist-put + new-state :last-update-report + (ebox-surface--participant-run-publish + framework-participant + (plist-get new-state :last-update-report))) + (when after-publication + (funcall after-publication + (plist-get new-state :last-update-report)))) (unless (buffer-live-p buffer) (error "Ebox declarative target died during publication"))) (lambda () - (if (buffer-live-p buffer) - (progn - (when region-snapshot - (ebox-incremental--restore-hash-snapshot - ebox--region-box-table region-snapshot)) - (when scroll-snapshot - (ebox-incremental--restore-hash-snapshot - ebox--scroll-global-state scroll-snapshot)) - (with-current-buffer buffer - (setq-local ebox-surface--buffer-surface old-surface)) - (if old-mirror - (puthash buffer old-mirror ebox--buffer-render-state-table) - (remhash buffer ebox--buffer-render-state-table))) - (remhash buffer ebox--buffer-render-state-table) - (dolist (region-id region-keys) - (remhash region-id ebox--region-box-table)) - (dolist (region-id scroll-keys) - (ebox--scroll-clear-state region-id) - (ebox--smooth-scroll-stop region-id))))))) + (unwind-protect + (ebox-surface--participant-run-rollback framework-participant) + (if (buffer-live-p buffer) + (progn + (when region-snapshot + (ebox-incremental--restore-hash-snapshot + ebox--region-box-table region-snapshot)) + (when scroll-snapshot + (ebox-incremental--restore-hash-snapshot + ebox--scroll-global-state scroll-snapshot)) + (with-current-buffer buffer + (setq-local ebox-surface--buffer-surface old-surface)) + (if old-mirror + (puthash buffer old-mirror ebox--buffer-render-state-table) + (remhash buffer ebox--buffer-render-state-table))) + (remhash buffer ebox--buffer-render-state-table) + (dolist (region-id region-keys) + (remhash region-id ebox--region-box-table)) + (dolist (region-id scroll-keys) + (ebox--scroll-clear-state region-id) + (ebox--smooth-scroll-stop region-id)))))))) (defun ebox-surface-mount-buffer (buffer source &optional report-base after-publication - preserve-identities-p state-overrides) + preserve-identities-p state-overrides framework-participant) "Mount or atomically update BUFFER from Ebox SOURCE and return its surface. REPORT-BASE requests a committed Ebox report. AFTER-PUBLICATION runs inside the rollback-capable transaction. PRESERVE-IDENTITIES-P retains identities -already present in a logical candidate. STATE-OVERRIDES augments its runtime." +already present in a logical candidate. STATE-OVERRIDES augments its runtime. +FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil." (let* ((surface (ebox-surface--live-buffer-surface buffer)) (old-state (and surface (tp-surface-client-state surface))) (context-values @@ -445,17 +665,23 @@ already present in a logical candidate. STATE-OVERRIDES augments its runtime." '(:capability content :inhibit-read-only t :coordinate-mounts t)))) (ebox-surface--publish-runtime-state - buffer surface old-state report-base after-publication)) + buffer surface old-state report-base after-publication + framework-participant)) (setq success t) - (let* ((new-state (tp-surface-client-state surface)) - (scroll-keys - (delete-dups - (append - (copy-sequence (plist-get old-state :scroll-region-ids)) - (copy-sequence - (plist-get new-state :scroll-region-ids)))))) - (ebox-incremental--finalize-declarative-scroll-publication - scroll-keys)) + (let ((scroll-keys + (if framework-participant + (ebox-surface--framework-participant-scroll-keys + framework-participant) + (let ((new-state (tp-surface-client-state surface))) + (delete-dups + (append + (copy-sequence (plist-get old-state :scroll-region-ids)) + (copy-sequence + (plist-get new-state :scroll-region-ids)))))))) + (ebox-surface--participant-complete + framework-participant + (ebox-incremental--finalize-declarative-scroll-publication + scroll-keys))) surface) (when (and signals-created-p (not success)) (ebox-surface--dispose-signals signals))))) @@ -584,25 +810,68 @@ PREVIOUS-STATE's node-object table." ebox-surface--nodes-key 'ebox/nodes)) (objects-by-node (if (memq projection-kind - '(span-patch viewport-reflow viewport-reflow-mixed-scroll)) + '(span-patch owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow + viewport-reflow viewport-reflow-mixed-scroll)) (or (plist-get previous-state :surface-node-object-table) (error "Ebox span projection has no retained node table")) - (make-hash-table :test 'eq))) + (make-hash-table :test 'eq))) + (style-state-table + (ebox-surface--style-state-table previous-state)) + (stylesheet-signature + (and style-required-p + (if (memq projection-kind + '(owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow)) + nil + (ebox-surface--stylesheet-signature)))) (bindings-by-subject (make-hash-table :test 'eq)) - (subjects (when style-required-p - (ebox-tree-subject-index root)))) + (states-by-subject (make-hash-table :test 'eq)) + (subjects (when (and style-required-p + (not (memq projection-kind + '(owner-scoped scroll-patch + formatting-context-reflow + mixed-owner-reflow)))) + (ebox-tree-subject-index root))) + (selector-tree-snapshot + (if (memq projection-kind + '(owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow)) + (plist-get previous-state :selector-tree-snapshot) + (and subjects + (ebox-surface--subject-signature + (plist-get subjects :root-subject))))) + (selector-tree-token + (if (memq projection-kind + '(owner-scoped scroll-patch)) + (plist-get previous-state :selector-tree-token) + (and selector-tree-snapshot + (if (and (equal selector-tree-snapshot + (plist-get previous-state + :selector-tree-snapshot)) + (plist-get previous-state :selector-tree-token)) + (plist-get previous-state :selector-tree-token) + (cons 'ebox/selector-tree nil)))))) (if (memq projection-kind - '(span-patch viewport-reflow viewport-reflow-mixed-scroll)) + '(span-patch owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow + viewport-reflow viewport-reflow-mixed-scroll)) (tp-object-reuse-subtree context node-root) (progn (tp-object-retain context node-root) (ebox-surface--ensure-node-tree context node-root root objects-by-node (and subjects (plist-get subjects :node-subject-table)) - bindings-by-subject))) + bindings-by-subject states-by-subject style-state-table + stylesheet-signature + selector-tree-token))) (list :surface-root surface-root :node-root node-root - :objects-by-node objects-by-node))) + :objects-by-node objects-by-node + :style-binding-states style-state-table + :stylesheet-signature stylesheet-signature + :selector-tree-snapshot selector-tree-snapshot + :selector-tree-token selector-tree-token))) (defun ebox-surface--complete-projection (context root style-required-p projection) @@ -612,35 +881,71 @@ CONTEXT, so full fallback must populate those same objects instead of creating the projection roots a second time." (let* ((node-root (plist-get projection :node-root)) (objects-by-node (plist-get projection :objects-by-node)) + (style-state-table + (plist-get projection :style-binding-states)) + (stylesheet-signature + (or (plist-get projection :stylesheet-signature) + (and style-required-p + (ebox-surface--stylesheet-signature)))) + (selector-tree-token + (plist-get projection :selector-tree-token)) (bindings-by-subject (make-hash-table :test 'eq)) + (states-by-subject (make-hash-table :test 'eq)) (subjects (when style-required-p (ebox-tree-subject-index root)))) (tp-object-retain context node-root) (ebox-surface--ensure-node-tree context node-root root objects-by-node (and subjects (plist-get subjects :node-subject-table)) - bindings-by-subject) + bindings-by-subject states-by-subject style-state-table + stylesheet-signature + selector-tree-token) projection)) (defun ebox-surface--projection-result - (context projection state output) + (context projection state output &optional projection-kind) "Complete CONTEXT PROJECTION for STATE from rendered OUTPUT." (let* ((surface-root (plist-get projection :surface-root)) (objects-by-node (plist-get projection :objects-by-node)) - (node-objects (ebox-surface--node-object-table objects-by-node)) + (root-node (plist-get state :root-node)) + (root-id (and root-node (plist-get root-node :node-id))) + (owner-id (plist-get state :span-patch-owner-id)) + (scroll-fast-p (and (eq projection-kind 'scroll-patch) + (plist-get state :scroll-fast-window-p))) + (full-surface-p + (and scroll-fast-p + (plist-get state :retained-scroll-content-p) + root-id owner-id (= root-id owner-id))) + (node-objects + (or (and scroll-fast-p + (plist-get state :surface-node-object-table)) + (ebox-surface--node-object-table objects-by-node))) (region-objects - (ebox-surface--region-object-table state node-objects))) + (or (and scroll-fast-p + (plist-get state :region-surface-object-table)) + (ebox-surface--region-object-table state node-objects)))) (plist-put state :surface-node-object-table node-objects) (plist-put state :region-surface-object-table region-objects) - (plist-put state :surface-object-region-table - (ebox-surface--object-region-table region-objects)) - (plist-put state :logical-id-region-table - (ebox-surface--logical-id-region-table state region-objects)) + (unless (and scroll-fast-p + (plist-get state :surface-object-region-table)) + (plist-put state :surface-object-region-table + (ebox-surface--object-region-table region-objects))) + (unless (and scroll-fast-p + (plist-get state :logical-id-region-table)) + (plist-put state :logical-id-region-table + (ebox-surface--logical-id-region-table state region-objects))) (let* ((prepared (ebox-surface--surface-plan - context surface-root output state node-objects region-objects)) - (plan (car prepared))) - (tp-surface-result-create-owned context plan state)))) + context surface-root output state node-objects region-objects + scroll-fast-p)) + (plan (car prepared)) + (rendered (cadr prepared)) + (owned-ranges (nth 2 prepared))) + (if full-surface-p + (tp-surface-retained-content-result-create + context plan rendered owned-ranges state + t) + (tp-surface-result-create-owned context plan state))))) (defun ebox-surface--mounted-object-for-node (state node-id) "Return NODE-ID's nearest live retained object with mounts in STATE." @@ -667,7 +972,7 @@ the projection roots a second time." (defun ebox-surface-update-buffer-scoped (buffer source scope-node-ids report-base state-overrides &optional after-publication on-mismatch scroll-prefetch-delay - projection-kind source-isolated-p) + projection-kind source-isolated-p framework-participant) "Publish BUFFER SOURCE within SCOPE-NODE-IDS through TP. STATE-OVERRIDES augments the isolated candidate runtime. REPORT-BASE and AFTER-PUBLICATION have the same meaning as in `ebox-surface-mount-buffer'. @@ -677,16 +982,24 @@ PROJECTION-KIND may request a proven non-spatial candidate projection. SOURCE-ISOLATED-P means SOURCE is an internally copied runtime candidate and may be adopted without another structural copy or identity reconciliation. When SOURCE-PATH-COPIED-P is non-nil, SOURCE shares untouched published nodes; -the surface must preserve those shared nodes while consuming the candidate." +the surface must preserve those shared nodes while consuming the candidate. +FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil." (let* ((surface (ebox-surface--live-buffer-surface buffer)) (old-state (and surface (tp-surface-client-state surface)))) (unless surface (error "Ebox scoped update requires a mounted TP surface")) (let ((objects - (ebox-surface--objects-for-node-ids old-state scope-node-ids))) - (unless objects - (error "Ebox scoped update requires at least one retained owner")) - (let* ((context-values + (condition-case nil + (ebox-surface--objects-for-node-ids old-state scope-node-ids) + (error nil)))) + (if (null objects) + (ebox-surface-mount-buffer + buffer source + (append report-base + '(:tp-scope-fallback t :empty-range-owner-fallback t)) + after-publication t state-overrides + framework-participant) + (let* ((context-values (ebox-surface--context-values buffer old-state state-overrides)) (signals-result (ebox-surface--ensure-signals buffer context-values)) @@ -698,6 +1011,11 @@ the surface must preserve those shared nodes while consuming the candidate." source-isolated-p (plist-get state-overrides :source-path-copied-p))) success) + (when (and (null on-mismatch) + (or (plist-get state-overrides :owner-scoped-proofs) + (plist-get state-overrides :scroll-state-transaction) + (> (length scope-node-ids) 1))) + (setq on-mismatch 'root)) (unwind-protect (progn (tp-with-transaction @@ -706,21 +1024,27 @@ the surface must preserve those shared nodes while consuming the candidate." surface objects producer (list :on-mismatch on-mismatch :return-report nil)) (ebox-surface--publish-runtime-state - buffer surface old-state report-base after-publication)) + buffer surface old-state report-base after-publication + framework-participant)) (setq success t) - (let* ((new-state (tp-surface-client-state surface)) - (scroll-keys - (delete-dups - (append - (copy-sequence - (plist-get old-state :scroll-region-ids)) - (copy-sequence - (plist-get new-state :scroll-region-ids)))))) - (ebox-incremental--finalize-declarative-scroll-publication - scroll-keys scroll-prefetch-delay)) + (let ((scroll-keys + (if framework-participant + (ebox-surface--framework-participant-scroll-keys + framework-participant) + (let ((new-state (tp-surface-client-state surface))) + (delete-dups + (append + (copy-sequence + (plist-get old-state :scroll-region-ids)) + (copy-sequence + (plist-get new-state :scroll-region-ids)))))))) + (ebox-surface--participant-complete + framework-participant + (ebox-incremental--finalize-declarative-scroll-publication + scroll-keys scroll-prefetch-delay))) surface) (when (and signals-created-p (not success)) - (ebox-surface--dispose-signals signals))))))) + (ebox-surface--dispose-signals signals)))))))) (defun ebox-surface--clear-runtime-attachments (root) "Clear TP handles and render-cache attachments below ROOT." @@ -799,33 +1123,227 @@ published generation so a failed transaction has no cache state to restore." (list 'ebox/node (plist-get node :ebox-type))) (defun ebox-surface--node-style-binding - (object node subject bindings-by-subject) + (object node subject bindings-by-subject states-by-subject style-state-table + stylesheet-signature selector-tree-token) "Install and return NODE style binding on OBJECT for SUBJECT." (let* ((parent (ecss-subject-parent subject)) (parent-binding (and parent (gethash parent bindings-by-subject))) + (parent-style-state (and parent (gethash parent states-by-subject))) (declarations (ebox-style-node-declarations node)) + (old-state (gethash object style-state-table)) + (old-binding (and old-state (plist-get old-state :binding))) + (old-parent-style + (and old-state + (plist-get old-state :parent-binding) + (tp-binding-last-value + (plist-get old-state :parent-binding)))) + (new-parent-style + (and parent-binding (tp-binding-last-value parent-binding))) + (theme-explicit-delta-style + (and old-state old-binding + (eq selector-tree-token + (plist-get old-state :selector-tree-token)) + (equal stylesheet-signature + (plist-get old-state :stylesheet-signature)) + (ebox-style--theme-delta-computed + (tp-binding-last-value old-binding) + (plist-get old-state :declarations) + declarations + old-parent-style + new-parent-style))) + (theme-parent-delta-style + (and old-state old-binding + (equal (plist-get old-state :declarations) + declarations) + (eq selector-tree-token + (plist-get old-state :selector-tree-token)) + (equal stylesheet-signature + (plist-get old-state :stylesheet-signature)) + (ebox-style--theme-parent-delta-computed + (tp-binding-last-value old-binding) + declarations old-parent-style new-parent-style))) + (theme-delta-style + (or theme-explicit-delta-style theme-parent-delta-style)) + (theme-parent-delta-p + (and (null theme-explicit-delta-style) + theme-parent-delta-style)) + (reused-p + (and old-state + (null theme-delta-style) + (eq selector-tree-token + (plist-get old-state :selector-tree-token)) + (equal declarations (plist-get old-state :declarations)) + (eq parent-binding (plist-get old-state :parent-binding)) + (eq parent-style-state + (plist-get old-state :parent-style-state)) + (= (if parent-binding 1 0) + (or (plist-get old-state + :inherited-dependency-count) + -1)) + (equal stylesheet-signature + (plist-get old-state :stylesheet-signature)))) + (state + (if reused-p + old-state + (let ((new-state + (list :selector-tree-token selector-tree-token + :declarations (copy-tree declarations) + :parent-binding parent-binding + :parent-style-state parent-style-state + :inherited-dependency-count + (if theme-parent-delta-p + 1 + (if theme-explicit-delta-style + 0 + (if parent-binding 1 0))) + :stylesheet-signature stylesheet-signature + :subject subject))) + (plist-put + new-state :compute + (let ((captured new-state) + (delta-style theme-delta-style) + (parent-delta-p theme-parent-delta-p) + (last-style (and old-binding + (tp-binding-last-value old-binding))) + (last-parent-style old-parent-style)) + (if parent-delta-p + (lambda () + (let ((parent-style + (and (plist-get captured :parent-binding) + (tp-binding-read + (plist-get captured :parent-binding))))) + (setq last-style + (or + (ebox-style--theme-parent-delta-computed + last-style + (plist-get captured :declarations) + last-parent-style parent-style) + (ebox-style-compute-subject + (plist-get captured :subject) + (plist-get captured :declarations) + parent-style))) + (setq last-parent-style parent-style) + last-style)) + (lambda () + (or delta-style + (ebox-style-compute-subject + (plist-get captured :subject) + (plist-get captured :declarations) + (and (plist-get captured :parent-binding) + (tp-binding-read + (plist-get captured :parent-binding))))))))) + new-state))) (binding (tp-bind object 'ebox/computed-style - (lambda () - (ebox-style-compute-subject - subject declarations - (and parent-binding (tp-binding-read parent-binding))))))) + (plist-get state :compute)))) + (unless reused-p + (plist-put state :binding binding) + (puthash object state style-state-table)) (puthash subject binding bindings-by-subject) + (puthash subject state states-by-subject) binding)) (defun ebox-surface--apply-node-style - (object node subject-table bindings-by-subject) + (object node subject-table bindings-by-subject states-by-subject + style-state-table + stylesheet-signature selector-tree-token) "Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE." (when-let ((subject (gethash node subject-table))) (ebox-style-apply-computed node (tp-binding-read - (ebox-surface--node-style-binding - object node subject bindings-by-subject))))) + (ebox-surface--node-style-binding + object node subject bindings-by-subject states-by-subject + style-state-table + stylesheet-signature selector-tree-token))))) + +(defun ebox-surface--static-style-state-p (state &optional seen) + "Return non-nil when STATE's inherited binding closure is static. +The style compute may depend on its parent binding exactly once. Any other +dependency is a dynamic TP source and prevents a local cascade proof." + (let* ((binding (and state (plist-get state :binding))) + (parent-binding (and state (plist-get state :parent-binding))) + (parent-state (and state (plist-get state :parent-style-state))) + (inherited-count + (and state (plist-get state :inherited-dependency-count)))) + (and (tp-binding-live-p binding) + (not (memq state seen)) + (integerp inherited-count) + (= (tp-binding-dependency-count binding) + inherited-count) + (if parent-binding + (and parent-state + (eq parent-binding (plist-get parent-state :binding)) + (ebox-surface--static-style-state-p + parent-state (cons state seen))) + (null parent-state))))) + +(defun ebox-surface--cascade-local-owner-proof-p + (state candidate-state dirty-set) + "Return non-nil when DIRTY-SET has a static cascade closure in STATE. +CANDIDATE-STATE supplies the declarative nodes before cascade projection. +Missing binding state, changed declarations or selector metadata, dynamic TP +dependencies, or any malformed index conservatively preserves root planning." + (let ((objects (plist-get state :surface-node-object-table)) + (style-states (plist-get state :style-binding-states)) + (candidate-nodes (plist-get candidate-state :node-table)) + (stylesheet-signature + (let* ((cache ebox-incremental--allocated-slot-proof-cache) + (missing (make-symbol "ebox-stylesheet-proof-missing")) + (cached (and cache + (gethash 'stylesheet-signature cache missing)))) + (if (and cached (not (eq cached missing))) + cached + (let ((signature (ebox-surface--stylesheet-signature))) + (when cache + (puthash 'stylesheet-signature signature cache)) + signature))))) + (and (hash-table-p objects) + (hash-table-p style-states) + (hash-table-p candidate-nodes) + dirty-set + (cl-every + (lambda (entry) + (if (eq (plist-get entry :dirty-kind) 'paint) + t + (let* ((node-id (plist-get entry :node-id)) + (object (and node-id (gethash node-id objects))) + (style-state (and object (gethash object style-states))) + (candidate-node (and node-id + (gethash node-id candidate-nodes))) + (subject (and style-state + (plist-get style-state :subject)))) + (and style-state candidate-node subject + (or (equal (ebox-style-node-declarations candidate-node) + (plist-get style-state :declarations)) + (ebox-style--paint-declarations-equivalent-p + (plist-get style-state :declarations) + (ebox-style-node-declarations candidate-node))) + (equal (ebox-tree-node-id candidate-node) + (ecss-subject-id subject)) + (equal (ebox-tree-node-classes candidate-node) + (ecss-subject-classes subject)) + (equal (ebox-tree-metadata-string + (ebox-tree-node-selector-type candidate-node)) + (ecss-subject-type subject)) + (equal (mapcar + (lambda (attribute) + (cons (substring (symbol-name (car attribute)) 1) + (cdr attribute))) + (ebox-tree-node-attributes candidate-node)) + (ecss-subject-attributes subject)) + (equal (ebox-tree-node-state candidate-node) + (ecss-subject-states subject)) + (equal stylesheet-signature + (plist-get style-state :stylesheet-signature)) + (ebox-surface--static-style-state-p style-state))))) + dirty-set)))) (defun ebox-surface--ensure-node-tree - (context parent node table subject-table bindings-by-subject) + (context parent node table subject-table bindings-by-subject + states-by-subject style-state-table stylesheet-signature + selector-tree-token) "Ensure styled NODE descendants below PARENT in CONTEXT and fill TABLE." (let ((object (tp-object-ensure context parent @@ -836,10 +1354,14 @@ published generation so a failed transaction has no cache state to restore." (puthash node object table) (when subject-table (ebox-surface--apply-node-style - object node subject-table bindings-by-subject)) + object node subject-table bindings-by-subject states-by-subject + style-state-table + stylesheet-signature selector-tree-token)) (dolist (child (ebox-tree--children-raw node)) (ebox-surface--ensure-node-tree - context object child table subject-table bindings-by-subject)) + context object child table subject-table bindings-by-subject + states-by-subject style-state-table stylesheet-signature + selector-tree-token)) (when subject-table (ebox-style-sync-flex-item node)) object)) @@ -1014,6 +1536,7 @@ valid because their declarative layout and viewport did not change." (plist-get state :viewport-height-dependent-subtree-cache)) (ebox--flex-content-min-width-table (plist-get state :flex-content-min-widths)) + (ebox--paint-origin-capture-p t) (ebox--render-owned-text-values (make-hash-table :test #'eq))) (cl-letf (((symbol-function 'ebox--scroll-schedule-idle-prefetch) @@ -1043,6 +1566,26 @@ valid because their declarative layout and viewport did not change." objects)) state)) +(defun ebox-surface--apply-retained-owner-styles (state) + "Apply retained static computed styles to owner-scoped nodes in STATE." + (let* ((proofs (plist-get state :owner-scoped-proofs)) + (owner-ids + (or (mapcar (lambda (proof) (plist-get proof :owner-id)) proofs) + (and (plist-get state :span-patch-owner-id) + (list (plist-get state :span-patch-owner-id))))) + (nodes (plist-get state :node-table)) + (objects (plist-get state :surface-node-object-table)) + (style-states (plist-get state :style-binding-states))) + (dolist (owner-id owner-ids) + (when-let* ((node (and nodes (gethash owner-id nodes))) + (object (and objects (gethash owner-id objects))) + (style-state (and style-states + (gethash object style-states))) + (binding (plist-get style-state :binding))) + (ebox-style-apply-computed node (tp-binding-read binding)) + (ebox-style-sync-flex-item node))) + state)) + (defun ebox-surface--rendered-role-topology-signature (rendered region-ids) "Return rendered Ebox role topology for REGION-IDS in RENDERED." @@ -1067,11 +1610,25 @@ valid because their declarative layout and viewport did not change." (string< (symbol-name left) (symbol-name right)))))))) -(defun ebox-surface--span-patch-lines (buffer spans rendered) - "Return RENDERED shaped for BUFFER SPANS, or nil when unsafe." +(defun ebox-surface--span-patch-lines (buffer spans rendered + &optional variable-content-p + variable-content-max-width) + "Return RENDERED shaped for BUFFER SPANS, or nil when unsafe. +When VARIABLE-CONTENT-P is non-nil, allow a stable partial slot to retain its +old allocated width while the owner changes its natural content length." (with-current-buffer buffer (if (ebox-buffer--partial-line-slots-p spans) - (ebox-buffer--rendered-in-existing-slots spans rendered nil t) + (if variable-content-p + (let ((lines (ebox-string-lines rendered))) + (when (and (= (length spans) (length lines)) + (or (null variable-content-max-width) + (cl-every + (lambda (line) + (<= (ebox--string-pixel-width line) + variable-content-max-width)) + lines))) + rendered)) + (ebox-buffer--rendered-in-existing-slots spans rendered nil t)) (and (= (length spans) (length (ebox-string-lines rendered))) rendered)))) @@ -1107,7 +1664,8 @@ valid because their declarative layout and viewport did not change." (apply #'concat (nreverse pieces))))) (defun ebox-surface--span-patch-details - (_buffer snapshot node spans rendered) + (_buffer snapshot node spans rendered + &optional variable-content-p variable-content-max-width) "Return validated replacement details for SNAPSHOT and RENDERED." (let* ((lines (ebox-string-lines rendered)) (new-spans (ebox-surface--projected-span-positions spans lines)) @@ -1129,30 +1687,48 @@ valid because their declarative layout and viewport did not change." rendered (plist-get snapshot :region-ids)))) (new-overflow (ebox--overflow-signature node))) (when (and old-footprint new-footprint - (ebox--span-footprint-compatible-p - old-footprint new-footprint) - (ebox--external-footprint-compatible-p - (plist-get snapshot :external-footprint-signature) - new-external) - (ebox--parent-slot-compatible-p - (plist-get snapshot :parent-slot-signature) new-parent) + (if variable-content-p + (and (= (plist-get old-footprint :span-count) + (plist-get new-footprint :span-count)) + (or (null variable-content-max-width) + (<= (or (plist-get new-external + :max-line-pixel-width) + 0) + variable-content-max-width))) + (and (ebox--span-footprint-compatible-p + old-footprint new-footprint) + (ebox--external-footprint-compatible-p + (plist-get snapshot :external-footprint-signature) + new-external) + (ebox--parent-slot-compatible-p + (plist-get snapshot :parent-slot-signature) + new-parent))) (equal (plist-get snapshot :role-topology-signature) new-roles) (equal (plist-get snapshot :overflow-signature) new-overflow)) (list :lines lines :spans new-spans :footprint new-footprint :external new-external :parent new-parent :roles new-roles - :overflow new-overflow)))) + :overflow new-overflow + :variable-content-p variable-content-p)))) (defun ebox-surface--install-span-patch-snapshot - (state owner-id snapshot details) + (state owner-id snapshot details &optional generation-override) "Install DETAILS for OWNER-ID into candidate STATE snapshots." - (let* ((generation (1+ (or (plist-get state - :layout-snapshot-detail-generation) - 0))) + (let* ((current-generation + (or (plist-get state :layout-snapshot-detail-generation) 0)) + (old-footprint (plist-get snapshot :span-footprint-signature)) + (new-footprint (plist-get details :footprint)) + (coordinates-stable-p + (equal (plist-get old-footprint :char-lengths) + (plist-get new-footprint :char-lengths))) + (generation (or generation-override + (if coordinates-stable-p + current-generation + (1+ current-generation)))) (updated (copy-sequence snapshot)) (spans (plist-get details :spans)) - (footprint (plist-get details :footprint))) + (footprint new-footprint)) (dolist (entry `((:buffer-span . ,(car spans)) (:buffer-spans . ,spans) (:line-signature . ,(plist-get footprint @@ -1160,7 +1736,10 @@ valid because their declarative layout and viewport did not change." (:span-footprint-signature . ,footprint) (:external-footprint-signature . ,(plist-get details :external)) - (:parent-slot-signature . ,(plist-get details :parent)) + (:parent-slot-signature + . ,(if (plist-get details :variable-content-p) + (plist-get snapshot :parent-slot-signature) + (plist-get details :parent))) (:role-topology-signature . ,(plist-get details :roles)) (:overflow-signature . ,(plist-get details :overflow)) (:detail-generation . ,generation))) @@ -1170,36 +1749,438 @@ valid because their declarative layout and viewport did not change." (plist-put state :layout-snapshots-complete-p nil) state)) -(defun ebox-surface--span-patch-output - (buffer state) - "Return a proven full output for OWNER-ID's local span patch, or nil." - (let* ((owner-id (plist-get state :span-patch-owner-id)) +(defun ebox-surface--owner-patch-candidate + (buffer state owner-id allocated-width + &optional variable-content-p variable-content-max-width) + "Return validated patch details for OWNER-ID, or nil." + (let* ( (old-snapshot (and owner-id (ebox--ensure-layout-snapshot-details buffer owner-id))) (spans (and old-snapshot (plist-get old-snapshot :buffer-spans))) - (node (and owner-id (gethash owner-id (plist-get state :node-table))))) + (node (and owner-id (gethash owner-id (plist-get state :node-table)))) + (render-node + (if allocated-width + (plist-put (copy-sequence node) :width allocated-width) + node))) (when (and old-snapshot spans node) + (let* ((rendered + (ebox-surface--render-candidate-node state render-node)) + (replacement + (ebox-surface--span-patch-lines + buffer spans rendered variable-content-p + variable-content-max-width)) + (details + (and replacement + (ebox-surface--span-patch-details + buffer old-snapshot node spans replacement + variable-content-p variable-content-max-width)))) + (and details + (list :owner-id owner-id :snapshot old-snapshot + :old-spans spans :details details)))))) + +(defun ebox-surface--span-patch-output (buffer state) + "Return a proven single- or multi-owner local patch output, or nil." + (let* ((proofs (plist-get state :owner-scoped-proofs)) + (candidates + (if proofs + (mapcar + (lambda (proof) + (ebox-surface--owner-patch-candidate + buffer state (plist-get proof :owner-id) + (plist-get proof :allocated-width) + (plist-get proof :variable-content-p) + (plist-get proof :variable-content-max-width))) + proofs) + (list + (ebox-surface--owner-patch-candidate + buffer state (plist-get state :span-patch-owner-id) + (plist-get state :owner-scoped-allocated-width) + nil))))) + (when (and candidates (cl-every #'identity candidates)) (with-current-buffer buffer (save-restriction (widen) - (let* ((origin (point-min)) - (source (buffer-substring (point-min) (point-max))) - (rendered (ebox-surface--render-candidate-node state node)) - (replacement - (ebox-surface--span-patch-lines buffer spans rendered)) - (details - (and replacement - (ebox-surface--span-patch-details - buffer old-snapshot node spans replacement))) - (lines (and details (plist-get details :lines))) - (output (and lines - (ebox-surface--replace-buffer-spans - source origin spans lines)))) - (when output - (ebox-surface--install-span-patch-snapshot - state owner-id old-snapshot details) + (let* ((source (buffer-substring (point-min) (point-max))) + (origin (point-min)) + (variable-p + (cl-some + (lambda (candidate) + (plist-get (plist-get candidate :details) + :variable-content-p)) + candidates)) + (coordinate-shift-p + (cl-some + (lambda (candidate) + (let* ((details (plist-get candidate :details)) + (old-footprint + (plist-get (plist-get candidate :snapshot) + :span-footprint-signature)) + (new-footprint (plist-get details :footprint))) + (not (equal (plist-get old-footprint :char-lengths) + (plist-get new-footprint :char-lengths))))) + candidates)) + (shared-generation + ;; A variable one-line slot may change glyph widths without + ;; changing buffer coordinates. Only a character-count + ;; delta shifts later spans and requires global lazy detail + ;; invalidation; otherwise retain the existing generation + ;; and let the owner snapshot update locally. + (and variable-p coordinate-shift-p + (1+ (or (plist-get state + :layout-snapshot-detail-generation) + 0)))) + (ordered + (sort (copy-sequence candidates) + (lambda (left right) + (< (car (car (plist-get left :old-spans))) + (car (car (plist-get right :old-spans))))))) + (delta 0) + (rebased nil) + pairs) + ;; Candidate details are first computed against the committed + ;; coordinates. Once one owner changes length, every later + ;; owner's new snapshot must be rebased by the accumulated delta; + ;; installing each proof independently would leave stale spans. + (dolist (candidate ordered) + (let* ((details (plist-get candidate :details)) + (old-spans (plist-get candidate :old-spans)) + (new-spans + (mapcar (lambda (span) + (cons (+ (car span) delta) + (+ (cdr span) delta))) + (plist-get details :spans))) + (updated (copy-sequence details)) + (line-delta + (cl-loop for old-span in old-spans + for line in (plist-get details :lines) + sum (- (length line) + (- (cdr old-span) (car old-span)))))) + (plist-put updated :spans new-spans) + (push (cons candidate updated) rebased) + (setq delta (+ delta line-delta)))) + (dolist (candidate candidates) + (cl-mapc + (lambda (span line) (push (cons span line) pairs)) + (plist-get candidate :old-spans) + (plist-get (plist-get candidate :details) :lines))) + (setq pairs + (sort pairs + (lambda (left right) + (< (car (car left)) (car (car right)))))) + (when-let ((output + (ebox-surface--replace-buffer-spans + source origin (mapcar #'car pairs) + (mapcar #'cdr pairs)))) + (dolist (candidate candidates) + (ebox-surface--install-span-patch-snapshot + state (plist-get candidate :owner-id) + (plist-get candidate :snapshot) + (cdr (assq candidate rebased)) + shared-generation)) output))))))) +(defun ebox-surface--formatting-context-reflow-lines + (start rendered) + "Return absolute whole-line spans for RENDERED beginning at START." + (let ((offset start) + spans) + (dolist (line (ebox-string-lines rendered) + (nreverse spans)) + (let ((end (+ offset (length line)))) + (push (cons offset end) spans) + (setq offset (1+ end)))))) + +(defun ebox-surface--formatting-context-reflow-output (buffer state) + "Return full BUFFER text with one variable-line context replaced, or nil. +The proof owns a complete block of whole lines. Only that block is rendered +again; the surrounding buffer and retained node/object identities remain +untouched." + (let* ((proof (or (plist-get state :formatting-context-reflow-proof) + (plist-get (plist-get state :mixed-owner-proof) + :geometry-proof))) + (owner-id (and proof (plist-get proof :owner-id))) + (snapshot (and proof (plist-get proof :snapshot))) + (old-spans (and proof (plist-get proof :old-spans))) + (node (and owner-id + (gethash owner-id (plist-get state :node-table)))) + (allocated-width (and proof + (plist-get proof :allocated-width)))) + (when (and proof snapshot old-spans node + (ebox--spans-contiguous-lines-p old-spans) + (with-current-buffer buffer + (ebox--line-spans-cover-whole-lines-p old-spans))) + (let* ((rendered (ebox-surface--render-candidate-node state node)) + (new-footprint + (ebox--rendered-span-footprint-signature rendered)) + (new-max (plist-get (ebox--external-footprint-signature-from-span-footprint + new-footprint) + :max-line-pixel-width)) + (new-roles + (ebox-surface--rendered-role-topology-signature + rendered (plist-get snapshot :region-ids))) + (old-roles (plist-get snapshot :role-topology-signature)) + (new-overflow (ebox--overflow-signature node)) + (old-block-span (plist-get proof :old-block-span)) + (block-start + (and old-block-span + (max 0 + (1- (car old-block-span))))) + ;; Mount positions are buffer positions (one-based, exclusive + ;; end); the output string is zero-based, so both boundaries + ;; need the same conversion before splicing. + (block-end + (and old-block-span + (1- (cdr old-block-span)))) + (old-block-text + (and (integerp block-start) + (integerp block-end) + (with-current-buffer buffer + (buffer-substring (1+ block-start) + (1+ block-end))))) + ;; The material context sits between two column line breaks. + ;; They belong to the context's retained scope even though the + ;; local node renderer quite correctly emits only its content. + (leading-newline-p + (and old-block-text + (> (length old-block-text) 0) + (= (aref old-block-text 0) ?\n))) + (trailing-newline-p + (and old-block-text + (> (length old-block-text) 0) + (= (aref old-block-text (1- (length old-block-text))) + ?\n))) + (context-rendered + (concat (if leading-newline-p "\n" "") + rendered + (if trailing-newline-p "\n" ""))) + (content-start (+ block-start (if leading-newline-p 1 0))) + (new-spans + (ebox-surface--formatting-context-reflow-lines + content-start rendered))) + (when (and (integerp block-start) + (integerp block-end) + (> block-end block-start) + (> (length context-rendered) 0) + new-spans + (or (null allocated-width) + (null new-max) + (<= new-max allocated-width)) + (equal old-roles new-roles) + (equal (plist-get snapshot :overflow-signature) + new-overflow)) + (with-current-buffer buffer + (save-restriction + (widen) + (let* ((source (buffer-substring (point-min) (point-max))) + (output + (concat (substring source 0 block-start) + context-rendered + (substring source block-end))) + (generation + (1+ (or (plist-get state + :layout-snapshot-detail-generation) + 0))) + (updated (copy-sequence snapshot)) + (new-external + (ebox--external-footprint-signature-from-span-footprint + new-footprint))) + (dolist (entry `((:buffer-span . ,(car new-spans)) + (:buffer-spans . ,new-spans) + (:line-signature + . ,(plist-get new-footprint + :line-pixel-widths)) + (:span-footprint-signature . ,new-footprint) + (:external-footprint-signature + . ,new-external) + (:role-topology-signature . ,new-roles) + (:overflow-signature . ,new-overflow) + (:detail-generation . ,generation))) + (setq updated + (plist-put updated (car entry) (cdr entry)))) + (puthash owner-id updated (plist-get state :layout-snapshots)) + (plist-put state :layout-snapshot-detail-generation generation) + (plist-put state :layout-snapshots-complete-p nil) + (plist-put state :formatting-context-reflow-new-spans new-spans) + (plist-put state :formatting-context-reflow-new-length + (length context-rendered)) + output)))))))) + +(defun ebox-surface--mixed-owner-output (buffer previous-state state) + "Return one geometry-plus-paint candidate output, or nil on proof miss. +The geometry context is rendered by the existing whole-line proof. Paint +owners are then recomposed from the committed semantic fragment ledger, never +by peeling an already-composed face suffix. Any missing address/baseline +causes the caller to use the ordinary full projection." + (let* ((proof (plist-get state :mixed-owner-proof)) + (geometry-proof (and proof (plist-get proof :geometry-proof))) + (geometry-kind (and proof (plist-get proof :geometry-kind))) + (paint-owner-ids (and proof (plist-get proof :paint-owner-ids))) + (output + (when geometry-proof + (if (eq geometry-kind 'span-patch) + (ebox-surface--span-patch-output buffer state) + (plist-put state :render-cache (make-hash-table :test 'equal)) + (plist-put state :render-signature-cache + (make-hash-table :test 'eq)) + (let ((ebox--box-content-render-cache + (make-hash-table :test 'eq))) + (ebox-surface--formatting-context-reflow-output + buffer state))))) + (old-fragments (plist-get previous-state :surface-fragments)) + (old-by-address (make-hash-table :test #'equal)) + (old-by-local-address (make-hash-table :test #'equal))) + (when (and output old-fragments paint-owner-ids) + (dolist (fragment old-fragments) + (when-let ((address (plist-get fragment :paint-address))) + (puthash address fragment old-by-address) + (let* ((roles (plist-get fragment :paint-role-ids)) + (owner (cdr (assq 'content roles))) + (key (and owner + (list owner + (plist-get address :content-index) + (plist-get address :ordinal))))) + (when key + (puthash key + (cons fragment (gethash key old-by-local-address)) + old-by-local-address))))) + (let ((new-fragments (ebox-surface--rendered-fragments output))) + (catch 'mixed-owner-proof-miss + (let ((old-face-cache (make-hash-table :test #'equal)) + (new-face-cache (make-hash-table :test #'equal)) + pieces) + (dolist (fragment new-fragments) + (let* ((start (plist-get fragment :start)) + (end (plist-get fragment :end)) + (text (substring output start end)) + (copy (copy-tree fragment)) + (address (plist-get fragment :paint-address)) + (roles (plist-get fragment :paint-role-ids)) + (owner (cdr (assq 'content roles))) + (local-key + (and owner + (list owner + (plist-get address :content-index) + (plist-get address :ordinal)))) + (matches (and local-key + (gethash local-key old-by-local-address))) + (old-fragment + (or (and address (gethash address old-by-address)) + (and (= (length matches) 1) (car matches)))) + (affected-p + (cl-some (lambda (entry) + (memq (cdr entry) paint-owner-ids)) + roles))) + (plist-put copy :text text) + (plist-put copy :start 0) + (plist-put copy :end (length text)) + (cl-remf copy :text-source-p) + (when affected-p + (unless (and address old-fragment + (or (plist-get old-fragment + :face-baseline-known-p) + (plist-get copy + :face-baseline-known-p))) + (throw 'mixed-owner-proof-miss nil)) + (when (plist-get old-fragment :face-baseline-known-p) + (plist-put copy :face-baseline + (copy-tree + (plist-get old-fragment :face-baseline))) + (plist-put copy :face-baseline-known-p t))) + (plist-put copy :old-paint-role-ids + (copy-tree (or (and old-fragment + (plist-get old-fragment + :paint-role-ids)) + roles))) + (push (ebox-surface--repaint-fragment + copy previous-state state + old-face-cache new-face-cache) + pieces))) + (let* ((fragments (nreverse pieces)) + (rendered + (apply #'concat + (mapcar (lambda (fragment) + (plist-get fragment :text)) + fragments))) + (offset 0)) + (dolist (fragment fragments) + (let ((length (length (plist-get fragment :text)))) + (plist-put fragment :start offset) + (plist-put fragment :end (+ offset length)) + (setq offset (+ offset length)))) + (plist-put state :mixed-owner-fragment-data fragments) + (plist-put state :mixed-owner-content-p t) + rendered))))))) + +(defun ebox-surface--scroll-patch-output (_buffer state) + "Return a staged visible scroll window without rerunning layout when safe. +Chrome-free top-aligned root scroll boxes already store fully propertized +rendered lines. Join only the visible slice and add the scroll marker; any +box with wrapper chrome falls back to the retained wrapper renderer." + (let* ((region-id (plist-get state :scroll-patch-region-id)) + (scroll-table (plist-get state :scroll-state-table)) + (scroll-state (and region-id scroll-table + (gethash region-id scroll-table))) + (root (plist-get state :root-node)) + (root-id (and root (plist-get root :node-id))) + (owner-id (plist-get state :span-patch-owner-id)) + (cached-box (and scroll-state (plist-get scroll-state :box)))) + (when (and scroll-state root owner-id root-id + (= owner-id root-id) + cached-box + (equal (plist-get cached-box :node-id) root-id)) + (let* ((chrome-free-p + (and (= (or (ebox-get cached-box :padding-left-pixel) 0) 0) + (= (or (ebox-get cached-box :padding-right-pixel) 0) 0) + (= (or (ebox-get cached-box :padding-top-height) 0) 0) + (= (or (ebox-get cached-box :padding-bottom-height) 0) 0) + (= (or (ebox-get cached-box :margin-left-pixel) 0) 0) + (= (or (ebox-get cached-box :margin-right-pixel) 0) 0) + (= (or (ebox-get cached-box :margin-top-height) 0) 0) + (= (or (ebox-get cached-box :margin-bottom-height) 0) 0) + (= (or (ebox-get cached-box :border-left-pixel) 0) 0) + (= (or (ebox-get cached-box :border-right-pixel) 0) 0) + (not (ebox-get cached-box :border-top-p)) + (not (ebox-get cached-box :border-bottom-p)) + (eq (ebox-get cached-box :vertical-align) 'top) + (null (ebox-get cached-box :surface-properties)))) + (visible + (and chrome-free-p + (ebox--scroll-state-retained-window-ready-p + scroll-state)))) + (if (and visible (cadr visible)) + (let* ((lines (cadr visible)) + (output (ebox-lines-join lines)) + (fragment-data + (ebox-surface--scroll-fragment-data lines output))) + (when (and fragment-data + (plist-get state :retained-scroll-content-p)) + (plist-put state :scroll-patch-fragment-data fragment-data)) + (when (> (length output) 0) + (add-text-properties + 0 (length output) + (list 'ebox-scroll-window region-id) + output)) + output) + (let ((ebox--scroll-window-cached-state scroll-state) + (ebox--scroll-window-skip-state-rebuild-p + (plist-get scroll-state :content-lines-complete-p))) + (ebox-surface--render-candidate-node state root))))))) + +(defun ebox-surface--native-scroll-full-output (state) + "Return the complete propertized root scroll output for native scrolling." + (let* ((region-id (plist-get state :scroll-patch-region-id)) + (table (plist-get state :scroll-state-table)) + (scroll-state (and region-id table (gethash region-id table))) + (lines (and scroll-state + (plist-get scroll-state :rendered-content-lines)))) + (when (and lines + (plist-get scroll-state :content-lines-complete-p)) + (let ((output (ebox-lines-join lines))) + (when (> (length output) 0) + (add-text-properties + 0 (length output) (list 'ebox-scroll-window region-id) output)) + output)))) + (defun ebox-surface--runtime-index-ready-p (state) "Return non-nil when STATE carries a complete prepared runtime index." (let* ((root (plist-get state :root-node)) @@ -1215,6 +2196,7 @@ valid because their declarative layout and viewport did not change." (hash-table-p (plist-get state :region-box-count-table)) (hash-table-p (plist-get state :region-box-table)) (hash-table-p (plist-get state :host-ref-table)) + (hash-table-p (plist-get state :range-ref-table)) (vectorp (plist-get state :native-node-postorder))))) (defun ebox-surface--finish-runtime-state (state) @@ -1251,6 +2233,29 @@ one output projection." (puthash properties roles cache)) roles)))) +(defun ebox-surface--paint-address-at + (rendered position role-cache ordinal-table) + "Return the semantic paint address at POSITION in RENDERED. +ROLE-CACHE is the per-render role extraction cache and ORDINAL-TABLE tracks +the first-to-last occurrence of an otherwise equal owner/content address. +The result deliberately contains semantic owner/role facts only; it never +uses a string, buffer, marker, or TP object identity as an address." + (let* ((properties (text-properties-at position rendered)) + (roles (ebox-surface--role-ids-at rendered position role-cache)) + (content-owner (plist-get properties 'ebox-content-owner)) + (content-index (plist-get properties 'ebox-content-idx)) + (prefix (and (or roles content-owner (integerp content-index)) + (list :roles (copy-tree roles) + :content-owner content-owner + :content-index content-index))) + (ordinal (and prefix (gethash prefix ordinal-table 0)))) + (when prefix + (puthash prefix (1+ ordinal) ordinal-table) + (list :roles (copy-tree roles) + :content-owner content-owner + :content-index content-index + :ordinal ordinal)))) + (defun ebox-surface--candidate-plan-text (rendered owned-values) "Return a private snapshot of RENDERED for an owned TP plan. OWNED-VALUES is the candidate-local provenance registry created by Ebox's @@ -1310,15 +2315,41 @@ when it needs to mutate them." (limit (length rendered)) (line 0) (role-cache (make-hash-table :test #'equal)) + (ordinal-table (make-hash-table :test #'equal)) fragments previous-role-ids next-role-ids) (while (< position limit) - (let ((next (or (next-property-change position rendered limit) limit))) - (let ((roles (ebox-surface--role-ids-at rendered position role-cache))) - (push (list :text rendered :text-source-p t - :start position :end next - :line line :paint-role-ids roles - :role-ids roles) - fragments)) + (let* ((next (or (next-property-change position rendered limit) + limit)) + (origin (get-text-property position + ebox--paint-origin-property + rendered)) + (roles (ebox-surface--role-ids-at rendered position role-cache)) + (address + (ebox-surface--paint-address-at + rendered position role-cache ordinal-table)) + (baseline + (and origin + (copy-tree + (ebox--paint-origin-baseline origin))))) + (push (list :text rendered :text-source-p t + :start position :end next + :line line :paint-role-ids roles + :role-ids roles + :paint-address address + :paint-token + (and address + (list :baseline (copy-tree baseline) + :roles (copy-tree roles) + :content-owner + (plist-get address :content-owner) + :content-index + (plist-get address :content-index))) + :face-baseline baseline + :face-baseline-known-p (and origin t)) + fragments) + (when origin + (remove-text-properties + position next (list ebox--paint-origin-property nil) rendered)) (cl-incf line (cl-count ?\n rendered :start position :end next)) (setq position (max next (1+ position))))) (setq fragments (nreverse fragments)) @@ -1365,7 +2396,8 @@ buffer only when it needs the old text." (setq offset (+ offset length)))))) (defun ebox-surface--owned-ranges - (context leaf fragments state node-objects region-objects) + (context leaf fragments state node-objects region-objects + &optional attach-p) "Attach merged owner ranges for FRAGMENTS to candidate LEAF. Adjacent ranges merge only when both their owner and opaque tags match." (let ((active (make-hash-table :test #'eq)) @@ -1402,20 +2434,60 @@ Adjacent ranges merge only when both their owner and opaque tags match." (push range ranges) (puthash tags range tag-ranges))))) (setq offset (if source-p end (+ offset (length (plist-get fragment :text))))))) - (tp-object-attach-content-ranges-owned context leaf (nreverse ranges)) + (when attach-p + (tp-object-attach-content-ranges-owned context leaf (nreverse ranges))) ranges)) +(defun ebox-surface--formatting-context-reflow-owned-ranges + (context leaf ranges state node-objects) + "Replace inferred owner ranges for the reflow context with one block range. +Ancestor-output role propagation can otherwise make a variable-line context +claim the first property run of the following sibling. The proof already +owns the complete old block, so its candidate scope is the exact new block; +all descendant ranges remain unchanged." + (let* ((proof (plist-get state :formatting-context-reflow-proof)) + (owner-id (plist-get proof :owner-id)) + (owner (and owner-id (gethash owner-id node-objects))) + (node (and owner-id (gethash owner-id (plist-get state :node-table)))) + (region-id (and node (plist-get node :region-id))) + (block-start + (max 0 + (1- (car (plist-get proof :old-block-span))))) + (block-end (+ block-start + (or (plist-get state + :formatting-context-reflow-new-length) + 0))) + (filtered + (cl-remove-if (lambda (range) + (eq (plist-get range :object) owner)) + ranges))) + (when (and owner region-id (integerp block-start) (> block-end block-start)) + (push (list :object owner :start block-start :end block-end + :tags (list :ebox/region-id region-id + :ebox/roles '(content-owner content))) + filtered)) + (setq filtered (nreverse filtered)) + (tp-object-attach-content-ranges-owned context leaf filtered) + filtered)) + (defun ebox-surface--surface-plan - (context surface-root output state node-objects region-objects) + (context surface-root output state node-objects region-objects + &optional transfer-text-p) "Return one shared-text TP plan for OUTPUT and STATE. NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges." (let* ((fragment-root (tp-object-ensure context surface-root ebox-surface--fragments-key 'ebox/fragments)) (fragment-data - (if (stringp output) - (ebox-surface--rendered-fragments output) - output)) + (or (and transfer-text-p + (plist-get state :retained-scroll-content-p) + (plist-get state :scroll-patch-fragment-data)) + (and (eq (plist-get state :projection-kind) + 'mixed-owner-reflow) + (plist-get state :mixed-owner-fragment-data)) + (if (stringp output) + (ebox-surface--rendered-fragments output) + output))) (rendered (if (stringp output) output @@ -1429,11 +2501,41 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges." (text-leaf (tp-object-ensure context fragment-root ebox-surface--text-key 'ebox/text))) - (ebox-surface--owned-ranges - context text-leaf fragment-data state node-objects region-objects) + (let* ((attach-p + (not (and transfer-text-p + (plist-get state :retained-scroll-content-p)))) + (owned-ranges + (ebox-surface--owned-ranges + context text-leaf fragment-data state node-objects region-objects + (and attach-p + (not (eq (plist-get state :projection-kind) + 'formatting-context-reflow)) + (not (and (eq (plist-get state :projection-kind) + 'mixed-owner-reflow) + (eq (plist-get + (plist-get state :mixed-owner-proof) + :geometry-kind) + 'formatting-context-reflow))))))) + (when (or (eq (plist-get state :projection-kind) + 'formatting-context-reflow) + (and (eq (plist-get state :projection-kind) + 'mixed-owner-reflow) + (eq (plist-get (plist-get state :mixed-owner-proof) + :geometry-kind) + 'formatting-context-reflow))) + (setq owned-ranges + (ebox-surface--formatting-context-reflow-owned-ranges + context text-leaf owned-ranges state node-objects))) (let* ((plan-text - (ebox-surface--candidate-plan-text - rendered (plist-get state :render-owned-text-values))) + (if (or transfer-text-p + (plist-get state :mixed-owner-content-p)) + ;; Scroll output is a fresh renderer-owned string. The TP + ;; owned-result path copies the string spine once while + ;; rendering the plan; recursively snapshotting every + ;; property value here duplicated the hot scroll work. + rendered + (ebox-surface--candidate-plan-text + rendered (plist-get state :render-owned-text-values)))) (plan (tp-surface-plan-create-owned :key ebox-surface--root-key :kind 'ebox/surface @@ -1449,14 +2551,16 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges." :capability 'content))) (plist-put state :surface-fragments (ebox-surface--fragment-metadata fragment-data)) + (cl-remf state :mixed-owner-fragment-data) + (cl-remf state :mixed-owner-content-p) (let ((rendered-length (length rendered))) - (list plan rendered + (list plan rendered owned-ranges (list (list :object text-leaf :start 0 :end rendered-length :props nil :tags nil :leaf t) (list :object fragment-root :start 0 :end rendered-length :props nil :tags nil :leaf nil) (list :object surface-root :start 0 :end rendered-length - :props nil :tags nil :leaf nil))))))) + :props nil :tags nil :leaf nil)))))))) (defconst ebox-surface--paint-base-roles '(content content-owner pt pb pl pr bl br) @@ -1572,11 +2676,16 @@ ANCESTOR-P means BOX wraps a more specific rendered surface." "Remove trailing Ebox CONTRIBUTIONS from FACE and return its baseline." (let* ((entries (ebox-surface--face-list face)) (count (length contributions)) - (prefix-count (- (length entries) count))) - (if (and (>= prefix-count 0) - (equal (nthcdr prefix-count entries) contributions)) - (ebox-surface--face-value (seq-take entries prefix-count)) - face))) + (baseline entries)) + ;; A prior paint projection may have appended the same semantic Ebox + ;; contribution more than once. Peel every matching suffix layer before + ;; composing the new state; caller-provided face entries remain untouched. + (while (and (> count 0) + (>= (length baseline) count) + (equal (last baseline count) contributions)) + (setq baseline + (seq-take baseline (- (length baseline) count)))) + (ebox-surface--face-value baseline))) (defun ebox-surface--compose-face (baseline contributions) "Append Ebox CONTRIBUTIONS to BASELINE using Emacs face semantics." @@ -1643,16 +2752,31 @@ ANCESTOR-P means BOX wraps a more specific rendered surface." (ebox-surface--set-horizontal-border-role fragments region-id (cdr entry) (plist-get box (car entry))))))))) -(defun ebox-surface--repaint-fragment (fragment old-state new-state) +(defun ebox-surface--repaint-fragment + (fragment old-state new-state &optional old-face-cache new-face-cache) "Return FRAGMENT with Ebox paint recomputed from OLD-STATE to NEW-STATE." (let* ((text (copy-sequence (plist-get fragment :text))) (old-roles (plist-get fragment :old-paint-role-ids)) (new-roles (plist-get fragment :paint-role-ids)) - (old-faces (ebox-surface--face-contributions old-state old-roles)) - (new-faces (ebox-surface--face-contributions new-state new-roles)) + (old-faces + (or (and old-face-cache (gethash old-roles old-face-cache)) + (let ((value (ebox-surface--face-contributions + old-state old-roles))) + (when old-face-cache + (puthash old-roles value old-face-cache)) + value))) + (new-faces + (or (and new-face-cache (gethash new-roles new-face-cache)) + (let ((value (ebox-surface--face-contributions + new-state new-roles))) + (when new-face-cache + (puthash new-roles value new-face-cache)) + value))) (baseline (and (> (length text) 0) - (ebox-surface--face-baseline - (get-text-property 0 'face text) old-faces))) + (if (plist-get fragment :face-baseline-known-p) + (copy-tree (plist-get fragment :face-baseline)) + (ebox-surface--face-baseline + (get-text-property 0 'face text) old-faces)))) (unchanged (and (equal old-roles new-roles) (equal old-faces new-faces))) (face (and (not unchanged) @@ -1748,6 +2872,7 @@ OLD-TEXT is a defensive snapshot of the published TP content." (ebox--new-buffer-render-state root)) (copy-sequence state-overrides)))) (plist-put state :root-node root) + (plist-put state :projection-kind projection-kind) (plist-put state :cascade-active-p stylesheet-active-p) (plist-put state :cascade-required-p cascade-required-p) (when axes @@ -1782,7 +2907,26 @@ published runtime and must be consumed without clearing those shared nodes." (tp-surface-plan-create :key ebox-surface--root-key :kind 'ebox/string :text source :capability 'content))) - (let* ((stylesheet-active-p (ebox-style-cascade-active-p)) + (let* ((scroll-patch-p (eq projection-kind 'scroll-patch)) + (scroll-fast-p + (and scroll-patch-p + (let ((table (plist-get state-overrides + :scroll-state-table)) + (fast t)) + (if (hash-table-p table) + (maphash + (lambda (_region-id scroll-state) + (unless + (ebox--scroll-state-retained-window-ready-p + scroll-state) + (setq fast nil))) + table) + (setq fast nil)) + fast))) + (stylesheet-active-p + (if scroll-fast-p + (plist-get previous-state :cascade-active-p) + (ebox-style-cascade-active-p))) (root (cond (source-path-copied-p source) (source-isolated-p @@ -1798,19 +2942,30 @@ published runtime and must be consumed without clearing those shared nodes." (ebox-surface--isolated-viewport-overrides state-overrides) state-overrides)) (inline-inheritance-required-p - (ebox-surface--inline-inheritance-required-p root)) + (if scroll-fast-p + (plist-get previous-state :cascade-required-p) + (ebox-surface--inline-inheritance-required-p root))) (cascade-required-p - (or stylesheet-active-p inline-inheritance-required-p)) + (if scroll-fast-p + (plist-get previous-state :cascade-required-p) + (or stylesheet-active-p inline-inheritance-required-p))) (style-required-p - (or cascade-required-p - (plist-get previous-state :cascade-active-p) - (plist-get previous-state :cascade-required-p))) + (if scroll-fast-p + cascade-required-p + (or cascade-required-p + (plist-get previous-state :cascade-active-p) + (plist-get previous-state :cascade-required-p)))) (projection (ebox-surface--projection-start context root style-required-p projection-kind previous-state))) (unless (or source-isolated-p source-path-copied-p) (ebox-surface--reconcile-candidate root previous-state)) - (let* ((axes (and signals (ebox-surface--context-axes root))) + (let* ((axes + (and signals + (if scroll-fast-p + (plist-get previous-state + :viewport-dependent-node-id-axes) + (ebox-surface--context-axes root)))) (viewport-width (and signals (funcall @@ -1830,12 +2985,23 @@ published runtime and must be consumed without clearing those shared nodes." (tp-signal-peek (ebox-surface--signals-scroll signals)))) (state - (ebox-surface--projection-state + (ebox-surface--projection-state root previous-state state-overrides projection-kind stylesheet-active-p cascade-required-p axes viewport-width viewport-height display-signature scroll-offsets))) - (when (eq projection-kind 'span-patch) - (ebox-surface--attach-retained-node-objects state)) + (plist-put state :style-binding-states + (plist-get projection :style-binding-states)) + (plist-put state :selector-tree-snapshot + (plist-get projection :selector-tree-snapshot)) + (plist-put state :selector-tree-token + (plist-get projection :selector-tree-token)) + (plist-put state :scroll-fast-window-p scroll-fast-p) + (when (memq projection-kind + '(span-patch owner-scoped scroll-patch + formatting-context-reflow mixed-owner-reflow)) + (ebox-surface--attach-retained-node-objects state) + (when (eq projection-kind 'owner-scoped) + (ebox-surface--apply-retained-owner-styles state))) (if (eq projection-kind 'paint) (let* ((dirty-set (plist-get state-overrides :paint-dirty-set)) (buffer (and signals @@ -1853,26 +3019,57 @@ published runtime and must be consumed without clearing those shared nodes." context projection state (ebox-surface--paint-fragments previous-state state dirty-set old-text))) - (plist-put state :region-box-table (make-hash-table :test 'equal)) + (unless (memq projection-kind + '(scroll-patch formatting-context-reflow + mixed-owner-reflow)) + (plist-put state :region-box-table (make-hash-table :test 'equal))) (let ((rendered - (if (eq projection-kind 'span-patch) - (if-let ((span-output - (ebox-surface--span-patch-output - (ebox-surface--signals-buffer signals) state))) - span-output - (setq projection - (ebox-surface--complete-projection - context root style-required-p projection)) + (cond + ((and (eq projection-kind 'scroll-patch) + (plist-get state :native-scroll-materialize-p)) + (or (ebox-surface--native-scroll-full-output state) + (ebox-surface--scroll-patch-output + (ebox-surface--signals-buffer signals) state))) + ((eq projection-kind 'scroll-patch) + (or (ebox-surface--scroll-patch-output + (ebox-surface--signals-buffer signals) state) + (ebox-surface--render-candidate state))) + ((eq projection-kind 'formatting-context-reflow) + (or (ebox-surface--formatting-context-reflow-output + (ebox-surface--signals-buffer signals) state) + (ebox-surface--render-candidate state))) + ((eq projection-kind 'mixed-owner-reflow) + (or (ebox-surface--mixed-owner-output + (ebox-surface--signals-buffer signals) + previous-state state) + (ebox-surface--render-candidate state))) + ((memq projection-kind '(span-patch owner-scoped)) + (if-let ((span-output + (ebox-surface--span-patch-output + (ebox-surface--signals-buffer signals) state))) + span-output + (setq projection + (ebox-surface--complete-projection + context root style-required-p projection)) (setq state (ebox-surface--projection-state root previous-state state-overrides nil stylesheet-active-p cascade-required-p axes viewport-width viewport-height display-signature scroll-offsets)) + (plist-put state :style-binding-states + (plist-get projection :style-binding-states)) + (plist-put state :selector-tree-snapshot + (plist-get projection + :selector-tree-snapshot)) + (plist-put state :selector-tree-token + (plist-get projection + :selector-tree-token)) (plist-put state :region-box-table (make-hash-table :test 'equal)) - (ebox-surface--render-candidate state)) - (ebox-surface--render-candidate state)))) + (ebox-surface--render-candidate state))) + (t + (ebox-surface--render-candidate state))))) (when (and signals (hash-table-p (plist-get state :scroll-state-table)) (> (hash-table-count @@ -1887,8 +3084,16 @@ published runtime and must be consumed without clearing those shared nodes." ;; attaching before that point would mutate the published ;; node table through the old state's indexes. (ebox-surface--attach-retained-node-objects state)) - (ebox-surface--projection-result - context projection state rendered))))))) + (let ((result + (ebox-surface--projection-result + context projection state rendered projection-kind))) + ;; These flags authenticate one producer result only. Leaving + ;; them in the committed client state would make a later + ;; content/geometry update look like a scroll transaction and + ;; bypass its scope validation. + (plist-put state :retained-scroll-content-p nil) + (plist-put state :native-scroll-materialize-p nil) + result))))))) (defun ebox-surface-producer (source &optional previous-state preserve-identities-p state-overrides diff --git a/ebox-tree.el b/ebox-tree.el index 314fde5..e72c1ea 100644 --- a/ebox-tree.el +++ b/ebox-tree.el @@ -12,6 +12,7 @@ (require 'subr-x) (require 'ecss-selector) (require 'ebox-style) +(require 'ebox-child-range) (defconst ebox--default-display '(block flow) "Default CSS-like display for a plain Ebox box.") @@ -138,11 +139,11 @@ This is an optimization for snapshot capture, not buffer runtime state.") ('flex (append (when-let ((box (plist-get node :box))) (list box)) - (plist-get node :children))) + (ebox-tree-layout-children node))) ('grid (append (when-let ((box (plist-get node :box))) (list box)) - (plist-get node :children))) + (ebox-tree-layout-children node))) ('flex-item (delq nil (list (plist-get node :node)))) (_ nil))) @@ -157,15 +158,17 @@ must not modify a published runtime tree through this accessor." "Return layout container children for NODE in render order. New row/column containers store flat `:children'. Legacy `ebox-concat' and `ebox-stack' nodes may still carry `:left'/`:right' or `:top'/`:bottom'." - (or (plist-get node :children) - (pcase (and (listp node) (plist-get node :ebox-type)) - ('concat - (delq nil (list (plist-get node :left) - (plist-get node :right)))) - ('stack - (delq nil (list (plist-get node :top) - (plist-get node :bottom)))) - (_ nil)))) + (if (plist-member node :ebox-child-sequence) + (ebox-child-range--flatten (plist-get node :ebox-child-sequence)) + (or (plist-get node :children) + (pcase (and (listp node) (plist-get node :ebox-type)) + ('concat + (delq nil (list (plist-get node :left) + (plist-get node :right)))) + ('stack + (delq nil (list (plist-get node :top) + (plist-get node :bottom)))) + (_ nil))))) (defun ebox-tree--replace-direct-child (child replacements) "Return CHILD's identity replacement from REPLACEMENTS, when present. @@ -242,6 +245,55 @@ still copied while every nested value remains shared." (ebox-tree--replace-direct-child-list children replacements))) (unless (eq replaced children) (setq copy (plist-put copy :children replaced))))) + (when-let ((sequence (and (memq type '(concat stack flex grid)) + (plist-get copy :ebox-child-sequence)))) + (let ((updated sequence) changed fallback) + (dolist (replacement replacements) + (let* ((old (car replacement)) (new (cdr replacement)) + (location (and old (plist-get old :ebox-sequence-location))) + (key (and old (plist-get old :key))) + (key-location + (and (null location) key + (ebox-child-range--hash-lookup + (ebox-child-range--sequence-key-root updated) key + (funcall + (ebox-child-range--sequence-hash-function updated) + key))))) + (when key-location + (let* ((segment (ebox-child-range--segment-at + updated (car key-location))) + (candidate (aref + (ebox-child-range--segment-payload segment) + (cdr key-location)))) + (when (eq candidate old) + (setq location + (list :parent-node-id (plist-get node :node-id) + :segment-index (car key-location) + :offset (cdr key-location)))))) + (when (and location + (equal (plist-get location :parent-node-id) + (plist-get node :node-id))) + (if new + (setq updated + (ebox-child-range--replace-item-at + updated (plist-get location :segment-index) + (plist-get location :offset) old new) + changed t) + (setq fallback t))))) + (when fallback + (let (segments) + (dotimes (index (ebox-child-range--sequence-count sequence)) + (let* ((segment (ebox-child-range--segment-at sequence index)) + (items (append + (ebox-child-range--segment-payload segment) nil))) + (push (cons (ebox-child-range--segment-ref segment) + (ebox-tree--replace-direct-child-list + items replacements)) + segments))) + (setq updated (ebox-child-range--build (nreverse segments)) + changed t))) + (when changed + (setq copy (plist-put copy :ebox-child-sequence updated))))) copy)) (defun ebox-tree-copy-node-structure (root) @@ -250,15 +302,57 @@ The returned tree owns distinct node plists and child lists. Values such as keymaps, callbacks, Host references, and surface-property payloads retain their original object identity." (cl-labels - ((copy-node + ((without (plist key) + (cl-loop for (property value) on plist by #'cddr + unless (eq property key) append (list property value))) + (copy-node (node) (if (or (not (listp node)) (stringp node)) node - (ebox-tree-copy-with-direct-child-replacements - node - (mapcar (lambda (child) - (cons child (copy-node child))) - (ebox-tree--children-raw node)))))) + (let* ((type (plist-get node :ebox-type)) + (material-p (memq type '(concat stack flex grid))) + (raw (and material-p (plist-get node :children))) + (sequence (and material-p + (plist-get node :ebox-child-sequence))) + (has-range (cl-some #'ebox-child-range--descriptor-p raw))) + (if (or has-range sequence) + (let ((copy (copy-sequence node)) segments) + (if sequence + (dotimes (index + (ebox-child-range--sequence-count sequence)) + (let ((segment + (ebox-child-range--segment-at sequence index))) + (push + (cons (ebox-child-range--segment-ref segment) + (mapcar #'copy-node + (append + (ebox-child-range--segment-payload + segment) + nil))) + segments))) + (dolist (entry raw) + (if (ebox-child-range--descriptor-p entry) + (push (cons (ebox-child-range--descriptor-ref entry) + (mapcar + #'copy-node + (ebox-child-range--descriptor-items entry))) + segments) + (push (cons nil (list (copy-node entry))) segments)))) + (setq copy (without copy :children)) + (pcase type + ((or 'flex 'grid) + (when-let ((box (plist-get node :box))) + (setq copy (plist-put copy :box (copy-node box))))) + ('concat + (setq copy (without (without copy :left) :right))) + ('stack + (setq copy (without (without copy :top) :bottom)))) + (plist-put copy :ebox-child-sequence + (ebox-child-range--build (nreverse segments)))) + (ebox-tree-copy-with-direct-child-replacements + node + (mapcar (lambda (child) (cons child (copy-node child))) + (ebox-tree--children-raw node)))))))) (copy-node root))) (defun ebox-tree--runtime-identity-node-shell @@ -312,7 +406,7 @@ Record its identities in NODE-ID-SET and REGION-ID-SET." (lambda (child) (ebox-tree--runtime-identity-skeleton child node-id-set region-id-set)) - (plist-get node :children)))) + (ebox-tree-layout-children node)))) ('flex-item (when-let ((child (plist-get node :node))) (plist-put shell :node @@ -368,7 +462,10 @@ Host references are root-global opaque metadata and are compared with `equal'." (puthash node t seen) (puthash node t active) (dolist (child (ebox-tree--children-raw node)) - (visit child)) + (if (ebox-child-range--descriptor-p child) + (dolist (item (ebox-child-range--descriptor-items child)) + (visit item)) + (visit child))) (remhash node active)))))) (visit root)) root)) @@ -380,9 +477,12 @@ The runtime tree must be a proper tree: a node object cannot appear in two locations, cycles are rejected, explicit sibling keys must be unique, and non-nil host references must be unique across the root. Keys are sibling-local and all explicit identities are compared with `equal'. Return ROOT on success." + (when (ebox-child-range--descriptor-p root) + (error "Ebox child Range descriptor cannot be the root")) (ebox-tree-validate-host-refs root) (let ((seen (make-hash-table :test 'eq)) - (active (make-hash-table :test 'eq))) + (active (make-hash-table :test 'eq)) + (range-refs (make-hash-table :test 'equal))) (cl-labels ((visit (node) (when (and (listp node) (not (stringp node))) @@ -392,8 +492,36 @@ and all explicit identities are compared with `equal'. Return ROOT on success." (error "Ebox declarative tree reuses one node object")) (puthash node t seen) (puthash node t active) - (let ((keys (make-hash-table :test 'equal))) - (dolist (child (ebox-tree--children-raw node)) + (let* ((keys (make-hash-table :test 'equal)) + (type (plist-get node :ebox-type)) + (raw (and (memq type '(concat stack flex grid)) + (plist-get node :children))) + children) + (when (and raw (not (proper-list-p raw))) + (error "Ebox material children must be a proper list")) + (dolist (entry (ebox-tree--children-raw node)) + (if (ebox-child-range--descriptor-p entry) + (progn + (unless (and (proper-list-p raw) (memq entry raw)) + (error "Ebox child Range descriptor is invalid in a scalar slot")) + (let ((ref (ebox-child-range--descriptor-ref entry)) + (items (ebox-child-range--descriptor-items entry))) + (unless (and ref (proper-list-p items)) + (error "Ebox child Range descriptor is invalid")) + (when (gethash ref range-refs) + (error "Ebox child Range ref is not unique: %S" ref)) + (puthash ref t range-refs) + (dolist (item items) + (when (ebox-child-range--descriptor-p item) + (error "Nested child Range descriptors are reserved")) + (unless (and (listp item) (not (stringp item))) + (error "Ebox child Range item must be a node")) + (push item children)))) + (progn + (when (ebox-child-range--descriptor-p entry) + (error "Ebox child Range descriptor is invalid here")) + (push entry children)))) + (dolist (child (nreverse children)) (when-let ((key (and (listp child) (not (stringp child)) (plist-get child :key)))) @@ -418,17 +546,21 @@ and all explicit identities are compared with `equal'. Return ROOT on success." (plist-put node :region-id nil))) (when (plist-member node :surface-object) (plist-put node :surface-object nil)) + (when (plist-member node :ebox-sequence-location) + (plist-put node :ebox-sequence-location nil)) (dolist (child (ebox-tree--children-raw node)) (visit child))))) (visit root)) root) (defconst ebox-tree--runtime-source-keys - '(:node-id :region-id :surface-object :render-cache) + '(:node-id :region-id :surface-object :render-cache :ebox-sequence-location + :ebox-content-width-exact-p) "Runtime-owned plist keys excluded from declarative source signatures.") (defconst ebox-tree--child-source-keys - '(:children :left :right :top :bottom :node :box :ebox-content-node) + '(:children :ebox-child-sequence :left :right :top :bottom :node :box + :ebox-content-node) "Child references excluded from node-local declarative signatures.") (defconst ebox-tree--excluded-source-keys @@ -449,21 +581,76 @@ projected Ebox longhands carry the actual paint and layout consequences.") "Return keys from PLIST in source order." (cl-loop for (key _value) on plist by #'cddr collect key)) +(defun ebox-tree--layout-props-source-signature (node) + "Return canonical layout-only props for a Grid/Flex NODE. +Raw layout props also carry derived paint aliases, host references, duplicate +width entries, and shorthand gap forms. Those fields are already represented +by style declarations or runtime identity and must not make a Theme repaint +look like a geometry mutation." + (when (memq (plist-get node :ebox-type) '(grid flex)) + (let* ((raw (or (plist-get node :raw-props) + (plist-get node :props))) + ;; Compare the same engine vocabulary used by Ebox rendering. A + ;; retained node may arrive once from an already-expanded style + ;; snapshot and later from fresh shorthand declarations; comparing + ;; those source spellings directly creates fake geometry dirtiness. + (raw (ebox-style-expand-ebox-plist raw)) + (table (make-hash-table :test #'eq))) + (cl-loop for (key value) on raw by #'cddr + unless (memq key '(:color :background-color :bgcolor :host-ref + :surface-properties)) + do (puthash key value table)) + (when (plist-member raw :gap) + (let* ((gap (plist-get raw :gap)) + (row (if (consp gap) (car gap) gap)) + (column (if (and (consp gap) (cdr gap)) (cadr gap) row)) + ;; Flex and Grid deliberately have separate canonical + ;; property vocabularies. Using Grid aliases for a Flex node + ;; makes an unchanged `gap' look like geometry dirtiness on + ;; the next retained generation. + (row-key (if (eq (plist-get node :ebox-type) 'grid) + :grid-row-gap + :row-gap)) + (column-key (if (eq (plist-get node :ebox-type) 'grid) + :grid-column-gap + :column-gap))) + (puthash row-key row table) + (puthash column-key column table) + (remhash :gap table))) + (let (keys) + (maphash (lambda (key _value) (push key keys)) table) + (setq keys + (sort keys + (lambda (left right) + (string< (symbol-name left) + (symbol-name right))))) + (cl-loop for key in keys + append (list key (gethash key table))))))) + +(defun ebox-tree--local-source-signature (node) + "Return NODE's filtered local declarative source signature." + (let ((plist node) + signature) + (while plist + (let ((key (pop plist)) + (value (pop plist))) + (unless (or (memq key ebox-tree--excluded-source-keys) + (and (memq key '(:props :raw-props)) + (memq (plist-get node :ebox-type) '(grid flex)))) + (push key signature) + (push value signature)))) + (when-let ((layout (ebox-tree--layout-props-source-signature node))) + (push :ebox-layout-props signature) + (push layout signature)) + (nreverse signature))) + (defun ebox-tree-node-local-source-signature (node) "Return NODE's non-recursive declarative source signature. Runtime identities, caches, and child pointers are excluded. Child order is compared independently through stable runtime ids, so a leaf change does not mark every ancestor dirty." - (let ((plist node) - signature) - (while plist - (let ((key (pop plist)) - (value (pop plist))) - (unless (memq key ebox-tree--excluded-source-keys) - (push key signature) - (push value signature)))) - (nreverse signature))) + (ebox-tree--local-source-signature node)) (defun ebox-tree--next-local-source-entry (plist) "Return PLIST's next node-local source entry, skipping excluded keys." @@ -489,24 +676,25 @@ mark every ancestor dirty." (defun ebox-tree-node-local-changed-keys (old new) "Return ordered declarative keys whose node-local values differ. OLD and NEW are source nodes with the same retained runtime identity." - (unless (ebox-tree--local-source-sequence-equal-p old new) - (let (seen changed) - (dolist (source (list old new)) - (let ((plist source)) - (while plist - (let ((key (pop plist))) - (pop plist) - (unless (or (memq key ebox-tree--excluded-source-keys) - (memq key seen)) - (push key seen) - (let ((old-entry (plist-member old key)) - (new-entry (plist-member new key))) - (unless (and (eq (not (null old-entry)) - (not (null new-entry))) - (equal-including-properties - (cadr old-entry) (cadr new-entry))) - (push key changed)))))))) - (nreverse changed)))) + (let ((old-signature (ebox-tree--local-source-signature old)) + (new-signature (ebox-tree--local-source-signature new)) + seen changed) + (dolist (source (list old-signature new-signature)) + (let ((plist source)) + (while plist + (let ((key (pop plist))) + (pop plist) + (unless (memq key seen) + (push key seen) + (let ((old-entry (plist-member old-signature key)) + (new-entry (plist-member new-signature key))) + (unless (and (eq (not (null old-entry)) + (not (null new-entry))) + (equal-including-properties + (cadr old-entry) (cadr new-entry))) + (push (if (eq key :ebox-layout-props) :props key) + changed)))))))) + (nreverse changed))) (defun ebox-tree-transfer-runtime-identity (old new) "Transfer retained runtime identity from matching OLD to NEW. @@ -522,6 +710,9 @@ candidate runtime index agree." (plist-get new :ebox-type))) (progn (plist-put new :node-id (ebox--ensure-node-id old)) + (when (plist-member old :ebox-sequence-location) + (plist-put new :ebox-sequence-location + (copy-sequence (plist-get old :ebox-sequence-location)))) (when (eq (plist-get new :ebox-type) 'box) (plist-put new :region-id (ebox--ensure-region-id old)) ;; Omitted scroll state is uncontrolled host state. `ebox-create' @@ -615,8 +806,8 @@ candidate runtime index agree." ((or 'concat 'stack) (ebox-tree--semantic-layout-leaves node)) ('flex - (mapcar #'ebox-tree-flex-item-source-node (plist-get node :children))) - ('grid (plist-get node :children)) + (mapcar #'ebox-tree-flex-item-source-node (ebox-tree-layout-children node))) + ('grid (ebox-tree-layout-children node)) ('flex-item (delq nil (list (plist-get node :node)))) (_ (ebox-tree-children node)))) @@ -742,14 +933,14 @@ not only the public update ids." (list (ebox--ensure-region-id box))) (apply #'append (mapcar #'ebox-tree-node-all-region-ids - (plist-get node :children))))) + (ebox-tree-layout-children node))))) ('grid (append (when-let ((box (plist-get node :box))) (list (ebox--ensure-region-id box))) (apply #'append (mapcar #'ebox-tree-node-all-region-ids - (plist-get node :children))))) + (ebox-tree-layout-children node))))) ('flex-item (ebox-tree-node-all-region-ids (plist-get node :node))) (_ nil)))) @@ -786,14 +977,14 @@ cannot be inspected and reports no conflict." (and (plist-get box paint-key) t))) (cl-some (lambda (child) (ebox-tree-node-paint-conflict-p child paint-key t)) - (plist-get node :children)))) + (ebox-tree-layout-children node)))) ('grid (or (and inherited (when-let ((box (plist-get node :box))) (and (plist-get box paint-key) t))) (cl-some (lambda (child) (ebox-tree-node-paint-conflict-p child paint-key t)) - (plist-get node :children)))) + (ebox-tree-layout-children node)))) ('flex-item (ebox-tree-node-paint-conflict-p (plist-get node :node) paint-key inherited)) @@ -834,7 +1025,7 @@ wrapper's visible content is produced by the flex renderer." (list node)) (t (catch 'found - (dolist (child (plist-get node :children)) + (dolist (child (ebox-tree-layout-children node)) (when-let ((path (ebox-tree-node-path-to-region child region-id))) (throw 'found (append path (list node))))) nil)))) @@ -845,7 +1036,7 @@ wrapper's visible content is produced by the flex renderer." (list node)) (t (catch 'found - (dolist (child (plist-get node :children)) + (dolist (child (ebox-tree-layout-children node)) (when-let ((path (ebox-tree-node-path-to-region child region-id))) (throw 'found (append path (list node))))) nil)))) @@ -873,12 +1064,12 @@ wrapper's visible content is produced by the flex renderer." (or (and (plist-get node :box) (ebox--box-visible-overflow-p (plist-get node :box))) (cl-some #'ebox-tree-node-visible-overflow-p - (plist-get node :children)))) + (ebox-tree-layout-children node)))) ('grid (or (and (plist-get node :box) (ebox--box-visible-overflow-p (plist-get node :box))) (cl-some #'ebox-tree-node-visible-overflow-p - (plist-get node :children)))) + (ebox-tree-layout-children node)))) ('flex-item (ebox-tree-node-visible-overflow-p (plist-get node :node))) (_ nil))))) diff --git a/ebox.el b/ebox.el index 35512f8..758f804 100644 --- a/ebox.el +++ b/ebox.el @@ -23,7 +23,7 @@ "Directory containing the active Ebox Lisp sources.") (defconst ebox--compile-sources - '("ebox-cache.el" "ebox-style.el" "ebox-tree.el" "ebox-measure.el" + '("ebox-cache.el" "ebox-style.el" "ebox-child-range.el" "ebox-tree.el" "ebox-measure.el" "ebox-fragment.el" "ebox-render-context.el" "ebox-layout.el" "ebox-flex.el" "ebox-grid.el" "ebox-buffer-backend.el" "ebox-incremental.el" "ebox-surface.el" "ebox-dsl.el" "ebox-selector.el" "ebox.el" @@ -38,6 +38,7 @@ (require 'subr-x) (require 'ebox-cache) (require 'ebox-style) +(require 'ebox-child-range) (require 'ebox-tree) (require 'ebox-measure) (require 'ebox-fragment) @@ -54,6 +55,8 @@ (declare-function ebox--buffer-update-report "ebox-incremental" (buffer)) (declare-function ebox--set-buffer-update-report "ebox-incremental" (buffer report)) +(declare-function ebox--scroll-rendered-content-lines + "ebox-layout" (box lines region-id &optional start-index)) (unless (fboundp 'ebox-native-build) (autoload 'ebox-native-build "ebox-native-reflow" nil t)) @@ -157,14 +160,15 @@ outputs remain correct but are not retained after rendering." :type 'positive-integer :group 'ebox) -(defcustom ebox-wheel-scroll-step 16 +(defcustom ebox-wheel-scroll-step 1 "Default number of lines moved by one vertical mouse wheel event. -This is separate from `ebox-scroll-step' so keyboard fine scrolling can stay -precise while real mouse and trackpad scrolling feels responsive." +Ebox follows ordinary document scrolling by default: one input moves one line +through the scroll owner chain. Users who prefer larger wheel jumps may +customize this independently from `ebox-scroll-step'." :type 'positive-integer :group 'ebox) -(defcustom ebox-wheel-smooth-scroll t +(defcustom ebox-wheel-smooth-scroll nil "When non-nil, animate mouse wheel scrolling over several short steps." :type 'boolean :group 'ebox) @@ -236,6 +240,17 @@ prefetch yield; ordinary prefix scheduling keeps its own configured delay." :type 'positive-integer :group 'ebox) +(defcustom ebox-native-buffer-scroll t + "When non-nil, use native-window scrolling for eligible root owners. +The native path is admitted only for an interactive buffer with one complete, +chrome-free root scroll owner and no nested scroll owner. Its one-time idle +materialization is scheduled for initial display or an explicit visible-window +handoff; ordinary incremental updates and resizes use the retained scroll +patch and never start a second native publication. Nested or lazy surfaces +keep the transactional retained-window path." + :type 'boolean + :group 'ebox) + (defcustom ebox-runtime-idle-reflow-cache-prewarm t "When non-nil, predict and cache the next steady viewport reflow. Each completed nonzero viewport-width delta predicts one following width. The @@ -359,6 +374,9 @@ caller, such as the Playground preview, renders against a concrete window.") "Buffer-keyed incremental-update prewarm jobs.") (defvar ebox--runtime-prewarm-timers (make-hash-table :test 'eq) "Buffer-keyed idle timers for incremental-update prewarming.") + +(defvar ebox--native-scroll-prewarm-in-progress nil + "Non-nil while idle native-scroll materialization publishes its candidate.") (defvar ebox--reflow-cache-prewarm-timers (make-hash-table :test 'eq) "Buffer-keyed idle timers for predicted reflow-cache warming.") (defvar ebox--scroll-prefetch-delay-override nil @@ -686,12 +704,14 @@ Use this to capture ids *before* inserting into a buffer: (if-let ((box (plist-get node :box))) (list (ebox--ensure-region-id box)) (apply #'append - (mapcar #'ebox-region-ids (plist-get node :children))))) + (mapcar #'ebox-region-ids + (ebox-tree-layout-children node))))) ((eq type 'grid) (if-let ((box (plist-get node :box))) (list (ebox--ensure-region-id box)) (apply #'append - (mapcar #'ebox-region-ids (plist-get node :children))))) + (mapcar #'ebox-region-ids + (ebox-tree-layout-children node))))) ((eq type 'flex-item) (ebox-region-ids (plist-get node :node))) (t nil)))))) @@ -1340,6 +1360,251 @@ remain transaction-local." (end (min (+ offset content-height) (length lines)))) (list offset (seq-subseq lines offset end)))))))) +(defun ebox--scroll-state-retained-window-ready-p (state) + "Return non-nil when STATE can publish its cached visible window directly. +The proof is deliberately limited to a top-aligned, chrome-free scroll box; +the cached rendered prefix may remain incomplete as long as it covers the +current visible slice. Prefix misses continue through the normal renderer." + (let ((box (plist-get state :box)) + (visible (ebox--scroll-state-rendered-visible-window state))) + (and box visible + (= (or (ebox-get box :padding-left-pixel) 0) 0) + (= (or (ebox-get box :padding-right-pixel) 0) 0) + (= (or (ebox-get box :padding-top-height) 0) 0) + (= (or (ebox-get box :padding-bottom-height) 0) 0) + (= (or (ebox-get box :margin-left-pixel) 0) 0) + (= (or (ebox-get box :margin-right-pixel) 0) 0) + (= (or (ebox-get box :margin-top-height) 0) 0) + (= (or (ebox-get box :margin-bottom-height) 0) 0) + (= (or (ebox-get box :border-left-pixel) 0) 0) + (= (or (ebox-get box :border-right-pixel) 0) 0) + (not (ebox-get box :border-top-p)) + (not (ebox-get box :border-bottom-p)) + (eq (ebox-get box :vertical-align) 'top) + (null (ebox-get box :surface-properties)) + visible))) + +(defun ebox--native-buffer-scroll-root-proof-p + (buffer region-id &optional render-state) + "Return non-nil when REGION-ID can use native BUFFER line scrolling. +This is intentionally stricter than the retained-window proof: native +scrolling requires one root owner, a live displaying window, and no sibling or +nested scroll state. The full content is materialized separately before the +proof becomes usable for an input event." + (let* ((state (or render-state (ebox--buffer-render-state buffer))) + (root (and state (plist-get state :root-node))) + (root-id (and root (plist-get root :node-id))) + (region-ids (and state (plist-get state :scroll-region-ids))) + (owner-id (and (buffer-live-p buffer) + (ebox--buffer-region-render-owner-node-id + buffer region-id))) + (scroll-state + (and state + (gethash region-id (plist-get state :scroll-state-table)))) + (box (and scroll-state (plist-get scroll-state :box))) + (window (and (not noninteractive) + (get-buffer-window buffer t)))) + (and ebox-native-buffer-scroll + (buffer-live-p buffer) + (window-live-p window) + root root-id scroll-state box + (memq region-id region-ids) + (= root-id owner-id) + ;; A native full-content buffer is a valid presentation only while + ;; the formatting context is independent of the viewport. If the + ;; root or any descendant reads viewport width/height, a later + ;; resize must be able to reflow from the retained window state; do + ;; not let idle materialization turn that resize into a full-content + ;; publication. + (ebox--native-buffer-scroll-viewport-independent-p state root) + ;; Native scrolling presents the complete root surface in the + ;; ordinary Emacs window. Any chrome or surface decoration needs the + ;; retained Ebox projection so its geometry remains transactional. + (= (or (ebox-get box :padding-left-pixel) 0) 0) + (= (or (ebox-get box :padding-right-pixel) 0) 0) + (= (or (ebox-get box :padding-top-height) 0) 0) + (= (or (ebox-get box :padding-bottom-height) 0) 0) + (= (or (ebox-get box :margin-left-pixel) 0) 0) + (= (or (ebox-get box :margin-right-pixel) 0) 0) + (= (or (ebox-get box :margin-top-height) 0) 0) + (= (or (ebox-get box :margin-bottom-height) 0) 0) + (= (or (ebox-get box :border-left-pixel) 0) 0) + (= (or (ebox-get box :border-right-pixel) 0) 0) + (not (ebox-get box :border-top-p)) + (not (ebox-get box :border-bottom-p)) + (eq (ebox-get box :vertical-align) 'top) + (null (ebox-get box :surface-properties))))) + +(defun ebox--native-buffer-scroll-viewport-independent-p (state root) + "Return non-nil when ROOT has no viewport-dependent descendant. +Use the published dependency axes when available so native scroll hit-tests +remain O(1); the subtree predicates are only a conservative initialization +fallback for legacy states without a completed axis index." + (let ((axes (plist-get state :viewport-dependent-node-id-axes))) + (if (plist-get state :viewport-dependent-node-ids-ready) + (and (null (car axes)) + (null (cdr axes))) + (and (not (ebox--viewport-dependent-subtree-p root)) + (not (ebox--viewport-height-dependent-subtree-p root)))))) + +(defun ebox--native-buffer-scroll-root-region-id (buffer state) + "Return the outer root scroll owner id for BUFFER STATE, if eligible." + (let* ((root (plist-get state :root-node)) + (root-id (and root (plist-get root :node-id)))) + (cl-loop for region-id in (plist-get state :scroll-region-ids) + when (and root-id + (= root-id + (ebox--buffer-region-render-owner-node-id + buffer region-id))) + return region-id))) + +(defun ebox--native-buffer-scroll-position (buffer offset) + "Return BUFFER position at logical line OFFSET from its root start." + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (forward-line (max 0 offset)) + (point)))) + +(defun ebox--native-buffer-scroll-by (buffer region-id delta) + "Scroll eligible root REGION-ID by DELTA using the native window. +Return the signed consumed distance, zero at a boundary, or the sentinel +`native-unavailable' when the strict proof does not hold." + (let* ((render-state (ebox--buffer-render-state buffer)) + (state (and render-state + (gethash region-id + (plist-get render-state :scroll-state-table))))) + (if (not (and state + (plist-get render-state :native-buffer-scroll-p) + (plist-get state :content-lines-complete-p) + (ebox--native-buffer-scroll-root-proof-p + buffer region-id render-state))) + 'native-unavailable + (let* ((lines (plist-get state :rendered-content-lines)) + (height (max 0 (or (plist-get state :content-height) 0))) + (old-offset (or (plist-get state :scroll-offset) 0)) + (maximum (max 0 (- (length lines) height))) + (new-offset (max 0 (min maximum (+ old-offset delta))))) + (if (= new-offset old-offset) + 0 + (let* ((window (get-buffer-window buffer t)) + (old-window-start (window-start window)) + (old-window-point (window-point window)) + (old-box-offset (ebox-get (plist-get state :box) + :scroll-offset)) + (old-report (plist-get render-state :last-update-report)) + (new-position + (ebox--native-buffer-scroll-position buffer new-offset)) + (report + (or (plist-get render-state :native-scroll-report) + (ebox--update-report + region-id 'native-buffer-scroll + :constraint-source 'scroll + :constraint-owner-id region-id + :constraint-owner-type 'box + :dirty-kinds '(geometry) + :dirty-count 1 :patch-count 1 + :patch-ops '(native-window-scroll) + :owner-ids (list region-id) + :owner-id region-id + :projection-kind 'native-buffer-scroll + :runtime-published t + :scroll-patch-fast-p t + :tp-full-root nil :tp-scope-fallback nil + :tp-operation-count 0 :tp-text-operations 0 + :tp-property-operations 0 :created-objects 0 + :removed-objects 0 :moved-objects 0 + :reconciled-objects 0)))) + ;; Native root scrolling is a presentation-only state transition: + ;; it touches no signal, binding, candidate, or TP surface. Keep + ;; the same atomic rollback contract locally, but do not allocate + ;; a full TP transaction (hash tables, journals, and participant + ;; records) for every ordinary document line. + (unless (plist-get render-state :native-scroll-report) + (plist-put render-state :native-scroll-report report)) + (condition-case condition + (progn + (set-window-start window new-position t) + (set-window-point window new-position) + (ebox-put (plist-get state :box) + :scroll-offset new-offset) + (plist-put state :scroll-offset new-offset) + (puthash region-id state ebox--scroll-global-state) + (plist-put render-state :last-update-report report) + (- new-offset old-offset)) + ((error quit) + (condition-case nil + (progn + (set-window-start window old-window-start t) + (set-window-point window old-window-point) + (ebox-put (plist-get state :box) + :scroll-offset old-box-offset) + (plist-put state :scroll-offset old-offset) + (puthash region-id state ebox--scroll-global-state) + (plist-put render-state :last-update-report old-report)) + ((error quit) nil)) + (signal (car condition) (cdr condition)))))))))) + +(defun ebox--native-buffer-scroll-at-position (buffer position delta) + "Try the native root scroll owner at BUFFER POSITION by DELTA. +Return a signed consumed distance, zero at a boundary, or +`native-unavailable' / `native-not-applicable'. The fast path only admits a +single root owner whose text properties prove that POSITION is not inside a +nested scroll owner; all other positions remain on the semantic intent +coordinator." + (let* ((render-state (ebox--buffer-render-state buffer)) + (root-region-id + (and render-state + (ebox--native-buffer-scroll-root-region-id + buffer render-state)))) + (if (not (and root-region-id + (integer-or-marker-p position))) + 'native-not-applicable + (with-current-buffer buffer + (let* ((position + (min (max (if (markerp position) + (marker-position position) + position) + (point-min)) + (1- (point-max)))) + (content-region-id + (get-text-property position 'ebox-content)) + (owners + (get-text-property position 'ebox-content-owners))) + (if (and (equal content-region-id root-region-id) + (or (null owners) + (and (null (cdr owners)) + (equal (car owners) root-region-id)))) + (ebox--native-buffer-scroll-by + buffer root-region-id delta) + 'native-not-applicable)))))) + +(defun ebox--native-buffer-scroll-at-point (delta) + "Try native root scrolling for the current buffer's point by DELTA." + (ebox--native-buffer-scroll-at-position + (current-buffer) (point) delta)) + +(defun ebox--native-buffer-scroll-at-event (event delta) + "Try native root scrolling at EVENT's window position by DELTA." + (when-let* ((start (ignore-errors (event-start event))) + (window (posn-window start)) + ((window-live-p window)) + (buffer (window-buffer window)) + (position (posn-point start))) + (ebox--native-buffer-scroll-at-position buffer position delta))) + +(defun ebox--scroll-box-contains-grid-p (box) + "Return non-nil when BOX's retained scroll source contains a Grid node." + (catch 'found + (cl-labels ((visit (node) + (when (and (listp node) (not (stringp node))) + (when (eq (plist-get node :ebox-type) 'grid) + (throw 'found t)) + (dolist (child (ebox-tree--children-raw node)) + (visit child))))) + (visit box) + nil))) + (defun ebox--scroll-rendered-visible-windows-equal-p (left right) "Return non-nil when LEFT and RIGHT have identical text and properties." (and left right @@ -2364,20 +2629,46 @@ predictions are skipped." buffer state revision viewport-width target-width viewport-height) ebox--reflow-cache-prewarm-timers)))))) -(defun ebox--runtime-prewarm-new-job (state) - "Return a new runtime prewarm job for render STATE." - (list :render-state state - :runtime-revision (or (plist-get state :runtime-revision) 0) - :phase 'snapshots - :snapshot-stack - (when-let ((root (plist-get state :root-node))) - (list (vector root :uninitialized t t))) - :node-region-ids-cache (make-hash-table :test 'eq) - :viewport-width-ids-rev nil - :viewport-height-ids-rev nil - :scroll-region-ids (plist-get state :scroll-region-ids) - :scroll-sources nil - :scroll-task nil)) +(defun ebox--runtime-prewarm-new-job + (buffer state &optional retained-only-p) + "Return a new runtime prewarm job for BUFFER's render STATE. +RETAINED-ONLY-P is true for ordinary update/resize follow-up work; those +transactions only warm retained indexes and must not publish a second native +scroll surface." + (let* ((native-prewarm-p (and (not retained-only-p) + ebox-native-buffer-scroll)) + (native-scroll-region-id + (and native-prewarm-p + ebox-native-buffer-scroll + (not (plist-get state :native-buffer-scroll-p)) + (ebox--native-buffer-scroll-root-region-id buffer state))) + ;; Once a live window exists, native root scrolling has a stronger + ;; latency contract than the general shared-index prewarm: it needs + ;; only one complete content materialization and one publication. + ;; Start that job directly instead of spending several idle slices + ;; walking snapshots and line indexes first. Off-window buffers keep + ;; the ordinary snapshot job and are re-armed by + ;; `ebox--window-buffer-change' when they become visible. + (native-ready-p + (and native-scroll-region-id + (not noninteractive) + (ebox--native-buffer-scroll-root-proof-p + buffer native-scroll-region-id state)))) + (list :render-state state + :runtime-revision (or (plist-get state :runtime-revision) 0) + :phase (if native-ready-p 'native-scroll 'snapshots) + :snapshot-stack + (unless native-ready-p + (when-let ((root (plist-get state :root-node))) + (list (vector root :uninitialized t t)))) + :node-region-ids-cache (make-hash-table :test 'eq) + :viewport-width-ids-rev nil + :viewport-height-ids-rev nil + :scroll-region-ids (plist-get state :scroll-region-ids) + :native-scroll-region-id native-scroll-region-id + :native-prewarm-allowed-p native-prewarm-p + :scroll-sources nil + :scroll-task nil))) (defun ebox--runtime-prewarm-schedule-timer (buffer &optional delay) "Schedule BUFFER's next runtime prewarm slice after DELAY." @@ -2392,16 +2683,66 @@ predictions are skipped." nil #'ebox--runtime-prewarm-timer buffer) ebox--runtime-prewarm-timers))) -(defun ebox--schedule-buffer-runtime-prewarm (buffer &optional delay) - "Schedule shared incremental-update prewarming for BUFFER." +(defun ebox--schedule-buffer-runtime-prewarm + (buffer &optional delay retained-only-p) + "Schedule shared runtime prewarming for BUFFER. +RETAINED-ONLY-P is deliberately true after ordinary commits and resizes; the +initial mount and visible-window handoff leave it nil." (ebox--cancel-buffer-runtime-prewarm buffer) (when-let ((state (and (ebox--runtime-prewarm-enabled-p) (buffer-live-p buffer) (ebox--buffer-render-state buffer)))) - (puthash buffer (ebox--runtime-prewarm-new-job state) + (puthash buffer (ebox--runtime-prewarm-new-job + buffer state retained-only-p) ebox--runtime-prewarm-jobs) (ebox--runtime-prewarm-schedule-timer buffer delay))) +(defun ebox--window-buffer-change (window) + "Re-arm visible BUFFER's native-scroll prewarm after WINDOW changes. + +`ebox-render-to-buffer' may be called before its result is displayed. In +that case the initial idle job quite correctly avoids native window scrolling +because no live window exists, but the old job used to finish permanently +before the caller installed the buffer in a window. Re-arm only this +buffer's shared prewarm when a later window attachment exposes a root +candidate; the strict proof is rechecked when the new job starts, while +unrelated buffers and already-native runtimes stay inert." + (when (and (not noninteractive) + (window-live-p window)) + (let ((buffer (window-buffer window))) + (when (and (buffer-live-p buffer) + (ebox--buffer-render-state buffer) + ebox-native-buffer-scroll) + (let* ((state (ebox--buffer-render-state buffer)) + (region-id + (ebox--native-buffer-scroll-root-region-id buffer state))) + (when (and region-id + (not (plist-get state :native-buffer-scroll-p)) + (ebox--native-buffer-scroll-root-proof-p + buffer region-id state) + (not (eq (plist-get (gethash buffer + ebox--runtime-prewarm-jobs) + :phase) + 'native-scroll))) + (ebox--schedule-buffer-runtime-prewarm buffer 0 nil))))))) + +(when (boundp 'window-buffer-change-functions) + (add-hook 'window-buffer-change-functions #'ebox--window-buffer-change)) + +(defun ebox--window-state-change (frame) + "Re-arm visible Ebox buffers after FRAME's windows settle. + +Some Emacs builds dispatch `window-buffer-change-functions' before the new +buffer is observable through `get-buffer-window'. The state-change hook is +the post-redisplay boundary; inspect each live window once there so a buffer +that was rendered off-window cannot miss the native-scroll handoff." + (when (frame-live-p frame) + (dolist (window (window-list frame 'no-minibuf)) + (ebox--window-buffer-change window)))) + +(when (boundp 'window-state-change-functions) + (add-hook 'window-state-change-functions #'ebox--window-state-change)) + (defun ebox--runtime-prewarm-record-viewport-node (job node width-allowed) "Record NODE's direct viewport dependencies in JOB. @@ -2522,7 +2863,7 @@ Return non-nil when descendant width dependencies remain relevant." (let ((limit (max 1 ebox-runtime-idle-prewarm-slice-size)) (count 0)) (while (and (< count limit) - (not (eq (plist-get job :phase) 'done))) + (not (memq (plist-get job :phase) '(done native-scroll)))) (cond ((plist-get job :scroll-task) (let* ((task (plist-get job :scroll-task)) @@ -2567,7 +2908,63 @@ Return non-nil when descendant width dependencies remain relevant." region-id state)))) (setq count (1+ count))) (t - (plist-put job :phase 'done)))))) + (plist-put job :phase + (if (and (not noninteractive) + (plist-get job :native-prewarm-allowed-p) + ebox-native-buffer-scroll + (ebox--native-buffer-scroll-root-proof-p + buffer + (plist-get job :native-scroll-region-id))) + 'native-scroll + 'done))))))) + +(defun ebox--runtime-prewarm-native-scroll (buffer job) + "Materialize and publish an eligible root scroll surface for BUFFER. +The one-time publication runs only from the idle prewarm job; visible scroll +events use the native window afterwards and never enter the TP surface plan." + (let* ((region-id (plist-get job :native-scroll-region-id)) + (render-state (ebox--buffer-render-state buffer))) + (when (and region-id + (ebox--native-buffer-scroll-root-proof-p + buffer region-id render-state)) + (let* ((old-state (ebox--scroll-get-state region-id)) + (materialized + (ebox--scroll-state-materialize-lines region-id old-state))) + (unless (plist-get materialized :rendered-content-lines) + (let ((box (plist-get materialized :box)) + (lines (plist-get materialized :content-lines))) + (when (and box lines) + (setq materialized (copy-sequence materialized)) + (plist-put materialized :rendered-content-lines + (ebox--scroll-rendered-content-lines + box lines region-id 0))))) + (when (plist-get materialized :content-lines-complete-p) + (puthash region-id materialized ebox--scroll-global-state) + (let* ((runtime (ebox--surface-scroll-runtime buffer region-id)) + (table (plist-get runtime :scroll-table)) + (state (copy-sequence materialized)) + (candidate-box + (ebox--root-region-box + (plist-get runtime :root) region-id)) + (old-point (with-current-buffer buffer (point)))) + (plist-put state :box (or candidate-box (plist-get state :box))) + (puthash region-id state table) + (let ((ebox--native-scroll-prewarm-in-progress t)) + (ebox--surface-publish-scroll + buffer region-id runtime + (list :result 0 :state state + :offset (or (plist-get state :scroll-offset) 0) + :native-materialize-p t))) + (when-let ((window (get-buffer-window buffer t))) + (with-current-buffer buffer + (goto-char (min old-point (point-max)))) + (set-window-point window (point)) + (let ((position + (ebox--native-buffer-scroll-position + buffer (or (plist-get state :scroll-offset) 0)))) + (set-window-start window position t) + (set-window-point window position)))))))) + (plist-put job :phase 'done)) (defun ebox--runtime-prewarm-step (buffer) "Run one bounded runtime prewarm slice for BUFFER. @@ -2583,7 +2980,9 @@ Return non-nil while more work remains." ('snapshots (ebox--runtime-prewarm-snapshot-slice buffer job)) ('scroll - (ebox--runtime-prewarm-scroll-slice buffer job))) + (ebox--runtime-prewarm-scroll-slice buffer job)) + ('native-scroll + (ebox--runtime-prewarm-native-scroll buffer job))) (if (eq (plist-get job :phase) 'done) (progn (remhash buffer ebox--runtime-prewarm-jobs) @@ -2614,7 +3013,7 @@ Return non-nil while more work remains." (unless (gethash buffer ebox--runtime-prewarm-jobs) (when-let ((state (and (buffer-live-p buffer) (ebox--buffer-render-state buffer)))) - (puthash buffer (ebox--runtime-prewarm-new-job state) + (puthash buffer (ebox--runtime-prewarm-new-job buffer state) ebox--runtime-prewarm-jobs))) (if (ebox--runtime-prewarm-step buffer) (setq limit (1- limit)) @@ -2635,12 +3034,26 @@ Return non-nil while more work remains." (ebox-surface-region-bounds (current-buffer) region-id))) (when (and (<= (car bounds) pos) (< pos (cdr bounds))) - (push (cons region-id (- (cdr bounds) (car bounds))) + (push (cons region-id + (ebox--scroll-region-semantic-depth region-id)) candidates)))) ebox--scroll-global-state) (mapcar #'car (sort candidates - (lambda (a b) (< (cdr a) (cdr b))))))) + (lambda (a b) + (if (= (cdr a) (cdr b)) + (string< (format "%S" (car a)) + (format "%S" (car b))) + (> (cdr a) (cdr b)))))))) + +(defun ebox--scroll-region-semantic-depth (region-id) + "Return REGION-ID's runtime owner depth in the current buffer. +Scroll routing uses semantic ancestry rather than mount span length because +nested owners may render equal-sized clipped spans." + (let* ((state (ebox--buffer-render-state (current-buffer))) + (region-nodes (plist-get state :region-node-table)) + (node-id (and region-nodes (gethash region-id region-nodes)))) + (if node-id (ebox-surface--node-depth state node-id) -1))) (defun ebox--scroll-region-ids-in-buffer-outer-first () "Return scroll region ids in the current buffer from outer to inner." @@ -2650,12 +3063,17 @@ Return non-nil while more work remains." (when-let ((bounds (ebox-surface-region-bounds (current-buffer) region-id))) - (push (cons region-id (- (cdr bounds) (car bounds))) + (push (cons region-id + (ebox--scroll-region-semantic-depth region-id)) candidates))) ebox--scroll-global-state) (mapcar #'car (sort candidates - (lambda (a b) (> (cdr a) (cdr b))))))) + (lambda (a b) + (if (= (cdr a) (cdr b)) + (string< (format "%S" (car a)) + (format "%S" (car b))) + (< (cdr a) (cdr b)))))))) (defun ebox--scroll-region-ids-at-pos (pos) "Return scroll candidate region ids at POS from inner to outer." @@ -2674,7 +3092,13 @@ Return non-nil while more work remains." (unless (cl-some #'ebox--scroll-get-state ids) (dolist (region-id (ebox--scroll-region-ids-in-mounts-at-pos pos)) (add region-id)))) - ids)) + (sort ids + (lambda (a b) + (let ((a-depth (ebox--scroll-region-semantic-depth a)) + (b-depth (ebox--scroll-region-semantic-depth b))) + (if (= a-depth b-depth) + (string< (format "%S" a) (format "%S" b)) + (> a-depth b-depth))))))) (defun ebox--scroll-region-ids-at-point () "Return scroll candidate region ids at point from inner to outer." @@ -2701,12 +3125,36 @@ inside the old prefix, so a line-slide never mixes two layout versions." (defun ebox--surface-scroll-runtime (buffer region-id) "Return isolated scroll candidate runtime for BUFFER and REGION-ID." (let* ((old-state (ebox--buffer-render-state buffer)) - (root (ebox-tree-copy-node-structure - (plist-get old-state :root-node))) - (index (ebox--runtime-index root t)) + (old-root (plist-get old-state :root-node)) + (owner-id (ebox--buffer-region-render-owner-node-id + buffer region-id)) + ;; Scrolling changes one box property and never changes the logical + ;; tree. Copy only that owner path when it is the published root; + ;; nested scroll owners retain the old conservative isolated-copy + ;; path until their ancestor publication contract is proven. The + ;; previous implementation copied and indexed the complete gallery + ;; for every wheel event, which made a 512-node grid visibly stall. + (path-root + (and owner-id old-root + (equal owner-id (plist-get old-root :node-id)) + (ebox-incremental-surface-region-candidate-root + buffer region-id))) + (root (or path-root + (ebox-tree-copy-node-structure old-root))) + ;; All runtime index keys remain stable for a scroll-only path copy. + ;; Rebind just the affected region box; the incremental commit will + ;; derive its local index delta from the shared candidate path. + (region-box-table + (copy-hash-table (plist-get old-state :region-box-table))) + (candidate-box (ebox--root-region-box root region-id)) + (_ (when candidate-box + (puthash region-id candidate-box region-box-table))) + (index + (list :region-id-set (plist-get old-state :region-id-set) + :region-box-table region-box-table)) (scroll-table (ebox-incremental--candidate-scroll-state-table - buffer old-state index (plist-get index :region-box-table))) + buffer old-state index region-box-table)) (old-scroll-state (ebox--scroll-get-state region-id)) (candidate-scroll-state (gethash region-id scroll-table)) (state (copy-sequence old-state))) @@ -2786,6 +3234,7 @@ inside the old prefix, so a line-slide never mixes two layout versions." (buffer region-id runtime transition) "Publish BUFFER scroll TRANSITION for REGION-ID from isolated RUNTIME." (let* ((root (plist-get runtime :root)) + (root-id (and root (plist-get root :node-id))) (base-state (plist-get runtime :base-state)) (table (plist-get runtime :scroll-table)) (state (plist-get transition :state)) @@ -2806,6 +3255,10 @@ inside the old prefix, so a line-slide never mixes two layout versions." (unless (eq base-state (ebox--buffer-render-state buffer)) (error "Ebox runtime changed during scroll update notification")) (let* ((staged-scroll-state (copy-sequence state)) + (scroll-patch-fast-p + (and (ebox--scroll-state-retained-window-ready-p + staged-scroll-state) + t)) (commit-input (let ((ebox--scroll-global-state table)) (ebox-incremental-prepare-scoped-commit @@ -2821,7 +3274,10 @@ inside the old prefix, so a line-slide never mixes two layout versions." :patch-ops '(span-patch) :owner-id owner-id :owner-ids (list owner-id) - :scroll-state-transaction t)) + :scroll-state-transaction t + :scroll-patch-fast-p scroll-patch-fast-p + :native-scroll-materialize-p + (plist-get transition :native-materialize-p))) t))) (_staged-cache (ebox--surface-restore-staged-scroll-cache @@ -2830,9 +3286,23 @@ inside the old prefix, so a line-slide never mixes two layout versions." (or (plist-get commit-input :scope-node-ids) (list owner-id))) (state-overrides - (plist-put - (plist-get commit-input :state-overrides) - :preserve-scroll-producer-region-ids (list region-id))) + (let ((value (plist-get commit-input :state-overrides))) + (setq value + (plist-put + value :preserve-scroll-producer-region-ids + (list region-id))) + (setq value + (plist-put + value :native-buffer-scroll-p + (and (plist-get transition :native-materialize-p) t))) + (setq value + (plist-put + value :retained-scroll-content-p + (and scroll-patch-fast-p root-id owner-id + (= root-id owner-id)))) + (if (plist-get transition :native-materialize-p) + (plist-put value :native-scroll-materialize-p t) + value))) (surface (ebox-surface-update-buffer-scoped buffer @@ -2912,19 +3382,106 @@ inside the old prefix, so a line-slide never mixes two layout versions." (defun ebox--scroll-region-by (region-id delta &optional prefix-budget-lines) "Scroll REGION-ID by DELTA through its runtime using PREFIX-BUDGET-LINES." - (when-let* ((state (and region-id (ebox--scroll-get-state region-id))) - (buffer (ebox--scroll-state-buffer state))) - (unless (ebox-surface-buffer-mounted-p buffer) - (error "Ebox scroll update requires a mounted TP surface")) - (ebox--surface-scroll-region-by - buffer region-id delta prefix-budget-lines))) + (let ((run + (lambda () + (when-let* ((state (and region-id (ebox--scroll-get-state region-id))) + (buffer (ebox--scroll-state-buffer state))) + (unless (ebox-surface-buffer-mounted-p buffer) + (error "Ebox scroll update requires a mounted TP surface")) + (ebox--surface-scroll-region-by + buffer region-id delta prefix-budget-lines))))) + ;; Scroll publication allocates a short-lived candidate text/ownership + ;; plan. Keep GC out of the visible event and let the existing deferred + ;; render-GC lease collect after the interaction burst; batch tests keep + ;; their deterministic threshold and never install a timer. + (let ((native + (when-let* ((state (and region-id + (ebox--scroll-get-state region-id))) + (buffer (ebox--scroll-state-buffer state))) + (ebox--native-buffer-scroll-by buffer region-id delta)))) + (if (not (eq native 'native-unavailable)) + native + (if noninteractive + (funcall run) + (ebox--with-deferred-render-gc + (funcall run))))))) (defun ebox--scroll-progress-p (result) "Return non-nil when RESULT represents consumed or pending scroll work." - (or (memq result '(pending refreshed)) + (or (eq result 'pending) (and (numberp result) (/= result 0)))) +(defun ebox--scroll-intent-create (delta chain) + "Create a signed line scroll intent for inner-to-outer owner CHAIN. +DELTA is the requested document-line distance. The returned plist is the +single allocation record used by keyboard, page, and wheel input." + (unless (and (integerp delta) (/= delta 0)) + (error "Ebox scroll intent delta must be a non-zero integer: %S" delta)) + (list :requested delta + :direction (if (> delta 0) 1 -1) + :chain (delete-dups (copy-sequence chain)) + :index 0 + :remaining delta + :consumption nil + :ebox-consumed 0 + :native-residual 0)) + +(defun ebox--scroll-intent-at-point (delta) + "Create keyboard scroll intent DELTA anchored at current point." + (ebox--scroll-intent-create + delta (ebox--scroll-region-ids-at-point))) + +(defun ebox--scroll-intent-at-event (event delta) + "Create wheel scroll intent DELTA anchored at EVENT position." + (ebox--scroll-intent-create delta (ebox--wheel-region-ids event))) + +(defun ebox--scroll-consumed-delta (requested result) + "Normalize scroll RESULT to actual signed consumption of REQUESTED. +Publication results such as `pending' and `refreshed' moved no lines and +therefore consume nothing. Numeric region results must preserve direction +and cannot exceed the remaining request." + (let ((consumed (if (numberp result) result 0))) + (unless (or (= consumed 0) + (and (= (if (> consumed 0) 1 -1) + (if (> requested 0) 1 -1)) + (<= (abs consumed) (abs requested)))) + (error "Invalid Ebox scroll consumption %S for request %S" + consumed requested)) + consumed)) + +(defun ebox--scroll-consume-intent (intent &optional native-consumer) + "Allocate INTENT from inner owners outward, then to NATIVE-CONSUMER. +Each owner receives only the signed residual left by its child. The returned +intent records the exact invariant REQUESTED = EBOX-CONSUMED + +NATIVE-RESIDUAL; refresh-only publication never consumes user input." + (let ((remaining (plist-get intent :requested)) + (chain (plist-get intent :chain)) + consumption + (index 0)) + (while (and chain (/= remaining 0)) + (let* ((region-id (pop chain)) + (result (ebox--scroll-region-by region-id remaining)) + (consumed (ebox--scroll-consumed-delta remaining result))) + (push (cons region-id consumed) consumption) + (setq remaining (- remaining consumed)) + (setq index (1+ index)))) + ;; Preserve zero-capacity owners in the allocation record. This makes + ;; boundary behavior inspectable and keeps the chain/index contract stable + ;; for a future deferred smooth tick. + (dolist (region-id chain) + (push (cons region-id 0) consumption) + (setq index (1+ index))) + (let ((ebox-consumed (- (plist-get intent :requested) remaining))) + (plist-put intent :index index) + (plist-put intent :remaining remaining) + (plist-put intent :consumption (nreverse consumption)) + (plist-put intent :ebox-consumed ebox-consumed) + (plist-put intent :native-residual remaining) + (when (and native-consumer (/= remaining 0)) + (funcall native-consumer remaining)) + intent))) + (defun ebox--scroll-redisplay-after-tick () "Flush GUI redisplay after an asynchronous scroll tick." (unless noninteractive @@ -3062,10 +3619,18 @@ inside the old prefix, so a line-slide never mixes two layout versions." (t (ebox--smooth-scroll-stop region-id))))))))) -(defun ebox--smooth-scroll-region-by (region-id delta) - "Animate wheel scroll REGION-ID by DELTA lines." +(defun ebox--smooth-scroll-region-by + (region-id delta &optional chain index residual) + "Animate wheel scroll REGION-ID by DELTA lines. +CHAIN, INDEX, and RESIDUAL retain the owner-allocation position when this +animation was admitted because one owner can consume the complete intent." (let* ((existing (gethash region-id ebox--smooth-scroll-state-table)) - (entry (or existing (list :pending 0 :timer nil))) + (entry (or existing + (list :pending 0 :timer nil + :chain (or chain (list region-id)) + :index (or index 0) + :direction (if (> delta 0) 1 -1) + :residual (or residual 0)))) (had-timer (timerp (plist-get entry :timer))) (pending (ebox--smooth-scroll-clamp-pending region-id @@ -3084,6 +3649,10 @@ inside the old prefix, so a line-slide never mixes two layout versions." (ebox--deferred-render-gc-enter)) (ebox--scroll-cancel-idle-prefetch region-id) (plist-put entry :pending pending) + (when chain (plist-put entry :chain chain)) + (when index (plist-put entry :index index)) + (plist-put entry :direction (if (> pending 0) 1 -1)) + (plist-put entry :residual (or residual 0)) (puthash region-id entry ebox--smooth-scroll-state-table) ;; Move the first tick immediately so the UI responds to the initial ;; event. While a timer is already active, new wheel events only update @@ -3106,13 +3675,17 @@ inside the old prefix, so a line-slide never mixes two layout versions." (ebox--smooth-scroll-stop region-id))) (defun ebox--scroll-by (delta fallback) - "Scroll box content by DELTA lines. Positive = down, negative = up. + "Scroll box content by DELTA lines. Positive = down, negative = up. FALLBACK is the Emacs scroll command to call when ebox cannot scroll." - (if (ebox--scroll-first-region-by - (ebox--scroll-region-ids-at-point) - delta) - t - (funcall fallback 1))) + (let ((native (ebox--native-buffer-scroll-at-point delta))) + (if (not (memq native '(native-not-applicable native-unavailable))) + (if (and (numberp native) (= native 0)) + (funcall fallback (abs delta)) + native) + (ebox--scroll-consume-intent + (ebox--scroll-intent-at-point delta) + (lambda (residual) + (funcall fallback (abs residual))))))) (defun ebox--scroll-page-lines (&optional arg) "Return the number of content lines to move for a page scroll ARG." @@ -3144,20 +3717,68 @@ FALLBACK is the Emacs scroll command to call when ebox cannot scroll." "Return the innermost ebox region id under mouse wheel EVENT, or nil." (car (ebox--wheel-region-ids event))) +(defun ebox--scroll-region-can-consume-complete-p (region-id delta) + "Return non-nil when REGION-ID can consume all signed DELTA now." + (when-let ((state (and region-id (ebox--scroll-get-state region-id)))) + (let* ((offset (or (plist-get state :scroll-offset) 0)) + (height (or (plist-get state :content-height) 0)) + (maximum (max 0 (- (length (plist-get state :content-lines)) + height))) + (available (if (> delta 0) (- maximum offset) offset))) + ;; An incomplete lazy prefix is not proof of total capacity. Route that + ;; case through the synchronous chain allocator so any clamped movement + ;; leaves an exact residual for the parent or native buffer. + (>= available (abs delta))))) + +(defun ebox--wheel-native-residual (event residual requested arg) + "Send wheel RESIDUAL to ordinary buffer scrolling for EVENT. +When no ebox owner consumed REQUESTED, preserve Emacs' native wheel command. +For a partial residual, scroll its exact signed line count so the original +wheel event is not applied twice." + (if (= residual requested) + (mwheel-scroll event arg) + (when-let* ((start (ignore-errors (event-start event))) + (window (posn-window start)) + ((window-live-p window))) + (with-selected-window window + (condition-case nil + (if (> residual 0) + (scroll-up residual) + (scroll-down (- residual))) + ((beginning-of-buffer end-of-buffer) nil)))))) + (defun ebox--wheel-scroll (event delta &optional arg smooth) "Scroll an ebox region under EVENT by DELTA, or delegate to `mwheel-scroll'. When SMOOTH is non-nil, animate the scroll over short line steps." - (let* ((region-ids (ebox--wheel-region-ids event)) - (region-id (and smooth - ebox-wheel-smooth-scroll - (ebox--first-scrollable-region region-ids delta)))) - (cond - (region-id - (ebox--smooth-scroll-region-by region-id delta)) - ((ebox--scroll-first-region-by region-ids delta) - t) - (t - (mwheel-scroll event arg))))) + (let ((native + (and (not (and smooth ebox-wheel-smooth-scroll)) + (ebox--native-buffer-scroll-at-event event delta)))) + (if (and native + (not (memq native '(native-not-applicable native-unavailable)))) + (if (and (numberp native) (= native 0)) + (ebox--wheel-native-residual event delta delta arg) + native) + (let* ((intent (ebox--scroll-intent-at-event event delta)) + (region-ids (plist-get intent :chain)) + (region-id (and smooth + ebox-wheel-smooth-scroll + (ebox--first-scrollable-region + region-ids delta))) + (smooth-index (and region-id (cl-position region-id region-ids + :test #'equal)))) + ;; Smooth animation is admitted only when one owner can consume the + ;; whole intent. Boundary-crossing input takes the synchronous chain + ;; allocator, preserving residual distance instead of dropping it in + ;; a region timer. + (if (and region-id + (ebox--scroll-region-can-consume-complete-p + region-id delta)) + (ebox--smooth-scroll-region-by + region-id delta region-ids smooth-index 0) + (ebox--scroll-consume-intent + intent + (lambda (residual) + (ebox--wheel-native-residual event residual delta arg)))))))) (defun ebox-wheel-scroll-down (event &optional arg) "Handle mouse wheel down EVENT in an ebox buffer. @@ -3195,8 +3816,8 @@ With prefix ARG, scroll by that many content lines." (let ((delta (ebox--scroll-page-lines arg))) (ebox--scroll-by delta - (lambda (&optional _n) - (scroll-up-command arg))))) + (lambda (n) + (scroll-up-command n))))) ;;;###autoload (defun ebox-scroll-page-up (&optional arg) @@ -3206,8 +3827,8 @@ With prefix ARG, scroll by that many content lines." (let ((delta (- (ebox--scroll-page-lines arg)))) (ebox--scroll-by delta - (lambda (&optional _n) - (scroll-down-command arg))))) + (lambda (n) + (scroll-down-command n))))) (defun ebox--region-id-at-pos (pos) "Return the owning ebox region-id at POS, if any." @@ -3307,7 +3928,12 @@ Defaults to the current buffer." (defun ebox--schedule-runtime-prewarm-after-batch-flush (buffer _pending _report) "Schedule shared runtime prewarming after BUFFER's batch flush." - (ebox--schedule-buffer-runtime-prewarm buffer)) + (unless ebox--native-scroll-prewarm-in-progress + ;; The update already published its one allowed candidate. Warm only + ;; retained indexes here; native materialization belongs to the initial + ;; display/visible-window handoff and would otherwise add a second + ;; publication before the next input. + (ebox--schedule-buffer-runtime-prewarm buffer nil t))) (add-hook 'ebox-incremental--after-successful-batch-flush-hook #'ebox--schedule-runtime-prewarm-after-batch-flush t) @@ -3734,7 +4360,7 @@ NODE can be any box/concat/stack node created by `ebox-create', (add-hook 'kill-buffer-hook #'ebox--cleanup-current-buffer nil t) (ebox-buffer-mode 1) (read-only-mode 1) - (ebox--schedule-buffer-runtime-prewarm buffer) + (ebox--schedule-buffer-runtime-prewarm buffer nil nil) buffer)))) (defun ebox--host-ref-buffer (buffer-or-name) @@ -3796,6 +4422,45 @@ See `ebox-host-ref-bounds' for lookup and lifetime semantics." buffer-or-name)) (ebox-incremental-candidate-begin buffer))) +;;;###autoload +(defun ebox-range-ref-present-p (buffer-or-name range-ref) + "Return non-nil when RANGE-REF is a live mounted address in BUFFER-OR-NAME. + +This is a read-only boundary query for framework integrations. It does not +create a candidate or expose Ebox's runtime tables; a caller should fall back +to its wider owner when a semantic Range has no corresponding published +address." + (when-let* ((buffer (get-buffer buffer-or-name)) + (state (ebox--buffer-render-state buffer)) + (table (plist-get state :range-ref-table))) + (and (hash-table-p table) + (gethash range-ref table)))) + +;;;###autoload +(defun ebox-child-range (range-ref &rest items) + "Return an owned child Range descriptor for non-nil RANGE-REF and ITEMS. +ITEMS are declarative nodes. Child Range descriptors cannot be nested." + (unless range-ref (error "Ebox child Range ref must be non-nil")) + (dolist (item items) + (unless (and (listp item) (not (stringp item))) + (error "Ebox child Range item must be a declarative node")) + (cl-labels ((reject-range + (node) + (when (ebox-child-range--descriptor-p node) + (error "Ebox child Range descriptors cannot be nested")) + (when (and (listp node) (not (stringp node))) + (dolist (child (ebox-tree--children-raw node)) + (reject-range child))))) + (reject-range item))) + (ebox-tree-validate-declarative-root + (list :ebox-type 'stack :display '(block column) :children items)) + (ebox-child-range--descriptor-create + range-ref + (mapcar (lambda (item) + (ebox-tree-clear-runtime-identities + (ebox-tree-copy-node-structure item))) + items))) + ;;;###autoload (defun ebox-candidate-replace (candidate node-id next-subtree @@ -3820,7 +4485,21 @@ Return CANDIDATE." candidate host-ref next-subtree old-semantic-key new-semantic-key)) ;;;###autoload -(defun ebox-commit (buffer-or-name next-root &optional after-publication) +(defun ebox-candidate-replace-range-ref (candidate range-ref next-items) + "Replace base child RANGE-REF in CANDIDATE with proper node NEXT-ITEMS." + (ebox-incremental-candidate-replace-range-ref + candidate range-ref next-items)) + +;;;###autoload +(defun ebox-candidate-replace-root (candidate next-root) + "Replace CANDIDATE's exact implicit root with declarative NEXT-ROOT. +The root address is private, base-bound, and cannot collide with host refs. +Repeated calls are last-wins and absorb all descendant candidate operations." + (ebox-incremental-candidate-replace-root candidate next-root)) + +;;;###autoload +(defun ebox-commit + (buffer-or-name next-root &optional framework-publish framework-rollback) "Atomically commit declarative NEXT-ROOT into BUFFER-OR-NAME. NEXT-ROOT may be a newly built Ebox node tree or a one-shot logical candidate @@ -3832,14 +4511,20 @@ prove rendered owners in isolation, and publish only property-aware buffer differences. Validation, render, and publication failures leave the current buffer and runtime unchanged. -When AFTER-PUBLICATION is non-nil, it must be a function of one update report. +When FRAMEWORK-PUBLISH is non-nil, it must be a function of one update report. Ebox invokes it inside the quit-free atomic publication boundary after the buffer and runtime agree. This hook is for framework pointer promotion only; it must not run application code. An error rolls the Ebox publication back. +FRAMEWORK-ROLLBACK, when supplied, receives the same report if publication or +a later transaction phase fails, and is contained if it violates no-throw. Return the successful publication report stored by `ebox-buffer-update-report'." - (unless (or (null after-publication) (functionp after-publication)) - (signal 'wrong-type-argument (list 'functionp after-publication))) + (unless (or (null framework-publish) (functionp framework-publish)) + (signal 'wrong-type-argument (list 'functionp framework-publish))) + (unless (or (null framework-rollback) (functionp framework-rollback)) + (signal 'wrong-type-argument (list 'functionp framework-rollback))) + (when (and framework-rollback (null framework-publish)) + (error "Ebox framework rollback requires framework publish")) (let ((buffer (get-buffer buffer-or-name))) (unless (buffer-live-p buffer) (error "Ebox declarative commit requires an existing live buffer: %S" @@ -3850,9 +4535,13 @@ Return the successful publication report stored by `ebox-buffer-update-report'." (ebox-incremental-prepare-root-commit buffer next-root))) (source (plist-get commit-input :root)) (callback - (or after-publication + (or framework-publish ebox-incremental--after-declarative-publication)) - (surface + (participant + (ebox-surface--make-framework-participant + :publish callback :rollback framework-rollback + :state 'unpublished :diagnostics nil)) + (_surface (if-let ((scope-node-ids (plist-get commit-input :scope-node-ids))) (ebox-surface-update-buffer-scoped @@ -3861,14 +4550,15 @@ Return the successful publication report stored by `ebox-buffer-update-report'." (plist-get commit-input :state-overrides) callback nil nil (plist-get commit-input :projection-kind) - t) + t participant) (ebox-surface-mount-buffer buffer source (plist-get commit-input :report-base) callback (plist-get commit-input :preserve-identities-p) - (plist-get commit-input :state-overrides))))) - (plist-get (tp-surface-client-state surface) :last-update-report)))) + (plist-get commit-input :state-overrides) + participant)))) + (ebox-surface--framework-participant-report participant)))) ;;;###autoload (defun ebox-rerender-buffer-with-context @@ -3887,7 +4577,7 @@ through dirty-set and patch-set execution before falling back to root rerender." (prog1 (ebox-surface-update-buffer-viewport buffer viewport-width viewport-height) - (ebox--schedule-buffer-runtime-prewarm buffer) + (ebox--schedule-buffer-runtime-prewarm buffer nil t) (ebox--schedule-buffer-reflow-cache-prewarm buffer old-viewport-width viewport-width)))) @@ -3913,7 +4603,10 @@ through dirty-set and patch-set execution before falling back to root rerender." ebox-build ebox-byte-compile ebox-candidate-begin + ebox-child-range ebox-candidate-replace + ebox-candidate-replace-range-ref + ebox-candidate-replace-root ebox-candidate-replace-host-ref ebox-clear-cache ebox-column diff --git a/tests/ebox-child-range-tests.el b/tests/ebox-child-range-tests.el new file mode 100644 index 0000000..62b0f19 --- /dev/null +++ b/tests/ebox-child-range-tests.el @@ -0,0 +1,1007 @@ +;;; ebox-child-range-tests.el --- Persistent child sequence tests -*- lexical-binding: t; -*- + +(require 'ert) +(require 'ebox-child-range) +(require 'ebox) + +(defconst ebox-child-range-test--root + (expand-file-name ".." (file-name-directory (or load-file-name buffer-file-name))) + "Ebox repository root for source audits.") + +(defun ebox-child-range-test--item (key) + "Return one declarative test item for KEY." + (list :key key :value key)) + +(defun ebox-child-range-test--fixture (static-count range-items &optional hash) + "Build STATIC-COUNT static segments followed by RANGE-ITEMS." + (ebox-child-range--build + (append + (cl-loop for index below static-count + collect (cons nil (list (ebox-child-range-test--item + (list 'static index))))) + (list (cons 'range + (mapcar #'ebox-child-range-test--item range-items)))) + hash)) + +(ert-deftest ebox-child-range-gate-a-exact-segment-and-payload-costs () + "Point replacement cost follows trie height, never parent child count." + (dolist (case '((0 0 1) (10 1 2) (100 2 3) (500 2 3))) + (pcase-let* ((`(,static-count ,height ,bound) case) + (old (ebox-child-range-test--fixture static-count '(old))) + (old-flat (ebox-child-range--flatten old)) + (result (ebox-child-range--replace + old 'range + (mapcar #'ebox-child-range-test--item + '(new-a new-b)))) + (new (car result)) + (metrics (cdr result))) + (should (= (ebox-child-range--sequence-count old) (1+ static-count))) + (should (= (ebox-child-range--sequence-height old) height)) + (should (= (ebox-child-range--segment-node-segment-count + (ebox-child-range--sequence-root old)) + (1+ static-count))) + (should (= (ebox-child-range--segment-node-weight + (ebox-child-range--sequence-root old)) + (1+ static-count))) + (should (= (ebox-child-range--prefix-weight old static-count) + static-count)) + (should (= (ebox-child-range--rank old static-count) static-count)) + (pcase-let ((`(,nodes . ,edges) + (ebox-child-range--segment-memory old))) + (should (<= nodes (1+ (* (1+ static-count) (1+ height))))) + (should (= edges (1- nodes)))) + (pcase-let ((`(,vectors . ,slots) + (ebox-child-range--segment-vector-memory old))) + (should (= slots (* vectors 32))) + (should (<= vectors (1+ (ceiling (/ (float (1+ static-count)) 32)))))) + (should (<= (ebox-child-range--metrics-segment-visits metrics) bound)) + (should (<= (ebox-child-range--metrics-segment-copies metrics) bound)) + (should (= (ebox-child-range--metrics-old-affected-payload-visits metrics) + 1)) + (should (= (ebox-child-range--metrics-new-payload-visits metrics) 2)) + (should (= (ebox-child-range--metrics-new-payload-validations metrics) 2)) + (should (= (ebox-child-range--metrics-new-payload-copies metrics) 2)) + (should (= (ebox-child-range--segment-node-weight + (ebox-child-range--sequence-root new)) + (+ static-count 2))) + (should (= (ebox-child-range--rank new static-count) static-count)) + (should (= (ebox-child-range--metrics-ref-index-visits metrics) 1)) + (should (= (ebox-child-range--metrics-ref-index-copies metrics) 0)) + (dolist (accessor + '(ebox-child-range--metrics-unaffected-payload-visits + ebox-child-range--metrics-unaffected-payload-validations + ebox-child-range--metrics-unaffected-payload-copies)) + (should (zerop (funcall accessor metrics)))) + (should (equal (ebox-child-range--flatten old) old-flat)) + (should (equal (mapcar (lambda (item) (plist-get item :key)) + (ebox-child-range--flatten new)) + (append + (cl-loop for index below static-count + collect (list 'static index)) + '(new-a new-b))))))) + +(ert-deftest ebox-child-range-gate-a-key-bound-collisions-and-sharing () + "Sparse hash work is bounded and unaffected segment branches remain shared." + (let* ((old (ebox-child-range-test--fixture 100 '(old-a old-b) + (lambda (_key) 0))) + (result (ebox-child-range--replace + old 'range + (mapcar #'ebox-child-range-test--item + '(new-a new-b new-c)))) + (new (car result)) + (metrics (cdr result)) + (affected 2) (replacement 3) + (old-key-root (ebox-child-range--sequence-key-root old)) + (old-first (aref (ebox-child-range--segment-node-children + (ebox-child-range--sequence-root old)) 0)) + (new-first (aref (ebox-child-range--segment-node-children + (ebox-child-range--sequence-root new)) 0))) + (should (= (ebox-child-range--metrics-key-visits metrics) 35)) + (should (= (ebox-child-range--metrics-key-copies metrics) 35)) + (should (= (ebox-child-range--metrics-collision-visits metrics) 506)) + (should (= (ebox-child-range--metrics-collision-copies metrics) 506)) + (should (= (+ (ebox-child-range--metrics-key-visits metrics) + (ebox-child-range--metrics-collision-visits metrics)) + (+ 35 506))) + (should (= (+ (ebox-child-range--metrics-key-copies metrics) + (ebox-child-range--metrics-collision-copies metrics)) + (+ 35 506))) + (should (<= (+ (ebox-child-range--metrics-key-visits metrics) + (ebox-child-range--metrics-collision-visits metrics)) + (+ (* (+ affected replacement) 7) 506))) + (should (<= (+ (ebox-child-range--metrics-key-copies metrics) + (ebox-child-range--metrics-collision-copies metrics)) + (+ (* (+ affected replacement) 7) 506))) + (should (<= (ebox-child-range--metrics-key-visits metrics) + (+ (* (+ affected replacement) 7) 506))) + (should (<= (ebox-child-range--metrics-key-copies metrics) + (+ (* (+ affected replacement) 7) 506))) + (should (eq old-first new-first)) + (should (eq (ebox-child-range--sequence-ref-index old) + (ebox-child-range--sequence-ref-index new))) + (should (eq (ebox-child-range--sequence-key-root old) old-key-root)) + (should (equal (ebox-child-range--hash-lookup + (ebox-child-range--sequence-key-root new) 'new-b 0) + '(100 . 1))) + (should-not (ebox-child-range--hash-lookup + (ebox-child-range--sequence-key-root new) 'old-a 0)) + (should (ebox-child-range--hash-lookup old-key-root 'old-a 0)) + (pcase-let ((`(,nodes . ,edges) + (ebox-child-range--hash-memory + (ebox-child-range--sequence-key-root old)))) + (should (<= nodes (1+ (* 7 102)))) + (should (= edges (1- nodes)))))) + +(ert-deftest ebox-child-range-gate-a-empty-order-and-duplicates () + "Empty ranges stay addressable and global ref/key uniqueness is exact." + (let* ((empty (ebox-child-range-test--fixture 1 nil)) + (one (car (ebox-child-range--replace + empty 'range (list (ebox-child-range-test--item 'one))))) + (many (car (ebox-child-range--replace + one 'range + (mapcar #'ebox-child-range-test--item '(two three))))) + (empty-again (car (ebox-child-range--replace many 'range nil)))) + (should (= (length (ebox-child-range--segment-payload + (ebox-child-range--segment-at empty 1))) 0)) + (should (equal (mapcar (lambda (item) (plist-get item :key)) + (ebox-child-range--flatten many)) + '((static 0) two three))) + (should-not (cdr (ebox-child-range--flatten empty-again))) + (should-error + (ebox-child-range--build + (list (cons 'same nil) (cons 'same nil)))) + (should-error (ebox-child-range--build (list (cons nil nil)))) + (should-error (ebox-child-range--build nil)) + (should-error + (ebox-child-range--build + (list (cons nil (list (ebox-child-range-test--item 'a) + (ebox-child-range-test--item 'b)))))) + (should-error + (ebox-child-range--build + (list (cons nil (list (ebox-child-range-test--item 'duplicate))) + (cons 'range (list (ebox-child-range-test--item 'duplicate)))))) + (should-error + (ebox-child-range--build + (list (cons 'left (list (ebox-child-range-test--item 'duplicate))) + (cons 'right (list (ebox-child-range-test--item 'duplicate)))))) + (should-error + (ebox-child-range--replace + empty 'range + (list (ebox-child-range--descriptor-create 'nested nil)))) + (should-error (ebox-child-range--descriptor-create nil nil)) + (should-error (ebox-child-range--descriptor-create 'bad '(one . two))) + (should-error (ebox-child-range--replace empty 'range '(one . two))) + (should-error + (ebox-child-range--build (list (cons 'bad '(one . two))))) + (should-error (ebox-child-range--replace empty 'missing nil)))) + +(ert-deftest ebox-child-range-gate-a-adjacent-refs-and-unkeyed-items () + "First, middle, and last Range refs stay O(1)-addressed and accept no key." + (let* ((segments + (list + (cons 'first (list (list :value 'unkeyed-first))) + (cons nil (list (ebox-child-range-test--item 'static-a))) + (cons 'middle (list (ebox-child-range-test--item 'middle-old))) + (cons 'adjacent (list (ebox-child-range-test--item 'adjacent))) + (cons nil (list (list :value 'unkeyed-static))) + (cons 'last nil))) + (base (ebox-child-range--build segments))) + (dolist (entry '((first first-new) (middle middle-new) (last last-new))) + (let* ((result + (ebox-child-range--replace + base (car entry) + (list (ebox-child-range-test--item (cadr entry))))) + (new (car result)) + (metrics (cdr result))) + (should (= (ebox-child-range--metrics-ref-index-visits metrics) 1)) + (should (= (ebox-child-range--metrics-ref-index-copies metrics) 0)) + (should (eq (ebox-child-range--sequence-ref-index base) + (ebox-child-range--sequence-ref-index new))) + (should (equal + (ebox-child-range--hash-lookup + (ebox-child-range--sequence-key-root new) + (cadr entry) + (ebox-child-range--stable-hash (cadr entry))) + (cons (gethash (car entry) + (ebox-child-range--sequence-ref-index base)) + 0))))) + (should (equal (plist-get (car (ebox-child-range--flatten base)) :value) + 'unkeyed-first)) + (should (eq (ebox-child-range--segment-ref + (ebox-child-range--lookup-ref base 'middle)) + 'middle)))) + +(ert-deftest ebox-child-range-integration-is-transparent-and-indexed () + "Compiled Range segments render as direct children and retain empty refs." + (let* ((static (ebox-create :key 'a :class "a" :content "A" :width '(40))) + (one (ebox-create :key 'b :class "b" :content "B" :width '(40))) + (two (ebox-create :key 'c :class "c" :content "C" :width '(40))) + (descriptor (ebox-child-range--descriptor-create 'items (list one two))) + (empty (ebox-child-range--descriptor-create 'empty nil)) + (raw-items (ebox-child-range--descriptor-items descriptor)) + (ranged (ebox-column static empty descriptor)) + (direct (ebox-column + (ebox-create :key 'a :class "a" :content "A" :width '(40)) + (ebox-create :key 'b :class "b" :content "B" :width '(40)) + (ebox-create :key 'c :class "c" :content "C" :width '(40)))) + (left (generate-new-buffer " *ebox-range-direct*")) + (right (generate-new-buffer " *ebox-range-compiled*"))) + (unwind-protect + (progn + (ebox-render-to-buffer left direct) + (ebox-render-to-buffer right ranged) + (should (equal + (with-current-buffer left + (substring-no-properties (buffer-string))) + (with-current-buffer right + (substring-no-properties (buffer-string))))) + (should (equal + (mapcar #'ebox-string-pixel-width + (ebox-string-lines + (with-current-buffer left (buffer-string)))) + (mapcar #'ebox-string-pixel-width + (ebox-string-lines + (with-current-buffer right (buffer-string)))))) + (should (eq raw-items (ebox-child-range--descriptor-items descriptor))) + (should (equal (mapcar (lambda (node) (plist-get node :key)) raw-items) + '(b c))) + (let* ((direct-state (ebox--buffer-render-state left)) + (state (ebox--buffer-render-state right)) + (range-table (plist-get state :range-ref-table)) + (empty-record (gethash 'empty range-table)) + (items-record (gethash 'items range-table)) + (empty-resolved + (ebox-incremental--range-ref-resolve state 'empty)) + (items-resolved + (ebox-incremental--range-ref-resolve state 'items))) + (should empty-record) + (should items-record) + (should-not (plist-member empty-record :rank)) + (should-not (plist-member empty-record :sequence)) + (should (= (plist-get empty-resolved :rank) 1)) + (should (= (plist-get items-resolved :rank) 1)) + (should (= (hash-table-count (plist-get state :node-table)) + (hash-table-count (plist-get direct-state :node-table)))) + (should (= (hash-table-count (plist-get state :region-id-set)) + (hash-table-count + (plist-get direct-state :region-id-set)))) + (should (= (hash-table-count + (plist-get state :surface-node-object-table)) + (hash-table-count + (plist-get direct-state :surface-node-object-table)))) + (should (equal (plist-get empty-record :parent-node-id) + (plist-get (plist-get state :root-node) :node-id)))) + (should (= (length (ebox-selector-query-buffer right ".a + .b")) 1)) + (should (= (length (ebox-selector-query-buffer right ".a ~ .c")) 1))) + (dolist (buffer (list left right)) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-child-range-integration-rejects-invalid-placement-atomically () + "Range refs, keys, nesting, roots, and scalar slots fail before publication." + (let ((buffer (generate-new-buffer " *ebox-range-invalid*"))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer (ebox-create :key 'root :content "old")) + (let ((before (with-current-buffer buffer (buffer-string))) + (state (ebox--buffer-render-state buffer))) + (dolist + (root + (list + (ebox-child-range--descriptor-create + 'root (list (ebox-create :key 'x :content "x"))) + (list :ebox-type 'box + :ebox-content-node + (ebox-child-range--descriptor-create 'scalar nil)) + (ebox-column + (ebox-child-range--descriptor-create + 'outer + (list (ebox-child-range--descriptor-create 'nested nil)))) + (ebox-column + (ebox-child-range--descriptor-create 'same nil) + (ebox-column + (ebox-child-range--descriptor-create 'same nil))) + (ebox-column + (ebox-create :key 'duplicate :content "a") + (ebox-child-range--descriptor-create + 'range (list (ebox-create :key 'duplicate :content "b")))))) + (should-error (ebox-commit buffer root)) + (should (eq (ebox--buffer-render-state buffer) state)) + (should (equal (with-current-buffer buffer (buffer-string)) + before))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-production-readers-use-tree-accessor () + "Range-capable production consumers do not read node `:children' directly." + (dolist (file '("ebox.el" "ebox-layout.el" "ebox-flex.el" "ebox-grid.el" + "ebox-incremental.el" "ebox-native-reflow.el" + "ebox-surface.el")) + (with-temp-buffer + (insert-file-contents + (expand-file-name file ebox-child-range-test--root)) + (should-not (re-search-forward + "plist-get[[:space:]\n]+\\(?:node\\|flex-node\\)[[:space:]\n]+:children" + nil t))))) + +(ert-deftest ebox-child-range-ecss-subjects-and-inheritance-are-transparent () + "Ranges add no ECSS subject and preserve child/sibling cascade semantics." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (direct-left + (ebox-create :key 'left :host-ref 'left :class "left" + :content "L" :width '(40))) + (direct-right + (ebox-create :key 'right :host-ref 'right :class "right" + :content "R" :width '(40))) + (range-left + (ebox-create :key 'left :host-ref 'left :class "left" + :content "L" :width '(40))) + (range-right + (ebox-create :key 'right :host-ref 'right :class "right" + :content "R" :width '(40))) + (left-range + (ebox-child-range--descriptor-create 'left-range (list range-left))) + (right-range + (ebox-child-range--descriptor-create 'right-range (list range-right))) + (direct (plist-put (ebox-column direct-left direct-right) + :class "parent")) + (ranged (plist-put (ebox-column left-range right-range) + :class "parent")) + (direct-buffer (generate-new-buffer " *ebox-range-ecss-direct*")) + (range-buffer (generate-new-buffer " *ebox-range-ecss-range*")) + (original (symbol-function 'ebox-style-compute-subject)) + direct-subjects range-subjects) + (ebox-style-add-rule ".parent > .left" '(:color "#123456")) + (ebox-style-add-rule ".left + .right" '(:background-color "#ABCDEF")) + (unwind-protect + (progn + (cl-letf (((symbol-function 'ebox-style-compute-subject) + (lambda (&rest arguments) + (cl-incf direct-subjects) + (apply original arguments)))) + (setq direct-subjects 0) + (ebox-render-to-buffer direct-buffer direct)) + (cl-letf (((symbol-function 'ebox-style-compute-subject) + (lambda (&rest arguments) + (cl-incf range-subjects) + (apply original arguments)))) + (setq range-subjects 0) + (ebox-render-to-buffer range-buffer ranged)) + (should (= direct-subjects range-subjects)) + (should (= (length (ebox-selector-query-buffer + range-buffer ".left + .right")) 1)) + (let ((direct-faces + (with-current-buffer direct-buffer + (cl-loop for position from (point-min) below (point-max) + collect (get-text-property position 'face)))) + (range-faces + (with-current-buffer range-buffer + (cl-loop for position from (point-min) below (point-max) + collect (get-text-property position 'face))))) + (should (equal direct-faces range-faces))) + (dolist (node (list range-left range-right)) + (should-not (plist-get node :node-id)) + (should-not (plist-get node :region-id)) + (should-not (plist-get node :surface-object))) + (dolist (ref '(left right)) + (let* ((state (ebox--buffer-render-state range-buffer)) + (node-id (gethash ref (plist-get state :host-ref-table))) + (node (gethash node-id (plist-get state :node-table)))) + (should node-id) + (should (equal (plist-get node :key) ref))))) + (dolist (buffer (list direct-buffer range-buffer)) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-child-range-path-copy-replaces-compiled-material-child () + "Tree path copying cannot ignore a child stored in a compiled sequence." + (let* ((source + (ebox-column + (ebox-create :key 'static :content "static") + (ebox-child-range--descriptor-create + 'items (list (ebox-create :key 'old :content "old"))))) + (compiled (ebox-tree-copy-node-structure source)) + (old-child (cadr (ebox-tree-layout-children compiled))) + (new-child (ebox-create :key 'new :content "new")) + (unchanged (ebox-tree-copy-with-direct-child-replacements compiled nil)) + (copy (ebox-tree-copy-with-direct-child-replacements + compiled (list (cons old-child new-child))))) + (should (eq (plist-get unchanged :ebox-child-sequence) + (plist-get compiled :ebox-child-sequence))) + (should (equal (mapcar (lambda (node) (plist-get node :key)) + (ebox-tree-layout-children copy)) + '(static new))) + (should (equal (mapcar (lambda (node) (plist-get node :key)) + (ebox-tree-layout-children compiled)) + '(static old))))) + +(ert-deftest ebox-child-range-empty-sequence-is-authoritative () + "An all-empty sequence cannot fall through to legacy alias children." + (let* ((sequence (ebox-child-range--build (list (cons 'empty nil)))) + (legacy (ebox-create :key 'legacy :content "legacy")) + (node (list :ebox-type 'stack :ebox-child-sequence sequence + :top legacy :bottom legacy))) + (should-not (ebox-tree-layout-children node)))) + +(ert-deftest ebox-child-range-validator-covers-wrapper-and-scalar-slots () + "Flat Range compilation cannot hide wrappers or admit scalar descriptors." + (let* ((wrapper (ebox-create :key 'wrapper :host-ref 'wrapper :content "W")) + (item (ebox-create :key 'item :host-ref 'item :content "I")) + (descriptor (ebox-child-range--descriptor-create 'items (list item))) + (source (list :ebox-type 'flex :display '(block flex) + :box wrapper :children (list descriptor)))) + (ebox-tree-validate-declarative-root source) + (let* ((copy (ebox-tree-copy-node-structure source)) + (copy-wrapper (plist-get copy :box)) + (copy-item (car (ebox-tree-layout-children copy)))) + (should-not (eq wrapper copy-wrapper)) + (should-not (eq item copy-item)) + (dolist (node (list wrapper item)) + (should-not (plist-get node :node-id)) + (should-not (plist-get node :region-id)) + (should-not (plist-get node :surface-object)))) + (should-error + (ebox-tree-validate-declarative-root + (list :ebox-type 'stack :display '(block column) + :top (ebox-child-range--descriptor-create 'bad nil) + :bottom (ebox-create :key 'bottom :content "B")))) + (should-error + (ebox-tree-validate-declarative-root + (list :ebox-type 'flex :display '(block flex) + :box (ebox-create :key 'same :host-ref 'same :content "W") + :children + (list (ebox-child-range--descriptor-create + 'items + (list (ebox-create :key 'item :host-ref 'same + :content "I"))))))))) + +(ert-deftest ebox-child-range-public-candidate-splices-and-reports () + "Public child Ranges support empty and repeated last-wins candidate splices." + (let* ((buffer (generate-new-buffer " *ebox-public-range*")) + (source + (ebox-column + (ebox-create :key 'static :content "S") + (ebox-child-range 'items))) + report) + (unwind-protect + (progn + (ebox-render-to-buffer buffer source) + (dolist (items + (list + (list (ebox-create :key 'one :content "1")) + (list (ebox-create :key 'two :content "2") + (ebox-create :key 'three :content "3")) + (list (ebox-create :key 'final :content "F")) + nil)) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref candidate 'items items) + (when items + (ebox-candidate-replace-range-ref candidate 'items items)) + (setq report (ebox-commit buffer candidate)) + (should (plist-get report :range-metrics)))) + (should (gethash 'items + (plist-get (ebox--buffer-render-state buffer) + :range-ref-table)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-sole-child-keeps-public-layout-parent () + "Keep row/column material parents for one empty or populated Range." + (dolist (constructor '(ebox-row ebox-column)) + (dolist (items (list nil (list (ebox-create :key 'one :content "1")))) + (let* ((range (apply #'ebox-child-range 'items items)) + (parent (funcall constructor range))) + (should-not (ebox-child-range--descriptor-p parent)) + (should (eq (plist-get parent :ebox-type) + (if (eq constructor 'ebox-row) 'concat 'stack))) + (should (equal (plist-get parent :children) (list range))) + (should (stringp (ebox-render parent))))))) + +(ert-deftest ebox-child-range-dsl-layout-child-keeps-props-wrapper () + "Pass a Range through row/column DSL children while retaining properties." + (dolist (tag '(row column)) + (let* ((range (ebox-child-range 'items)) + (node (ebox-build (list tag :color "red" range)))) + (should (equal "red" (plist-get node :color))) + (should (not (ebox-child-range--descriptor-p node))) + (should-error (ebox-build range))))) + +(ert-deftest ebox-child-range-empty-owner-falls-back-atomically () + "Publish empty sole Range through full surface fallback and rollback safely." + (let ((buffer (generate-new-buffer " *ebox-empty-range-owner*"))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer + (ebox-column (ebox-child-range 'items))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'items (list (ebox-create :key 'one :content "1"))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) (error "injected empty accept")))) + (should-error (ebox-commit buffer candidate) :type 'error))) + (should (equal "" (with-current-buffer buffer (buffer-string)))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'items (list (ebox-create :key 'one :content "1"))) + (let ((report (ebox-commit buffer candidate))) + (should (plist-get report :empty-range-owner-fallback)))) + (should (string-match-p "1" (with-current-buffer buffer + (buffer-string)))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref candidate 'items nil) + (ebox-commit buffer candidate)) + (should (equal "" (with-current-buffer buffer (buffer-string))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-candidate-derivation-never-flattens-parent () + "Range logical-root and local-index derivation never flatten parent payloads." + (let* ((buffer (generate-new-buffer " *ebox-range-no-flatten*")) + (static + (cl-loop for index below 100 + collect (ebox-create :key (list 'static index) + :content (number-to-string index)))) + (root (apply #'ebox-column + (append static + (list (ebox-child-range + 'items + (ebox-create :key 'old :content "old")))))) + candidate logical trace deltas) + (unwind-protect + (progn + (ebox-render-to-buffer buffer root) + (setq candidate (ebox-candidate-begin buffer)) + (ebox-candidate-replace-range-ref + candidate 'items (list (ebox-create :key 'new :content "new"))) + (setq trace (make-hash-table :test 'equal)) + (cl-letf (((symbol-function 'ebox-child-range--flatten) + (lambda (&rest _) (error "candidate flattened Range")))) + (let ((ebox-incremental--candidate-path-copy-trace trace) + (ebox-incremental--candidate-range-index-deltas nil)) + (setq logical + (ebox-incremental--candidate-logical-root candidate nil) + deltas ebox-incremental--candidate-range-index-deltas)) + (ebox-incremental--candidate-local-index-delta + (ebox-candidate--base-state candidate) logical trace deltas)) + (let ((metrics (car (ebox-candidate--range-metrics candidate)))) + (should (= (plist-get metrics :segment-visits) 3)) + (should (= (plist-get metrics :unaffected-payload-visits) 0)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-adjacent-key-move-is-two-phase () + "A key can move between adjacent Ranges in one logical candidate." + (let ((buffer (generate-new-buffer " *ebox-range-key-move*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-child-range 'left (ebox-create :key 'move :content "L")) + (ebox-child-range 'right (ebox-create :key 'stay :content "R")))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref candidate 'left nil) + (ebox-candidate-replace-range-ref + candidate 'right + (list (ebox-create :key 'move :content "M") + (ebox-create :key 'stay :content "R"))) + (ebox-commit buffer candidate)) + (should (string-match-p "M" (with-current-buffer buffer + (buffer-string))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-public-gate-a-and-prepared-index () + "Public Range commits retain logarithmic metrics and a prepared local index." + (dolist (static-count '(10 100 500)) + (let* ((buffer (generate-new-buffer " *ebox-range-public-gate*")) + (root + (apply #'ebox-column + (append + (cl-loop for index below static-count + collect (ebox-create :key (list 'static index) + :content "s")) + (list (ebox-child-range + 'items (ebox-create :key 'old :content "o"))))))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer root) + (let* ((old-state (ebox--buffer-render-state buffer)) + (old-table (plist-get old-state :range-ref-table)) + (surface (with-current-buffer + buffer ebox-surface--buffer-surface)) + (revision (tp-surface-revision surface)) + (candidate (ebox-candidate-begin buffer)) + report) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'new-a :content "a") + (ebox-create :key 'new-b :content "b"))) + (cl-letf (((symbol-function 'ebox--runtime-index) + (lambda (&rest _) (error "unexpected full index")))) + (setq report (ebox-commit buffer candidate))) + (let* ((parent-metrics + (car (plist-get (plist-get report :range-metrics) + :parents))) + (bound (if (= static-count 10) 2 3))) + (should (<= (plist-get parent-metrics :segment-visits) bound)) + (should (<= (plist-get parent-metrics :segment-copies) bound)) + (should (= (plist-get parent-metrics + :unaffected-payload-visits) 0)) + (should (= (plist-get parent-metrics :new-payload-visits) 2))) + (should (= (tp-surface-revision surface) (1+ revision))) + (let* ((state (ebox--buffer-render-state buffer)) + (resolved + (ebox-incremental--range-ref-resolve state 'items)) + (segment + (ebox-child-range--segment-at + (plist-get resolved :sequence) + (plist-get resolved :segment-index)))) + (should (eq old-table (plist-get state :range-ref-table))) + (dotimes (offset + (length (ebox-child-range--segment-payload segment))) + (let* ((node (aref + (ebox-child-range--segment-payload segment) + offset)) + (node-id (plist-get node :node-id)) + (object (gethash + node-id + (plist-get state + :surface-node-object-table)))) + (should (eq node (gethash node-id + (plist-get state :node-table)))) + (should object) + (should (eq object (plist-get node :surface-object)))))))) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-child-range-candidate-introduced-ref-is-next-turn-only () + "A node replacement may introduce a Range address only for the next turn." + (let ((buffer (generate-new-buffer " *ebox-range-introduced*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column (ebox-create :key 'a :host-ref 'a :content "a") + (ebox-create :key 'b :content "b"))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'a + (ebox-column + (ebox-create :key 'a :host-ref 'a :content "a") + (ebox-child-range 'introduced))) + (should-error + (ebox-candidate-replace-range-ref candidate 'introduced nil)) + (ebox-commit buffer candidate)) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'introduced + (list (ebox-create :key 'later :content "later"))) + (ebox-commit buffer candidate)) + (should (string-match-p "later" (with-current-buffer buffer + (buffer-string))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-coalescing-is-order-independent () + "Host ancestors win Range updates while Ranges win descendant Host updates." + (dolist (order '(host-first range-first)) + (let ((buffer (generate-new-buffer " *ebox-range-coalesce*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (plist-put + (ebox-column + (ebox-create :key 'static :content "s") + (ebox-child-range + 'items (ebox-create :key 'child :host-ref 'child + :content "old"))) + :host-ref 'parent) + (ebox-create :key 'peer :content "peer"))) + (let ((candidate (ebox-candidate-begin buffer))) + (dolist (operation (if (eq order 'host-first) + '(host range) '(range host))) + (pcase operation + ('host + (ebox-candidate-replace-host-ref + candidate 'parent + (ebox-create :key 'parent-new :content "HOST-WINS"))) + ('range + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'range-new + :content "range-loses")))))) + (ebox-commit buffer candidate)) + (should (string-match-p "HOST-WINS" + (with-current-buffer buffer + (buffer-string))))) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-child-range-consecutive-host-updates-keep-point-location () + "Retained Host identity preserves its sequence point location across turns." + (let ((buffer (generate-new-buffer " *ebox-range-host-location*")) node-id) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'static :content "s") + (ebox-child-range + 'items (ebox-create :key 'child :host-ref 'child :content "0")))) + (dotimes (turn 2) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'child + (ebox-create :key 'child :host-ref 'child + :content (number-to-string (1+ turn)))) + (ebox-commit buffer candidate)) + (let* ((state (ebox--buffer-render-state buffer)) + (current-id (gethash 'child (plist-get state :host-ref-table))) + (node (gethash current-id (plist-get state :node-table)))) + (when node-id (should (equal node-id current-id))) + (setq node-id current-id) + (should (plist-get node :ebox-sequence-location)))) + (should (string-match-p "2" (with-current-buffer buffer + (buffer-string))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-three-way-coalescing-keeps-host-descendant () + "A losing Range cannot absorb a descendant Host under its winning ancestor." + (let ((buffer (generate-new-buffer " *ebox-range-three-way*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (plist-put + (ebox-column + (ebox-create :key 'static :content "s") + (ebox-child-range + 'items (ebox-create :key 'child :host-ref 'child + :content "old"))) + :host-ref 'parent) + (ebox-create :key 'peer :content "peer"))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'parent + (plist-put + (ebox-column + (ebox-create :key 'static :content "s2") + (ebox-child-range + 'items (ebox-create :key 'child :host-ref 'child + :content "ancestor"))) + :host-ref 'parent)) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'range :content "RANGE-LOSES"))) + (ebox-candidate-replace-host-ref + candidate 'child + (ebox-create :key 'child :host-ref 'child + :content "DESCENDANT-WINS")) + (ebox-commit buffer candidate)) + (let ((text (with-current-buffer buffer (buffer-string)))) + (should (string-match-p "DESCENDANT-WINS" text)) + (should-not (string-match-p "RANGE-LOSES" text)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-large-payload-never-promotes-to-full-index () + "M=64 remains an affected-payload local delta under 500 static segments." + (let* ((buffer (generate-new-buffer " *ebox-range-large-payload*")) + (root + (apply #'ebox-column + (append + (cl-loop for index below 500 + collect (ebox-create :key (list 'static index) + :content "s")) + (list (ebox-child-range 'items))))) + report) + (unwind-protect + (progn + (ebox-render-to-buffer buffer root) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'items + (cl-loop for index below 64 + collect (ebox-create :key (list 'new index) + :content "n"))) + (cl-letf (((symbol-function + 'ebox-incremental--candidate-full-index-preparation) + (lambda (&rest _) (error "unexpected full preparation"))) + ((symbol-function 'ebox--runtime-index) + (lambda (&rest _) (error "unexpected full index")))) + (setq report (ebox-commit buffer candidate)))) + (let ((metrics (car (plist-get (plist-get report :range-metrics) + :parents)))) + (should (= (plist-get metrics :new-payload-visits) 64)) + (should (<= (plist-get metrics :segment-visits) 3)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-wins-descendant-host-in-both-orders () + "A surviving Range absorbs a descendant Host replacement independent of order." + (dolist (order '(host-first range-first)) + (let ((buffer (generate-new-buffer " *ebox-range-wins-host*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'static :content "s") + (ebox-child-range + 'items (ebox-create :key 'child :host-ref 'child + :content "old")))) + (let ((candidate (ebox-candidate-begin buffer))) + (dolist (operation (if (eq order 'host-first) + '(host range) '(range host))) + (if (eq operation 'host) + (ebox-candidate-replace-host-ref + candidate 'child + (ebox-create :key 'child :host-ref 'child + :content "HOST-LOSES")) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'range :content "RANGE-WINS"))))) + (ebox-commit buffer candidate)) + (let ((text (with-current-buffer buffer (buffer-string)))) + (should (string-match-p "RANGE-WINS" text)) + (should-not (string-match-p "HOST-LOSES" text)))) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-child-range-overlay-prunes-descendant-node-anchors () + "Ancestor/descendant node anchors install nested Range refs exactly once." + (let ((buffer (generate-new-buffer " *ebox-range-overlay-prune*"))) + (unwind-protect + (cl-labels + ((child (static-text range-ref range-key range-text) + (let ((node + (ebox-column + (ebox-create :key 'child-static :content static-text) + (if range-key + (ebox-child-range + range-ref + (ebox-create :key range-key :content range-text)) + (ebox-child-range range-ref))))) + (plist-put node :key 'child) + (plist-put node :host-ref 'child) + node)) + (ancestor (child-node peer-text) + (let ((node + (ebox-column + child-node + (ebox-create :key 'ancestor-peer :content peer-text)))) + (plist-put node :key 'ancestor) + (plist-put node :host-ref 'ancestor) + node))) + (ebox-render-to-buffer + buffer + (ebox-column + (ancestor (child "s" 'old-ref nil nil) "p") + (ebox-create :key 'root-peer :content "r"))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'ancestor + (ancestor (child "s2" 'new-ref 'ancestor-range "a") "p2")) + (ebox-candidate-replace-host-ref + candidate 'child + (child "s3" 'new-ref 'descendant-range "d")) + (ebox-commit buffer candidate)) + (let* ((state (ebox--buffer-render-state buffer)) + (table (plist-get state :range-ref-table)) + (record (gethash 'new-ref table)) + (child-id (gethash 'child (plist-get state :host-ref-table)))) + (should-not (gethash 'old-ref table)) + (should record) + (should (= (hash-table-count table) 1)) + (should (equal (plist-get record :parent-node-id) child-id)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-disjoint-host-and-range-publish-once () + "Disjoint Host and Range changes share one scoped TP publication." + (let ((buffer (generate-new-buffer " *ebox-range-disjoint*")) (callbacks 0)) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'host :host-ref 'host :content "old-host") + (ebox-child-range + 'items (ebox-create :key 'old-range :content "old-range")))) + (let* ((surface (with-current-buffer buffer ebox-surface--buffer-surface)) + (revision (tp-surface-revision surface)) + (candidate (ebox-candidate-begin buffer)) + report) + (ebox-candidate-replace-host-ref + candidate 'host + (ebox-create :key 'host :host-ref 'host :content "new-host")) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'new-range :content "new-range"))) + (setq report + (ebox-commit buffer candidate + (lambda (_report) (cl-incf callbacks)))) + (should (= callbacks 1)) + (should (= (tp-surface-revision surface) (1+ revision))) + (should (= (plist-get (plist-get report :range-metrics) + :applied-count) 1)) + (should-not (plist-get report :tp-scope-fallback)) + (let ((text (with-current-buffer buffer (buffer-string)))) + (should (string-match-p "new-host" text)) + (should (string-match-p "new-range" text))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-final-accept-failure-restores-exact-generation () + "A Range commit rejected by final accept restores all old identities." + (let ((buffer (generate-new-buffer " *ebox-range-final-rollback*")) trace) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'static :content "s") + (ebox-child-range + 'items (ebox-create :key 'old :host-ref 'old :content "old")))) + (let* ((old-state (ebox--buffer-render-state buffer)) + (old-root (plist-get old-state :root-node)) + (old-table (plist-get old-state :range-ref-table)) + (old-id (gethash 'old (plist-get old-state :host-ref-table))) + (old-buffer (with-current-buffer buffer (buffer-string))) + (candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'new :host-ref 'new :content "new"))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (_group) (error "reject final accept")))) + (should-error + (ebox-commit + buffer candidate + (lambda (_report) (push 'publish trace)) + (lambda (_report) (push 'rollback trace))))) + (should (equal trace '(rollback publish))) + (should (eq (ebox--buffer-render-state buffer) old-state)) + (should (eq (plist-get old-state :root-node) old-root)) + (should (eq (plist-get old-state :range-ref-table) old-table)) + (should (= (gethash 'old (plist-get old-state :host-ref-table)) + old-id)) + (should (equal (with-current-buffer buffer (buffer-string)) + old-buffer))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'new :content "new"))) + (ebox-commit buffer candidate))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-child-range-framework-failure-rolls-back-and-retries () + "A failed framework publish restores the exact old Range generation." + (let ((buffer (generate-new-buffer " *ebox-range-rollback*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'static :content "s") + (ebox-child-range + 'items (ebox-create :key 'old :content "old")))) + (let* ((old-state (ebox--buffer-render-state buffer)) + (old-root (plist-get old-state :root-node)) + (old-range-table (plist-get old-state :range-ref-table)) + (old-buffer (with-current-buffer buffer (buffer-string))) + (candidate (ebox-candidate-begin buffer)) + trace) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'new :content "new"))) + (should-error + (ebox-commit + buffer candidate + (lambda (_report) (push 'publish trace) (error "reject")) + (lambda (_report) (push 'rollback trace)))) + (should (equal trace '(rollback publish))) + (should (eq (ebox--buffer-render-state buffer) old-state)) + (should (eq (plist-get old-state :root-node) old-root)) + (should (eq (plist-get old-state :range-ref-table) old-range-table)) + (should (equal (with-current-buffer buffer (buffer-string)) + old-buffer))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-range-ref + candidate 'items + (list (ebox-create :key 'new :content "new"))) + (ebox-commit buffer candidate)) + (should (string-match-p "new" (with-current-buffer buffer + (buffer-string))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(provide 'ebox-child-range-tests) +;;; ebox-child-range-tests.el ends here diff --git a/tests/ebox-ci-contract-tests.el b/tests/ebox-ci-contract-tests.el index 4a089e2..d90ec69 100644 --- a/tests/ebox-ci-contract-tests.el +++ b/tests/ebox-ci-contract-tests.el @@ -16,7 +16,7 @@ "The Makefile should expose Ebox targets without bundling ETAF." (let ((source (ebox-ci-test--read "Makefile"))) (dolist (target '("check:" "ci:" "load:" "compile:" "test:" - "core-tests:" "grid-tests:" "ebox-commit-tests:" + "core-tests:" "child-range-tests:" "grid-tests:" "ebox-commit-tests:" "surface-tests:" "docs-contract-tests:" "ci-contract-tests:" "native-rust-tests:" @@ -32,6 +32,7 @@ (should (string-match-p "byte-compile-error-on-warn" source)) (should (string-match-p "ebox-byte-compile" source)) (should (string-match-p "ebox-native-reflow.el" ebox)) + (should (string-match-p "ebox-child-range.el" ebox)) (should-not (string-match-p "ebox-playground.el" ebox)))) (ert-deftest ebox-ci-prefers-newer-source-and-cleans-local-products () diff --git a/tests/ebox-commit-tests.el b/tests/ebox-commit-tests.el index 3749907..ce4ad40 100644 --- a/tests/ebox-commit-tests.el +++ b/tests/ebox-commit-tests.el @@ -11,6 +11,32 @@ (widen) (buffer-substring (point-min) (point-max))))) +(ert-deftest ebox-style-schema-registration-is-not-per-node-copy () + "Repeated node construction must not copy the whole ECSS schema domain." + (let ((calls 0) + (original (symbol-function 'ecss-schema-set-property))) + (cl-letf (((symbol-function 'ecss-schema-set-property) + (lambda (&rest arguments) + (cl-incf calls) + (apply original arguments)))) + (dotimes (_ 24) + (ebox-create :content "schema-hot-path" :color "#111111"))) + (should (= calls 0)))) + +(ert-deftest ebox-style-declaration-compilation-is-memoized () + "Repeated equivalent style declarations compile through ECSS once." + (clrhash ebox-style--declaration-cache) + (let ((calls 0) + (original (symbol-function 'ecss-merge-declarations))) + (cl-letf (((symbol-function 'ecss-merge-declarations) + (lambda (&rest arguments) + (cl-incf calls) + (apply original arguments)))) + (dotimes (_ 24) + (ebox-style-compile-declarations + '(:color "#111111" :bgcolor "#222222")))) + (should (= calls 1)))) + (ert-deftest ebox-commit-publishes-content-change () "A declarative commit should publish changed content." (let* ((buffer (ebox-render-to-buffer @@ -55,6 +81,953 @@ (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-candidate-root-replacement-is-last-wins-and-absorbing () + "The private root address absorbs descendant operations without ref overlap." + (let* ((buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-root-candidate*") + (ebox-column + (ebox-create :key 'a :host-ref 'a :content "A" :width '(40)) + (ebox-create :key 'b :host-ref 'b :content "B" :width '(40))))) + (surface (with-current-buffer buffer ebox-surface--buffer-surface)) + (revision (tp-surface-revision surface)) + (candidate (ebox-candidate-begin buffer))) + (unwind-protect + (progn + (ebox-candidate-replace-host-ref + candidate 'a (ebox-create :key 'a :content "ignored-before")) + (ebox-candidate-replace-root + candidate + (ebox-create :key 'root :host-ref 'a :content "first-root" + :width '(80))) + (ebox-candidate-replace-host-ref + candidate 'b (ebox-create :key 'b :content "ignored-after")) + (ebox-candidate-replace-root + candidate + (ebox-create :key 'root :host-ref 'b :content "final-root" + :width '(80))) + (should (= (length (ebox-candidate--replacements candidate)) 1)) + (let ((report (ebox-commit buffer candidate))) + (should (string-match-p + "final-root" + (substring-no-properties + (ebox-commit-test--buffer-string buffer)))) + (should-not (string-match-p + "ignored" + (substring-no-properties + (ebox-commit-test--buffer-string buffer)))) + (should (= (tp-surface-revision surface) (1+ revision))) + (should (plist-get report :runtime-published))) + (should-error + (ebox-candidate-replace-root + candidate (ebox-create :key 'root :content "sealed")))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-framework-participant-completes-and-rolls-back () + "Framework publication is paired, diagnosed, and completed exactly once." + (let ((buffer (generate-new-buffer " *ebox-framework-participant*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-create :key 'root :content "old" :width '(80))) + (let (trace) + (let ((report + (ebox-commit + buffer (ebox-create :key 'root :content "new" :width '(80)) + (lambda (_report) (push 'publish trace)) + (lambda (_report) (push 'rollback trace))))) + (should (equal trace '(publish))) + (should (eq (plist-get report :framework-participant-state) + 'completed)) + (should-not + (plist-get report :framework-participant-diagnostics)))) + (let* ((before (ebox-commit-test--buffer-string buffer)) + (original + (symbol-function 'tp--run-transaction-precommit-functions)) + trace captured failure) + (cl-letf + (((symbol-function 'tp--run-transaction-precommit-functions) + (lambda () + (funcall original) + (error "later TP failure")))) + (setq failure + (condition-case condition + (ebox-commit + buffer + (ebox-create :key 'root :content "rejected" + :width '(80)) + (lambda (report) + (setq captured report) + (push 'publish trace)) + (lambda (_report) + (push 'rollback trace) + (error "rollback diagnostic"))) + (error condition)))) + (should (equal trace '(rollback publish))) + (should (equal (cadr failure) "later TP failure")) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) before)) + (should (eq (plist-get captured :framework-participant-state) + 'rolled-back)) + (should (= (length + (plist-get + captured :framework-participant-diagnostics)) + 1)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-framework-publish-failure-rolls-back-full-and-scoped () + "A framework publish failure invokes its pair once on both commit paths." + (dolist (mode '(full scoped)) + (let ((buffer (generate-new-buffer " *ebox-framework-publish-fail*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'a :host-ref 'a :content "old-a" :width '(40)) + (ebox-create :key 'b :host-ref 'b :content "old-b" :width '(40)))) + (let ((before (ebox-commit-test--buffer-string buffer)) + (candidate (ebox-candidate-begin buffer)) + trace captured) + (when (eq mode 'scoped) + (ebox-candidate-replace-host-ref + candidate 'a + (ebox-create :key 'a :host-ref 'a :content "new-a" + :width '(40)))) + (should-error + (ebox-commit + buffer + (if (eq mode 'scoped) + candidate + (ebox-create :key 'root :content "new-root" :width '(80))) + (lambda (report) + (setq captured report) + (push 'publish trace) + (error "framework publish failed")) + (lambda (_report) (push 'rollback trace)))) + (should (equal trace '(rollback publish))) + (should (eq (plist-get captured :framework-participant-state) + 'rolled-back)) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) before)))) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-commit-framework-argument-validation () + "Four-argument framework callbacks have an exact paired contract." + (let ((buffer (generate-new-buffer " *ebox-framework-validation*")) + (root (ebox-create :key 'root :content "x"))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer root) + (should-error (ebox-commit buffer root 7) :type 'wrong-type-argument) + (should-error + (ebox-commit buffer root nil #'ignore)) + (should-error + (ebox-commit buffer root #'ignore 7) + :type 'wrong-type-argument)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-expands-scope-for-length-changing-column-content () + "A column content growth must publish shifted later styled siblings." + (let* ((buffer (generate-new-buffer-name " *ebox-commit-column-scope*")) + (old-root + (ebox-column + (ebox-create :key 'panel :padding '(1 (2)) + :border "#687386" :bgcolor "#FFFDF8" + :content "Panel") + (ebox-create :key 'payload :padding '(0 (1)) + :border "#AAA" :content "No payload yet.") + (ebox-create :key 'later :padding '(0 (1)) + :border "#BBB" :content "Later sibling"))) + (new-root + (ebox-column + (ebox-create :key 'panel :padding '(1 (2)) + :border "#687386" :bgcolor "#FFFDF8" + :content "Panel") + (ebox-create :key 'payload :padding '(0 (1)) + :border "#AAA" + :content "Payload received: payload=42") + (ebox-create :key 'later :padding '(0 (1)) + :border "#BBB" :content "Later sibling"))) + (report nil)) + (unwind-protect + (progn + (ebox-render-to-buffer buffer old-root) + (setq report (ebox-commit buffer new-root)) + (should (string-match-p + "Payload received: payload=42" + (with-current-buffer buffer (buffer-string)))) + (should (string-match-p "Later sibling" + (with-current-buffer buffer (buffer-string)))) + (should (eq (plist-get report :strategy) 'owner-rerender)) + (should (equal (plist-get report :patch-ops) '(owner-rerender))) + (should-not (plist-get report :tp-scope-fallback))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-reuses-unchanged-style-computations () + "A content-only commit should not recompute unchanged retained styles." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (calls 0) + (original (symbol-function 'ecss-compute-style)) + (buffer nil)) + (ebox-style-add-rule ".card" '(:color "#111111") :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-commit-style-cache*") + (ebox-column + (ebox-create :key 'first :class "card" :content "Before" + :width '(40)) + (ebox-create :key 'second :class "card" :content "Stable" + :width '(40))))) + (setq calls 0) + (cl-letf (((symbol-function 'ecss-compute-style) + (lambda (&rest arguments) + (cl-incf calls) + (apply original arguments)))) + (ebox-commit + buffer + (ebox-column + (ebox-create :key 'first :class "card" :content "After" + :width '(40)) + (ebox-create :key 'second :class "card" :content "Stable" + :width '(40)))) + (should (= calls 0)))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-builds-one-selector-tree-snapshot () + "A styled commit should snapshot selector context once for the whole tree." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (calls 0) + (original (symbol-function 'ebox-surface--subject-signature)) + (buffer nil)) + (ebox-style-add-rule ".card" '(:color "#111111") :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-commit-selector-snapshot*") + (ebox-column + (ebox-create :key 'first :class "card" :content "Before" + :width '(40)) + (ebox-create :key 'second :class "card" :content "Stable" + :width '(40))))) + (cl-letf (((symbol-function 'ebox-surface--subject-signature) + (lambda (&rest arguments) + (cl-incf calls) + (apply original arguments)))) + (ebox-commit + buffer + (ebox-column + (ebox-create :key 'first :class "card" :content "After" + :width '(40)) + (ebox-create :key 'second :class "card" :content "Stable" + :width '(40)))) + (should (= calls 1)))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-invalidates-selector-tree-token-for-sibling-change () + "A sibling metadata change must invalidate retained selector computations." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (buffer nil)) + (ebox-style-add-rule ".active + .target" '(:color "#2255AA") + :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-commit-selector-change*") + (ebox-column + (ebox-create :key 'state :class "inactive" :content "State" + :width '(40)) + (ebox-create :key 'target :class "target" :content "Target" + :width '(40))))) + (let* ((before (ebox-commit-test--buffer-string buffer)) + (position (string-match "Target" before))) + (should position) + (should-not (get-text-property position 'face before))) + (ebox-commit + buffer + (ebox-column + (ebox-create :key 'state :class "active" :content "State" + :width '(40)) + (ebox-create :key 'target :class "target" :content "Target" + :width '(40)))) + (let* ((after (ebox-commit-test--buffer-string buffer)) + (position (string-match "Target" after))) + (should position) + (should (equal (plist-get (get-text-property position 'face after) + :foreground) + "#2255AA")))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-observes-in-place-stylesheet-changes () + "A retained commit must refresh when its stylesheet changes in place." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (buffer nil)) + (ebox-style-add-rule ".card" '(:color "#111111") :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-commit-style-rule*") + (ebox-create :key 'card :class "card" :content "Stable" + :width '(40)))) + (should (equal (plist-get (get-text-property + (point-min) 'face buffer) :foreground) + "#111111")) + (ebox-style-add-rule ".card" '(:color "#222222") :layer 'components) + (ebox-commit + buffer + (ebox-create :key 'card :class "card" :content "Stable" + :width '(40))) + (should (equal (plist-get (get-text-property + (point-min) 'face buffer) :foreground) + "#222222"))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-observes-cascade-activation-during-content-change () + "A commit must not span-patch across an inactive-to-active cascade change." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (buffer nil)) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-commit-cascade-activation*") + (ebox-create :key 'card :class "card" :content "Before" + :width '(40)))) + (should-not (get-text-property (point-min) 'face buffer)) + (ebox-style-add-rule ".card" '(:color "#2255AA") + :layer 'components) + (let ((report + (ebox-commit + buffer + (ebox-create :key 'card :class "card" :content "After" + :width '(40))))) + (should (string-prefix-p + "After" + (string-trim-right + (substring-no-properties + (ebox-commit-test--buffer-string buffer))))) + (should-not (eq (plist-get report :strategy) 'span-patch)) + (should (equal (plist-get (get-text-property + (point-min) 'face buffer) :foreground) + "#2255AA")))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-uses-static-cascade-owner-proof () + "A static cascade content commit may plan its local owner." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (calls 0) + (ensured 0) + (rendered nil) + (buffer nil)) + (ebox-style-add-rule ".card" '(:color "#111111") :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-commit-proof-cache*") + (ebox-build + '(column :width (100) :height 4 + (column :key main :width (100) :height 2 + (grid :key grid :width (100) :height 2 + :grid-template-columns (1fr 1fr) + (column :key card-shell :width stretch :height 2 + (box :key card :class "card" :host-ref target + :content "Before")) + (box :key stable :content "Stable" + :width (40) :height 1))) + (box :key footer :content "Footer" + :width (100) :height 1))))) + (let* ((state (ebox--buffer-render-state buffer)) + (style-states (plist-get state :style-binding-states)) + (binding-state + (cl-loop for value being the hash-values of style-states + when (and (plist-get value :declarations) + (plist-get value :parent-style-state) + (ebox-surface--static-style-state-p value)) + return value))) + (should binding-state) + (should (tp-binding-live-p (plist-get binding-state :binding))) + (should (plist-get binding-state :parent-style-state)) + (should (= 1 (plist-get binding-state + :inherited-dependency-count))) + (should (= 1 (tp-binding-dependency-count + (plist-get binding-state :binding)))) + (should (ebox-surface--static-style-state-p binding-state))) + (let ((original + (symbol-function 'ebox-incremental--layout-owner-plan)) + (original-ensure + (symbol-function 'ebox-surface--ensure-node-tree)) + (original-render (symbol-function 'ebox--render-layout))) + (cl-letf (((symbol-function 'ebox-incremental--layout-owner-plan) + (lambda (&rest arguments) + (cl-incf calls) + (apply original arguments))) + ((symbol-function 'ebox-surface--ensure-node-tree) + (lambda (&rest arguments) + (cl-incf ensured) + (apply original-ensure arguments))) + ((symbol-function 'ebox--render-layout) + (lambda (node) + (push (plist-get node :node-id) rendered) + (funcall original-render node)))) + (let* ((candidate (ebox-candidate-begin buffer)) + (_replacement + (ebox-candidate-replace-host-ref + candidate 'target + (ebox-create :key 'card :class "card" + :host-ref 'target :content "After"))) + (report (ebox-commit buffer candidate))) + (should (eq (plist-get report :projection-kind) + 'owner-scoped)) + ;; The nested 1fr Grid now carries a strict local allocation + ;; certificate; the proof no longer rescans every normal-flow + ;; ancestor just to establish the same slot width. + (should (= 1 (plist-get report :ancestor-slot-count))) + (should (= 0 (plist-get report + :ancestor-slot-generation)))) + (should (string-match-p + "After" + (substring-no-properties + (ebox-commit-test--buffer-string buffer)))) + (should (= calls 1)) + (should (= ensured 0)) + (should (= (length rendered) 1)))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))))) + +(ert-deftest ebox-commit-keeps-root-owner-for-dynamic-cascade-source () + "A TP-dependent cascade binding must preserve root-owner fallback." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (color (tp-signal-create "#111111")) + (calls 0) + (buffer nil)) + (ebox-style-add-rule + ".card" (list :color (tp-computed (lambda () (tp-signal-read color)))) + :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-dynamic-style-proof*") + (ebox-column + (ebox-create :key 'card :class "card" :content "Before" + :width '(40)) + (ebox-create :key 'stable :content "Stable" + :width '(40))))) + (let* ((state (ebox--buffer-render-state buffer)) + (style-states (plist-get state :style-binding-states)) + (binding-state + (cl-loop for value being the hash-values of style-states + when (and (plist-get value :binding) + (not (ebox-surface--static-style-state-p + value))) + return value))) + (should binding-state) + (should (> (tp-binding-dependency-count + (plist-get binding-state :binding)) + (if (plist-get binding-state :parent-binding) 1 0))) + (should-not (ebox-surface--static-style-state-p binding-state))) + (let ((original + (symbol-function 'ebox-incremental--layout-owner-plan))) + (cl-letf (((symbol-function 'ebox-incremental--layout-owner-plan) + (lambda (&rest arguments) + (cl-incf calls) + (apply original arguments)))) + (ebox-commit + buffer + (ebox-column + (ebox-create :key 'card :class "card" :content "After" + :width '(40)) + (ebox-create :key 'stable :content "Stable" + :width '(40)))) + (should (= calls 0))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-owner-scoped-proof-rejects-unstable-allocation () + "Auto intrinsic, line-count, and topology changes must keep root fallback." + (let ((ebox-style-stylesheet (ecss-stylesheet-create))) + (ebox-style-add-rule ".card" '(:color "#111111") :layer 'components) + (dolist + (case + (list + (list :name "auto" + :old (ebox-create :key 'card :class "card" :host-ref 'target + :content "Before") + :new (ebox-create :key 'card :class "card" :host-ref 'target + :content "After, intrinsically wider")) + (list :name "lines" + :old (ebox-create :key 'card :class "card" :host-ref 'target + :content "Before" :width '(40)) + :new (ebox-create :key 'card :class "card" :host-ref 'target + :content "After\nsecond" :width '(40))) + (list :name "topology" + :old (ebox-create :key 'card :class "card" :host-ref 'target + :content "Before" :width '(40) :height 1) + :new (ebox-column + (ebox-create :key 'first :content "After" :width '(40)) + (ebox-create :key 'second :content "Second" + :width '(40)))))) + (let ((buffer nil)) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name + (format " *ebox-owner-proof-%s*" (plist-get case :name))) + (ebox-column + (plist-get case :old) + (ebox-create :key 'stable :content "Stable" + :width '(40))))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'target (plist-get case :new)) + (let ((report (ebox-commit buffer candidate))) + (should-not (eq (plist-get report :projection-kind) + 'owner-scoped))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + (let ((buffer nil)) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-owner-proof-auto-grid*") + (ebox-build + '(grid :width (100) :height 1 + :grid-template-columns (auto (40)) + (box :key card :class "card" :host-ref target + :content "Before" :height 1) + (box :key stable :content "Stable" + :width (40) :height 1))))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'target + (ebox-create :key 'card :class "card" :host-ref 'target + :content "After" :height 1)) + (let ((report (ebox-commit buffer candidate))) + (should-not (eq (plist-get report :projection-kind) + 'owner-scoped))))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))))) + +(ert-deftest ebox-commit-owner-scoped-multi-owner-is-atomic () + "Two disjoint fixed-slot owners render locally in one publication." + (let* ((ebox-style-stylesheet (ecss-stylesheet-create)) + (buffer nil) + (ensured 0) + (ancestor-proofs 0) + (rendered nil) + (published 0)) + (ebox-style-add-rule ".card" '(:color "#111111") :layer 'components) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-owner-multi*") + (ebox-build + '(grid :width (100) + :grid-template-columns (1fr 1fr) + (column :key card-shell :width stretch + :border "#687386" :padding (1 2) + (box :key first :class "card" :host-ref first + :content "First" ) + (box :key second :class "card" :host-ref second + :content "Second")) + (box :key stable :content "Stable" + :width (40) :height 2))))) + (let* ((surface (with-current-buffer buffer + ebox-surface--buffer-surface)) + (revision (tp-surface-revision surface)) + (candidate (ebox-candidate-begin buffer)) + (original-ensure + (symbol-function 'ebox-surface--ensure-node-tree)) + (original-ancestor-proof + (symbol-function + 'ebox-incremental--compute-ancestor-slot-signature)) + (original-render (symbol-function 'ebox--render-layout))) + (ebox-candidate-replace-host-ref + candidate 'first + (ebox-create :key 'first :class "card" :host-ref 'first + :content "Alpha")) + (ebox-candidate-replace-host-ref + candidate 'second + (ebox-create :key 'second :class "card" :host-ref 'second + :content "Bravo!")) + (cl-letf (((symbol-function 'ebox-surface--ensure-node-tree) + (lambda (&rest arguments) + (cl-incf ensured) + (apply original-ensure arguments))) + ((symbol-function 'ebox--render-layout) + (lambda (node) + (push (plist-get node :node-id) rendered) + (funcall original-render node))) + ((symbol-function + 'ebox-incremental--compute-ancestor-slot-signature) + (lambda (&rest arguments) + (cl-incf ancestor-proofs) + (apply original-ancestor-proof arguments)))) + (let ((report + (ebox-commit + buffer candidate + (lambda (_report) (cl-incf published))))) + (should (eq (plist-get report :projection-kind) + 'owner-scoped)) + (should (= 2 (length (plist-get report + :rendered-owner-ids)))) + (should (= 1 published)) + (should (= 1 (- (tp-surface-revision surface) revision))) + (should (= 0 ensured)) + (should (= 2 ancestor-proofs)) + (should (= 2 (length rendered))) + (should (string-match-p + "Alpha" (ebox-commit-test--buffer-string buffer))) + (should (string-match-p + "Bravo!" (ebox-commit-test--buffer-string buffer))) + (let* ((text (ebox-commit-test--buffer-string buffer)) + (position (string-match "Alpha" text))) + (should position) + (should (equal + (plist-get (get-text-property position 'face text) + :foreground) + "#111111"))) + (should (< (plist-get report :reconciled-objects) + (plist-get (tp-surface-inspect surface) + :object-count))))) + (let* ((fallback-revision (tp-surface-revision surface)) + (fallback (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + fallback 'first + (ebox-create :key 'first :class "card" :host-ref 'first + :content "Gamma")) + (ebox-candidate-replace-host-ref + fallback 'second + (ebox-create :key 'second :class "card" :host-ref 'second + :content "Much much much much much much longer beta content")) + (let ((report (ebox-commit buffer fallback))) + (should-not (eq (plist-get report :projection-kind) + 'owner-scoped)) + (should (or (plist-get report :tp-scope-fallback) + (plist-get report :tp-full-root))) + (should (= 1 (- (tp-surface-revision surface) + fallback-revision))) + (let ((text (ebox-commit-test--buffer-string buffer))) + (should (string-match-p + "Much much much much much much longer beta" + text)) + (should (string-match-p "content" text))))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-commit-formatting-context-reflow-owns-variable-line-siblings () + "Two variable-line owners should publish through their nearest stack context. +The context owns the complete local block; the root and untouched header/footer +remain retained identities." + (let* ((old-root + (ebox-column + (ebox-create :key 'header :content "Header" :width '(160)) + (ebox-create + :key 'shell :width '(160) + :ebox-content-node + (ebox-column + (ebox-create :key 'message :host-ref 'message + :content "Callback action pending") + (ebox-flex :width '(120) :height 1 + (ebox-create :key 'toggle :host-ref 'toggle + :content "Behavior: off")))) + (ebox-create :key 'footer :content "Footer" :width '(160)))) + (new-message + (ebox-create :key 'message :host-ref 'message + :content "Behavior toggle: on / callback active / a longer status line")) + (new-toggle + (ebox-create :key 'toggle :host-ref 'toggle + :content "Behavior: on")) + (new-root + (ebox-column + (ebox-create :key 'header :content "Header" :width '(160)) + (ebox-create + :key 'shell :width '(160) + :ebox-content-node + (ebox-column + new-message + (ebox-flex :width '(120) :height 1 new-toggle))) + (ebox-create :key 'footer :content "Footer" :width '(160)))) + (buffer nil) + (fresh nil)) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name + " *ebox-formatting-context-reflow*") + old-root)) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref candidate 'message new-message) + (ebox-candidate-replace-host-ref candidate 'toggle new-toggle) + (let ((root-id + (plist-get (plist-get (ebox--buffer-render-state buffer) + :root-node) + :node-id)) + report) + (setq report (ebox-commit buffer candidate)) + (should (eq (plist-get report :projection-kind) + 'formatting-context-reflow)) + (should (= 1 (length (plist-get report :owner-ids)))) + (should-not (member root-id (plist-get report :owner-ids))) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback)) + (should (= 1 (plist-get report :tp-scope-count))) + (should (= 1 (plist-get report :tp-scope-range-count))) + (should (= 1 (plist-get report :tp-text-operations))))) + (setq fresh + (ebox-render-to-buffer + (generate-new-buffer-name + " *ebox-formatting-context-fresh*") + new-root)) + (let* ((committed (ebox-commit-test--buffer-string buffer)) + (expected (ebox-commit-test--buffer-string fresh)) + (keys '(ebox-content ebox-content-idx ebox-content-owner + ebox-content-owners display)) + (semantic-owner + (lambda (state value) + (if (numberp value) + (let* ((region-node-table + (plist-get state :region-node-table)) + (node-table (plist-get state :node-table)) + (node-id (and region-node-table + (gethash value region-node-table))) + (node (and node-id + (gethash node-id node-table)))) + (or (and node (ebox-tree-node-key node)) value)) + value))) + (semantic-properties + (lambda (state text position) + (mapcar + (lambda (key) + (cons key + (let ((value (get-text-property + position key text))) + (if (memq key '(ebox-content-owner + ebox-content-owners + ebox-content)) + (if (listp value) + (mapcar (lambda (owner) + (funcall semantic-owner + state owner)) + value) + (funcall semantic-owner state value)) + value)))) + keys)))) + ;; Region ids are buffer-local allocation identities. Compare + ;; stable node semantics and layout properties, not those ids. + (should (equal (substring-no-properties committed) + (substring-no-properties expected))) + (should (= (length committed) (length expected))) + (dotimes (position (length committed)) + (should + (equal (funcall semantic-properties + (ebox--buffer-render-state buffer) + committed position) + (funcall semantic-properties + (ebox--buffer-render-state fresh) + expected position)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer)) + (when (buffer-live-p fresh) + (kill-buffer fresh))))) + +(ert-deftest ebox-commit-formatting-context-reflow-rolls-back-and-retries () + "Formatting-context reflow keeps one rollback boundary and can retry." + (cl-labels + ((root (message toggle) + (ebox-column + (ebox-create :key 'header :content "Header" :width '(160)) + (ebox-create + :key 'shell :width '(160) + :ebox-content-node + (ebox-column + (ebox-create :key 'message :host-ref 'message :content message) + (ebox-flex :width '(120) :height 1 + (ebox-create :key 'toggle :host-ref 'toggle + :content toggle)))) + (ebox-create :key 'footer :content "Footer" :width '(160))))) + (dolist (failure-kind '(client-state final-accept)) + (let ((buffer (generate-new-buffer + (format " *ebox-formatting-context-%S*" failure-kind)))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (root "Callback action pending" "Behavior: off")) + (let* ((before (ebox-commit-test--buffer-string buffer)) + (state (tp-surface-client-state + (with-current-buffer + buffer ebox-surface--buffer-surface))) + (revision (tp-surface-revision + (with-current-buffer + buffer ebox-surface--buffer-surface))) + (candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'message + (ebox-create + :key 'message :host-ref 'message + :content "Behavior toggle: on / callback active / a longer status line")) + (ebox-candidate-replace-host-ref + candidate 'toggle + (ebox-create :key 'toggle :host-ref 'toggle + :content "Behavior: on")) + (if (eq failure-kind 'client-state) + (let ((tp--surface-publication-step-function + (lambda (step _surface) + (when (eq step 'client-state) + (error "reject formatting reflow publication"))))) + (should-error (ebox-commit buffer candidate))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (_group) + (error "reject formatting reflow accept")))) + (should-error (ebox-commit buffer candidate)))) + (let ((surface (with-current-buffer + buffer ebox-surface--buffer-surface))) + (should (eq (tp-surface-client-state surface) state)) + (should (= (tp-surface-revision surface) revision)) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) before))) + (let ((retry (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + retry 'message + (ebox-create + :key 'message :host-ref 'message + :content "Behavior toggle: on / callback active / a longer status line")) + (ebox-candidate-replace-host-ref + retry 'toggle + (ebox-create :key 'toggle :host-ref 'toggle + :content "Behavior: on")) + (let ((report (ebox-commit buffer retry))) + (should (eq (plist-get report :projection-kind) + 'formatting-context-reflow)) + (should-not (plist-get report :tp-scope-fallback)) + (should-not (plist-get report :tp-full-root)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))))) + +(ert-deftest ebox-commit-multi-owner-variable-content-keeps-fixed-slots () + "Two fixed Grid slots accept unequal one-line content in one publication." + (let* ((new-left + (ebox-create :key 'left :host-ref 'left + :content "L")) + (new-right + (ebox-create :key 'right :host-ref 'right :content "R")) + (old-root + (ebox-build + '(grid :key grid :width (80) + :grid-template-columns ((36) (36)) + :column-gap (0 (8)) + (box :key left :host-ref left :content "left-old") + (box :key right :host-ref right :content "right-old")))) + (buffer nil) + (fresh nil) + report) + (unwind-protect + (progn + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name + " *ebox-multi-owner-variable-slots*") + old-root)) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref candidate 'left new-left) + (ebox-candidate-replace-host-ref candidate 'right new-right) + (setq report (ebox-commit buffer candidate))) + (should (memq (plist-get report :projection-kind) + '(span-patch owner-scoped))) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback)) + (should (= 1 (plist-get report :tp-text-operations))) + (should (string-match-p "L" + (ebox-commit-test--buffer-string buffer))) + (setq fresh + (ebox-render-to-buffer + (generate-new-buffer-name + " *ebox-multi-owner-variable-slots-fresh*") + (ebox-build + '(grid :key grid :width (80) + :grid-template-columns ((36) (36)) + :column-gap (0 (8)) + (box :key left :host-ref left :content "L") + (box :key right :host-ref right :content "R"))))) + (should (equal + (substring-no-properties + (ebox-commit-test--buffer-string buffer)) + (substring-no-properties + (ebox-commit-test--buffer-string fresh)))) + (when (buffer-live-p buffer) + (kill-buffer buffer)) + (when (buffer-live-p fresh) + (kill-buffer fresh)))))) + +(ert-deftest ebox-commit-multi-owner-variable-content-rolls-back-and-retries () + "Variable multi-owner spans restore old state at both TP failure points." + (cl-labels + ((root (left right) + (ebox-grid :key 'grid :width '(80) + :grid-template-columns '((36) (36)) + :column-gap '(0 (8)) + (ebox-create :key 'left :host-ref 'left :content left) + (ebox-create :key 'right :host-ref 'right :content right))) + (candidate (buffer) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'left + (ebox-create :key 'left :host-ref 'left :content "L")) + (ebox-candidate-replace-host-ref + candidate 'right + (ebox-create :key 'right :host-ref 'right :content "R")) + candidate))) + (dolist (failure-kind '(client-state final-accept)) + (let ((buffer (generate-new-buffer + (format " *ebox-variable-span-%S*" failure-kind)))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (root "left-old" "right-old")) + (let* ((surface (with-current-buffer + buffer ebox-surface--buffer-surface)) + (state (tp-surface-client-state surface)) + (revision (tp-surface-revision surface)) + (before (ebox-commit-test--buffer-string buffer)) + (candidate (candidate buffer))) + (if (eq failure-kind 'client-state) + (let ((tp--surface-publication-step-function + (lambda (step _surface) + (when (eq step 'client-state) + (error "reject variable span publication"))))) + (should-error (ebox-commit buffer candidate))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (_group) + (error "reject variable span accept")))) + (should-error (ebox-commit buffer candidate)))) + (should (eq (tp-surface-client-state surface) state)) + (should (= (tp-surface-revision surface) revision)) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) before)) + (let ((report (ebox-commit buffer (candidate buffer)))) + (should (memq (plist-get report :projection-kind) + '(span-patch owner-scoped))) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))))) + (ert-deftest ebox-commit-updates-raw-runtime-type-counts () "A structural candidate should publish exact raw runtime type counts." (let* ((buffer @@ -98,6 +1071,323 @@ (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-candidate-root-replacement-reuses-candidate-validity-contract () + "Root replacement rejects invalid, other-buffer, stale, and sealed use." + (let ((first (generate-new-buffer " *ebox-root-valid-first*")) + (second (generate-new-buffer " *ebox-root-valid-second*"))) + (unwind-protect + (progn + (ebox-render-to-buffer first (ebox-create :key 'root :content "one")) + (ebox-render-to-buffer second (ebox-create :key 'root :content "two")) + (let ((candidate (ebox-candidate-begin first))) + (should-error (ebox-candidate-replace-root candidate "invalid")) + (ebox-candidate-replace-root + candidate (ebox-create :key 'root :content "candidate")) + (should-error (ebox-commit second candidate)) + (should-error + (ebox-candidate-replace-root + candidate (ebox-create :key 'root :content "sealed")))) + (let ((candidate (ebox-candidate-begin first))) + (ebox-candidate-replace-root + candidate (ebox-create :key 'root :content "stale")) + (ebox-commit first (ebox-create :key 'root :content "new-base")) + (should-error (ebox-commit first candidate)))) + (dolist (buffer (list first second)) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-commit-two-and-three-argument-compatibility () + "Two-argument commits complete and legacy callbacks receive one same report." + (let ((buffer (generate-new-buffer " *ebox-framework-compat*"))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer (ebox-create :key 'root :content "0")) + (should (eq (plist-get + (ebox-commit buffer (ebox-create :key 'root :content "1")) + :framework-participant-state) + 'completed)) + (let ((calls 0) seen) + (let ((report + (ebox-commit + buffer (ebox-create :key 'root :content "2") + (lambda (value) (cl-incf calls) (setq seen value))))) + (should (= calls 1)) + (should (eq seen report)) + (should (eq (plist-get seen :framework-participant-state) + 'completed))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-final-accept-failure-rolls-framework-back () + "A TP final-accept failure rolls the paired framework pointer back once." + (dolist (mode '(full scoped)) + (let ((buffer (generate-new-buffer " *ebox-framework-accept-fail*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-column + (ebox-create :key 'a :host-ref 'a :content "old-a") + (ebox-create :key 'b :host-ref 'b :content "old-b"))) + (let* ((before (ebox-commit-test--buffer-string buffer)) + (candidate (ebox-candidate-begin buffer)) + trace captured failure) + (ebox-candidate-replace-host-ref + candidate 'a (ebox-create :key 'a :host-ref 'a :content "new-a")) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (_group) (error "accept failed")))) + (setq failure + (condition-case condition + (ebox-commit + buffer + (if (eq mode 'scoped) + candidate + (ebox-create :key 'root :content "new-root")) + (lambda (report) + (setq captured report) + (push 'publish trace)) + (lambda (_report) + (push 'rollback trace) + (signal 'quit nil))) + (error condition)))) + (should (equal (cadr failure) "accept failed")) + (should (equal trace '(rollback publish))) + (should (eq (plist-get captured :framework-participant-state) + 'rolled-back)) + (should (= (length + (plist-get captured + :framework-participant-diagnostics)) + 1)) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) before)) + (should (eq (plist-get + (ebox-commit + buffer (ebox-create :key 'root :content "next")) + :framework-participant-state) + 'completed)))) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + +(ert-deftest ebox-commit-records-scroll-diagnostics-before-completion () + "Contained scroll failures are separately reported and do not block retry." + (let ((buffer (generate-new-buffer " *ebox-scroll-diagnostics*")) + (diagnostics + '((:region-id one :phase scroll-finalization :action cancel + :condition (error "x")) + (:region-id one :phase scroll-finalization :action stop + :condition (quit))))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer (ebox-create :key 'root :content "0")) + (cl-letf + (((symbol-function + 'ebox-incremental--finalize-declarative-scroll-publication) + (lambda (&rest _arguments) diagnostics))) + (let ((report + (ebox-commit + buffer (ebox-create :key 'root :content "1")))) + (should (eq (plist-get report :framework-participant-state) + 'completed)) + (should (equal + (plist-get report :scroll-finalization-diagnostics) + diagnostics)))) + (should (eq (plist-get + (ebox-commit buffer + (ebox-create :key 'root :content "2")) + :framework-participant-state) + 'completed))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-restores-ebox-after-participant-owner-failure () + "A rollback-owner failure cannot skip restoration of Ebox runtime state." + (let ((buffer (generate-new-buffer " *ebox-participant-owner-failure*"))) + (unwind-protect + (progn + (ebox-render-to-buffer buffer (ebox-create :key 'root :content "old")) + (let* ((surface (with-current-buffer + buffer ebox-surface--buffer-surface)) + (old-state (tp-surface-client-state surface)) + (old-buffer (ebox-commit-test--buffer-string buffer)) + (original-report + (symbol-function 'ebox-surface--participant-report)) + rollback-called failure) + (cl-letf + (((symbol-function 'accept-change-group) + (lambda (_group) (error "primary accept failure"))) + ((symbol-function 'ebox-surface--participant-report) + (lambda (participant report state) + (prog1 (funcall original-report participant report state) + (when (and rollback-called (eq state 'rolled-back)) + (error "rollback owner failure")))))) + (setq failure + (condition-case condition + (ebox-commit + buffer (ebox-create :key 'root :content "new") + #'ignore + (lambda (_report) (setq rollback-called t))) + (error condition)))) + (should (equal (cadr failure) "primary accept failure")) + (should rollback-called) + (should + (tp--transaction-condition-trailer failure :rollback-failures)) + (should (eq (tp-surface-client-state surface) old-state)) + (should (eq (ebox--buffer-render-state buffer) old-state)) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) old-buffer)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(defun ebox-commit-test--mixed-owner-root + (left right paint-a paint-b paint-c) + "Return the raw sibling fixture for mixed geometry/paint publication." + (ebox-column + (ebox-create + :key 'geometry-context :width '(80) + :ebox-content-node + (ebox-column + (ebox-create :key 'left :host-ref 'left + :content left :font 'bold) + (ebox-create :key 'right :host-ref 'right + :content right))) + (ebox-create :key 'paint-a :host-ref 'paint-a + :content "paint-a" :color paint-a) + (ebox-create :key 'paint-b :host-ref 'paint-b + :content "paint-b" :bgcolor paint-b) + (ebox-create :key 'paint-c :host-ref 'paint-c + :content "paint-c" :color paint-c) + (ebox-create :key 'untouched :host-ref 'untouched + :content "untouched"))) + +(defun ebox-commit-test--mixed-owner-candidate + (buffer left right paint-a paint-b paint-c) + "Return BUFFER candidate replacing all mixed fixture owners." + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'left + (ebox-create :key 'left :host-ref 'left + :content left :font 'bold)) + (ebox-candidate-replace-host-ref + candidate 'right + (ebox-create :key 'right :host-ref 'right + :content right)) + (ebox-candidate-replace-host-ref + candidate 'paint-a + (ebox-create :key 'paint-a :host-ref 'paint-a + :content "paint-a" :color paint-a)) + (ebox-candidate-replace-host-ref + candidate 'paint-b + (ebox-create :key 'paint-b :host-ref 'paint-b + :content "paint-b" :bgcolor paint-b)) + (ebox-candidate-replace-host-ref + candidate 'paint-c + (ebox-create :key 'paint-c :host-ref 'paint-c + :content "paint-c" :color paint-c)) + candidate)) + +(ert-deftest ebox-commit-mixed-owner-reflow-is-atomic-and-round-trips () + "Geometry and color owners publish once without duplicating face layers." + (let ((buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-mixed-owner* ") + (ebox-commit-test--mixed-owner-root + "left-old" "right-old" "#111111" "#222222" "#333333")))) + (unwind-protect + (progn + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'left + (ebox-create :key 'left :host-ref 'left + :content "left-new" :font 'bold)) + (ebox-candidate-replace-host-ref + candidate 'right + (ebox-create :key 'right :host-ref 'right + :content "right-new")) + (ebox-candidate-replace-host-ref + candidate 'paint-a + (ebox-create :key 'paint-a :host-ref 'paint-a + :content "paint-a" :color "#AAAAAA")) + (ebox-candidate-replace-host-ref + candidate 'paint-b + (ebox-create :key 'paint-b :host-ref 'paint-b + :content "paint-b" :bgcolor "#BBBBBB")) + (ebox-candidate-replace-host-ref + candidate 'paint-c + (ebox-create :key 'paint-c :host-ref 'paint-c + :content "paint-c" :color "#CCCCCC")) + (let ((report (ebox-commit buffer candidate))) + (should (eq (plist-get report :projection-kind) + 'mixed-owner-reflow)) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback)) + (should-not + (member (ebox--buffer-root-node-id buffer) + (plist-get report :owner-ids))) + (should (= (plist-get report :created-objects) 0)) + (should (= (plist-get report :removed-objects) 0)) + (with-current-buffer buffer + (should + (equal-including-properties + (buffer-substring (point-min) (point-max)) + (ebox-render (ebox--buffer-root-node buffer))))))) + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'left + (ebox-create :key 'left :host-ref 'left + :content "left-old" :font 'bold)) + (ebox-candidate-replace-host-ref + candidate 'right + (ebox-create :key 'right :host-ref 'right + :content "right-old")) + (ebox-candidate-replace-host-ref + candidate 'paint-a + (ebox-create :key 'paint-a :host-ref 'paint-a + :content "paint-a" :color "#111111")) + (ebox-candidate-replace-host-ref + candidate 'paint-b + (ebox-create :key 'paint-b :host-ref 'paint-b + :content "paint-b" :bgcolor "#222222")) + (ebox-candidate-replace-host-ref + candidate 'paint-c + (ebox-create :key 'paint-c :host-ref 'paint-c + :content "paint-c" :color "#333333")) + (let ((report (ebox-commit buffer candidate))) + (should (eq (plist-get report :projection-kind) + 'mixed-owner-reflow)) + (with-current-buffer buffer + (should + (equal-including-properties + (buffer-substring (point-min) (point-max)) + (ebox-render (ebox--buffer-root-node buffer)))))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-mixed-owner-reflow-rolls-back-and-retries () + "Mixed publication restores the old pair after final-accept failure." + (let* ((buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-mixed-owner-rollback* ") + (ebox-commit-test--mixed-owner-root + "left-old" "right-old" "#111111" "#222222" "#333333"))) + (old-buffer (ebox-commit-test--buffer-string buffer)) + (candidate + (ebox-commit-test--mixed-owner-candidate + buffer "left-new" "right-new" "#AAAAAA" "#BBBBBB" "#CCCCCC"))) + (unwind-protect + (progn + (cl-letf (((symbol-function 'accept-change-group) + (lambda (_group) (error "mixed final accept")))) + (should-error (ebox-commit buffer candidate))) + (should (equal-including-properties + (ebox-commit-test--buffer-string buffer) old-buffer)) + (let ((retry + (ebox-commit-test--mixed-owner-candidate + buffer "left-new" "right-new" + "#AAAAAA" "#BBBBBB" "#CCCCCC"))) + (let ((report (ebox-commit buffer retry))) + (should (eq (plist-get report :projection-kind) + 'mixed-owner-reflow)) + (with-current-buffer buffer + (should + (equal-including-properties + (buffer-substring (point-min) (point-max)) + (ebox-render (ebox--buffer-root-node buffer)))))))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + (provide 'ebox-commit-tests) ;;; ebox-commit-tests.el ends here diff --git a/tests/ebox-core-render-tests.el b/tests/ebox-core-render-tests.el index 26bdf54..fd1a184 100644 --- a/tests/ebox-core-render-tests.el +++ b/tests/ebox-core-render-tests.el @@ -4324,6 +4324,43 @@ (ebox-render box)) (should (eq (gethash region-id ebox--scroll-global-state) state)))) +(ert-deftest ebox-flat-preformatted-blank-line-preserves-child-owner-segments () + "Blank composite child segments must retain their distinct ownership." + (ebox-test--reset-runtime-state) + (let* ((left + (propertize + (ebox-pixel-space 40) + 'ebox-content 'left 'ebox-content-idx 0 + 'ebox-content-owner 'left 'ebox-content-owners '(left))) + (right + (propertize + (ebox-pixel-space 60) + 'ebox-content 'right 'ebox-content-idx 0 + 'ebox-content-owner 'right 'ebox-content-owners '(right))) + (box (ebox-create :content "" :width 100 :wrap-mode nil + :color "#112233" :bgcolor "#DDEEFF")) + (rendered + (car + (ebox--window-render-flat-wrapper-chunk-lines + box (list (concat left right)) 0 'outer + (ebox-pixel-space 100) t t)))) + (should (= (length rendered) 2)) + (should (= (ebox--string-pixel-width rendered) 100)) + (should (eq (get-text-property 0 'ebox-content rendered) 'left)) + (should (eq (get-text-property 1 'ebox-content rendered) 'right)) + (should (equal (get-text-property 0 'ebox-content-owners rendered) + '(left outer))) + (should (equal (get-text-property 1 'ebox-content-owners rendered) + '(right outer))) + (should (eq (get-text-property 0 'ebox-content-owner rendered) 'outer)) + (should (eq (get-text-property 1 'ebox-content-owner rendered) 'outer)) + (dolist (position '(0 1)) + (let ((face (get-text-property position 'face rendered))) + (should (ebox-test--face-has-key-value-p + face :foreground "#112233")) + (should (ebox-test--face-has-key-value-p + face :background "#DDEEFF")))))) + (ert-deftest ebox-transparent-preformatted-fast-path-keeps-intrinsic-scroll-state () "Intrinsic transparent rendering must not clear the published scroll state." (ebox-test--reset-runtime-state) @@ -4426,6 +4463,34 @@ (should (= justify-count 3)) (should (= (ebox--string-max-pixel-width rendered) 140)))) +(ert-deftest ebox-box-content-node-publishes-only-proven-exact-width () + "A wrapper should mark child output exact only at its proven viewport width." + (ebox-test--reset-runtime-state) + (let* ((overflow-child + (ebox-column + (ebox-create :content "A" :width 140) + (ebox-create :content "B" :width 140))) + (overflow-parent + (ebox-create :width 120 :wrap-mode nil + :ebox-content-node overflow-child)) + (exact-child + (ebox-column + (ebox-create :content "A" :width 120) + (ebox-create :content "B" :width 120))) + (exact-parent + (ebox-create :width 120 :wrap-mode nil + :ebox-content-node exact-child)) + (ebox-viewport-width 120) + (ebox--box-content-render-cache (make-hash-table :test 'eq)) + overflow exact) + (setq overflow + (ebox--render-box-content-node overflow-parent overflow-child)) + (setq exact (ebox--render-box-content-node exact-parent exact-child)) + (should (= (ebox--string-max-pixel-width overflow) 140)) + (should-not (plist-get overflow-parent :ebox-content-width-exact-p)) + (should (= (ebox--string-max-pixel-width exact) 120)) + (should (plist-get exact-parent :ebox-content-width-exact-p)))) + (ert-deftest ebox-render-caches-lazy-box-content-within-render-pass () "A lazy child layout should be rendered once per box/context in one pass." (ebox-test--reset-runtime-state) @@ -7667,6 +7732,7 @@ (unwind-protect (let ((ebox-viewport-width 240) (ebox-viewport-height 12) + (ebox-wheel-scroll-step 16) (ebox-scroll-lazy-idle-prefetch-lines 0) (ebox-scroll-lazy-prefix-lookahead-lines 0)) (setq buffer @@ -8329,8 +8395,7 @@ `(box :content ,(format "complete %02d" idx) :width (100) :height 8))))) (limit 4) - (full-lines (mapcar #'substring-no-properties - (ebox-string-lines (ebox-render node)))) + (full-lines (ebox-string-lines (ebox-render node))) (complete-wrapper-count 0) (original-render-box-lines (symbol-function 'ebox--flex-window-render-box-lines))) @@ -8344,9 +8409,19 @@ (should window) (should-not (plist-get window :complete)) (should (= complete-wrapper-count 0)) - (should (equal (seq-take full-lines limit) - (mapcar #'substring-no-properties - (plist-get window :lines)))))))) + (should + (cl-every + (lambda (pair) + (let ((full (car pair)) + (prefix (cdr pair))) + (or (equal (substring-no-properties full) + (substring-no-properties prefix)) + (and (string-blank-p full) + (string-blank-p prefix) + (= (ebox--string-pixel-width full) + (ebox--string-pixel-width prefix)))))) + (cl-mapcar #'cons (seq-take full-lines limit) + (plist-get window :lines)))))))) (ert-deftest ebox-flex-window-complete-extension-appends-bottom-border () "Completing a cached flex prefix should append bottom border without full render." @@ -9113,7 +9188,9 @@ (original-render-box (symbol-function 'ebox--render-box))) (unwind-protect (let ((ebox-viewport-width 240) - (ebox-viewport-height 2)) + (ebox-viewport-height 2) + (ebox-wheel-scroll-step 16) + (ebox-wheel-smooth-scroll t)) (cl-letf (((symbol-function 'ebox--render-box) (lambda (box) (when (equal (ebox-tree-node-id box) "row-30") @@ -9135,7 +9212,9 @@ (should (ebox--scroll-region-by root-id 31)) (should (= hidden-render-count 0)) (should (gethash root-id ebox--scroll-idle-prefetch-timers)) - (ebox--scroll-idle-prefetch root-id) + (dotimes (_ 40) + (when (= hidden-render-count 0) + (ebox--scroll-idle-prefetch root-id))) (should (> hidden-render-count 0)) (let* ((state (ebox--scroll-get-state root-id)) (delta (- 30 (or (plist-get state :scroll-offset) @@ -10627,6 +10706,7 @@ (unwind-protect (let ((ebox-viewport-width 240) (ebox-viewport-height 2) + (ebox-wheel-scroll-step 16) (ebox-wheel-smooth-scroll-lines-per-tick 4) (ebox-wheel-smooth-scroll-interval 60.0)) (setq buffer @@ -10984,7 +11064,8 @@ (original-render-box (symbol-function 'ebox--render-box))) (unwind-protect (let ((ebox-viewport-width 240) - (ebox-viewport-height 2)) + (ebox-viewport-height 2) + (ebox-wheel-scroll-step 16)) (cl-letf (((symbol-function 'ebox--render-box) (lambda (box) (when (equal (ebox-tree-node-id box) "row-30") @@ -11867,6 +11948,130 @@ (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-visible-buffer-rearms-native-scroll-prewarm () + "A buffer rendered off-window should switch to native scrolling when shown." + (ebox-test--reset-runtime-state) + (let ((buffer nil) + (scheduled 0) + (fake-window 'ebox-test-window)) + (unwind-protect + (let ((ebox--runtime-prewarm-allow-noninteractive t) + (ebox-native-buffer-scroll t) + ;; The production hook is intentionally GUI-only. Bind the + ;; flag for this lifecycle test and stub the window primitives. + (noninteractive nil)) + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-visible-prewarm*") + (ebox-build + '(box :id "root" :height 2 :overflow scroll + (column + (box :content "one" :height 1) + (box :content "two" :height 1) + (box :content "three" :height 1)))))) + ;; Rendering happened before the buffer had a window, so the + ;; original job is allowed to finish without native materializing. + (ebox--runtime-prewarm-drain buffer) + (should-not (plist-get (ebox--buffer-render-state buffer) + :native-buffer-scroll-p)) + (cl-letf (((symbol-function 'window-live-p) + (lambda (window) (eq window fake-window))) + ((symbol-function 'window-buffer) + (lambda (_window) buffer)) + ((symbol-function 'get-buffer-window) + (lambda (candidate &optional _frame) + (and (eq candidate buffer) fake-window))) + ((symbol-function 'ebox--viewport-dependent-subtree-p) + (lambda (&rest _) nil)) + ((symbol-function + 'ebox--viewport-height-dependent-subtree-p) + (lambda (&rest _) nil)) + ((symbol-function 'ebox--schedule-buffer-runtime-prewarm) + (lambda (candidate &optional _delay _retained-only-p) + (should (eq candidate buffer)) + (cl-incf scheduled)))) + (let ((render-state (ebox--buffer-render-state buffer))) + ;; This fixture stands for a viewport-independent root; the + ;; production proof consumes the published axes in O(1). + (plist-put render-state :viewport-dependent-node-ids-ready t) + (plist-put render-state :viewport-dependent-node-id-axes + (list nil)) + (let ((job (ebox--runtime-prewarm-new-job + buffer render-state))) + (should (eq (plist-get job :phase) 'native-scroll)) + (should (plist-get job :native-scroll-region-id)))) + (ebox--window-buffer-change fake-window)) + (should (= scheduled 1))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-native-scroll-prewarm-is-isolated-from-updates () + "Ordinary runtime prewarm must not materialize a native scroll surface. +Native-window scrolling remains enabled, but only the initial display or an +explicit visible-window handoff may admit its full-content publication." + (ebox-test--reset-runtime-state) + (let ((buffer nil)) + (unwind-protect + (let ((noninteractive nil) + (ebox--runtime-prewarm-allow-noninteractive t) + (ebox-native-buffer-scroll t)) + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-native-scroll-opt-in*") + (ebox-build + '(box :id "root" :height 2 :overflow scroll + (column + (box :content "one" :height 1) + (box :content "two" :height 1) + (box :content "three" :height 1)))))) + (let ((state (ebox--buffer-render-state buffer))) + (cl-letf (((symbol-function + 'ebox--native-buffer-scroll-root-region-id) + (lambda (&rest _) 1)) + ((symbol-function + 'ebox--native-buffer-scroll-root-proof-p) + (lambda (&rest _) t))) + (let ((job (ebox--runtime-prewarm-new-job buffer state t))) + (should (eq (plist-get job :phase) 'snapshots)) + (should-not (plist-get job :native-scroll-region-id))) + (let ((job (ebox--runtime-prewarm-new-job buffer state nil))) + (should (eq (plist-get job :phase) 'native-scroll)) + (should (= (plist-get job :native-scroll-region-id) 1)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-native-scroll-rejects-viewport-dependent-root () + "Native full-content materialization must not freeze a resizable root." + (ebox-test--reset-runtime-state) + (let ((buffer nil) + (fake-window 'ebox-test-window)) + (unwind-protect + (let ((noninteractive nil) + (ebox-viewport-width 120) + (ebox-viewport-height 2) + (ebox-native-buffer-scroll t)) + (setq buffer + (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-native-scroll-viewport*") + (ebox-build + '(box :id "root" :width (viewport) :height 2 + :overflow scroll + (column + (box :content "one" :height 1) + (box :content "two" :height 1) + (box :content "three" :height 1)))))) + (let* ((state (ebox--buffer-render-state buffer)) + (region-id (car (plist-get state :scroll-region-ids)))) + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) fake-window)) + ((symbol-function 'window-live-p) + (lambda (window) (eq window fake-window)))) + (should-not + (ebox--native-buffer-scroll-root-proof-p + buffer region-id state))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + (ert-deftest ebox-runtime-idle-prewarm-does-not-wait-for-prefix-prefetch () "Prewarm should index current scroll lines while lazy prefix work is active." (ebox-test--reset-runtime-state) @@ -12578,11 +12783,241 @@ (should (ebox--scroll-first-region-by '(stalled active) 1))) (should (equal (nreverse visited) '(stalled active))))) +(ert-deftest ebox-scroll-intent-distributes-forward-residual-inner-to-buffer () + "A positive line intent should drain inner, parent, then native buffer." + (let ((capacity '((inner . 1) (middle . 2) (outer . 0))) + native-residual) + (cl-letf (((symbol-function 'ebox--scroll-region-by) + (lambda (region-id delta &optional _prefix-budget-lines) + (let* ((available (alist-get region-id capacity)) + (consumed (min delta available))) + (setf (alist-get region-id capacity) (- available consumed)) + consumed)))) + (let ((result + (ebox--scroll-consume-intent + (ebox--scroll-intent-create 5 '(inner middle outer)) + (lambda (delta) (setq native-residual delta))))) + (should (= (plist-get result :requested) 5)) + (should (equal (plist-get result :consumption) + '((inner . 1) (middle . 2) (outer . 0)))) + (should (= (plist-get result :ebox-consumed) 3)) + (should (= (plist-get result :native-residual) 2)) + (should (= native-residual 2)))))) + +(ert-deftest ebox-scroll-intent-distributes-reverse-residual-inner-to-buffer () + "A negative line intent should preserve direction through the owner chain." + (let ((capacity '((inner . 1) (middle . 2) (outer . 0))) + native-residual) + (cl-letf (((symbol-function 'ebox--scroll-region-by) + (lambda (region-id delta &optional _prefix-budget-lines) + (let* ((available (alist-get region-id capacity)) + (magnitude (min (- delta) available)) + (consumed (- magnitude))) + (setf (alist-get region-id capacity) (- available magnitude)) + consumed)))) + (let ((result + (ebox--scroll-consume-intent + (ebox--scroll-intent-create -5 '(inner middle outer)) + (lambda (delta) (setq native-residual delta))))) + (should (equal (plist-get result :consumption) + '((inner . -1) (middle . -2) (outer . 0)))) + (should (= (plist-get result :ebox-consumed) -3)) + (should (= (plist-get result :native-residual) -2)) + (should (= native-residual -2)))))) + +(ert-deftest ebox-scroll-intent-distributes-real-nested-owner-capacity () + "Nested boxes should consume their capacity before the native buffer." + (ebox-test--reset-runtime-state) + (let ((layout + (ebox-build + '(box :id "outer" :height 4 :overflow scroll + (column + (box :id "middle" :height 2 :overflow scroll + (column + (box :id "inner" :content "inner 0\ninner 1" + :height 1 :overflow scroll) + (box :content "middle 0" :height 1) + (box :content "middle 1" :height 1) + (box :content "middle 2" :height 1))) + (box :content "outer 0\nouter 1" :height 2)))))) + (ebox-test--with-rendered-buffer layout + (let* ((surface (with-current-buffer + (current-buffer) ebox-surface--buffer-surface)) + (revision (tp-surface-revision surface)) + (inner-id (ebox-test--selector-region-id + (current-buffer) "#inner")) + (middle-id (ebox-test--selector-region-id + (current-buffer) "#middle")) + (outer-id (ebox-test--selector-region-id + (current-buffer) "#outer")) + native-lines) + (should (ebox-scroll-state inner-id)) + (should (ebox-scroll-state middle-id)) + (should-not (ebox-scroll-state outer-id)) + (goto-char (point-min)) + (search-forward "inner 0") + (backward-char) + (cl-letf (((symbol-function 'scroll-up) + (lambda (lines) (setq native-lines lines)))) + (ebox-scroll-down 5)) + ;; Each owner is currently a separately committed retained surface + ;; update; the later atomic multi-owner scroll transaction will reduce + ;; this to one revision without changing the consumption contract. + (should (= (tp-surface-revision surface) (+ revision 2))) + (should (= (plist-get (ebox-scroll-state inner-id) :scroll-offset) 1)) + (should (= (plist-get (ebox-scroll-state middle-id) :scroll-offset) 2)) + (should-not (ebox-scroll-state outer-id)) + (should (= native-lines 2)) + (setq native-lines nil) + (ebox--scroll-consume-intent + (ebox--scroll-intent-create -5 + (list inner-id middle-id outer-id)) + (lambda (residual) (setq native-lines residual))) + (should (= (plist-get (ebox-scroll-state inner-id) :scroll-offset) 0)) + (should (= (plist-get (ebox-scroll-state middle-id) :scroll-offset) 0)) + (should-not (ebox-scroll-state outer-id)) + (should (= native-lines -2)))))) + +(ert-deftest ebox-scroll-intent-refresh-at-boundary-does-not-swallow-input () + "Refreshing unchanged pixels should leave the complete line intent residual." + (let (native-residual) + (cl-letf (((symbol-function 'ebox--scroll-region-by) + (lambda (&rest _) 'refreshed))) + (let ((result + (ebox--scroll-consume-intent + (ebox--scroll-intent-create 1 '(inner)) + (lambda (delta) (setq native-residual delta))))) + (should (equal (plist-get result :consumption) '((inner . 0)))) + (should (= (plist-get result :ebox-consumed) 0)) + (should (= (plist-get result :native-residual) 1)) + (should (= native-residual 1)))))) + +(ert-deftest ebox-scroll-intent-pending-prefix-does-not-swallow-input () + "An unfulfilled lazy-prefix request should leave its line intent residual." + (let (native-residual) + (cl-letf (((symbol-function 'ebox--scroll-region-by) + (lambda (&rest _) 'pending))) + (let ((result + (ebox--scroll-consume-intent + (ebox--scroll-intent-create 3 '(inner parent)) + (lambda (delta) (setq native-residual delta))))) + (should (equal (plist-get result :consumption) + '((inner . 0) (parent . 0)))) + (should (= (plist-get result :ebox-consumed) 0)) + (should (= (plist-get result :native-residual) 3)) + (should (= native-residual 3)))))) + +(ert-deftest ebox-scroll-intent-anchor-routes-keyboard-and-wheel-independently () + "Keyboard anchors at point while wheel anchors at the event position." + (cl-letf (((symbol-function 'ebox--scroll-region-ids-at-point) + (lambda () '(point-inner point-outer))) + ((symbol-function 'ebox--wheel-region-ids) + (lambda (_event) '(wheel-inner wheel-outer)))) + (should (equal (plist-get (ebox--scroll-intent-at-point 1) :chain) + '(point-inner point-outer))) + (should (equal (plist-get + (ebox--scroll-intent-at-event 'fake-event 1) :chain) + '(wheel-inner wheel-outer))))) + +(ert-deftest ebox-scroll-intent-native-fallback-preserves-direction-and-count () + "Keyboard residuals should call the matching native command exactly once." + (let (native-up native-down) + (cl-letf (((symbol-function 'ebox--scroll-region-ids-at-point) + (lambda () '(inner))) + ((symbol-function 'ebox--scroll-region-by) + (lambda (_region-id delta &optional _budget) + (if (> delta 0) 1 -1))) + ((symbol-function 'scroll-up) + (lambda (lines) (setq native-up lines))) + ((symbol-function 'scroll-down) + (lambda (lines) (setq native-down lines)))) + (ebox-scroll-down 3) + (ebox-scroll-up 3)) + (should (= native-up 2)) + (should (= native-down 2)))) + +(ert-deftest ebox-wheel-partial-residual-uses-exact-native-direction () + "A partial wheel residual should not replay the complete wheel event." + (let (native-up native-down mwheel-called) + (cl-letf (((symbol-function 'event-start) + (lambda (_event) (list (selected-window) (point-min)))) + ((symbol-function 'scroll-up) + (lambda (lines) (setq native-up lines))) + ((symbol-function 'scroll-down) + (lambda (lines) (setq native-down lines))) + ((symbol-function 'mwheel-scroll) + (lambda (&rest _) (setq mwheel-called t)))) + (ebox--wheel-native-residual 'event 2 5 nil) + (ebox--wheel-native-residual 'event -3 -5 nil)) + (should (= native-up 2)) + (should (= native-down 3)) + (should-not mwheel-called))) + +(ert-deftest ebox-wheel-smooth-boundary-defers-to-residual-chain () + "Smooth mode should use the chain allocator when an owner cannot finish." + (let ((ebox-wheel-smooth-scroll t) + (capacity '((inner . 1) (parent . 2))) + native-residual + smooth-called) + (cl-letf (((symbol-function 'ebox--scroll-intent-at-event) + (lambda (_event delta) + (ebox--scroll-intent-create delta '(inner parent)))) + ((symbol-function 'ebox--first-scrollable-region) + (lambda (&rest _) 'inner)) + ((symbol-function 'ebox--scroll-region-can-consume-complete-p) + (lambda (&rest _) nil)) + ((symbol-function 'ebox--smooth-scroll-region-by) + (lambda (&rest _) (setq smooth-called t))) + ((symbol-function 'ebox--scroll-region-by) + (lambda (region-id delta &optional _budget) + (let* ((available (alist-get region-id capacity)) + (consumed (min delta available))) + (setf (alist-get region-id capacity) (- available consumed)) + consumed))) + ((symbol-function 'ebox--wheel-native-residual) + (lambda (_event residual _requested _arg) + (setq native-residual residual)))) + (ebox--wheel-scroll 'event 5 nil t)) + (should-not smooth-called) + (should (= native-residual 2)))) + +(ert-deftest ebox-scroll-mount-fallback-orders-equal-spans-deterministically () + "Equal mounted spans should use semantic depth and a stable id tie-break." + (let ((ebox--scroll-global-state (make-hash-table :test 'equal))) + (puthash 'z-owner t ebox--scroll-global-state) + (puthash 'a-owner t ebox--scroll-global-state) + (cl-letf (((symbol-function 'ebox-surface-region-bounds) + (lambda (&rest _) '(1 . 5))) + ((symbol-function 'ebox--scroll-region-semantic-depth) + (lambda (_region-id) 2))) + (should (equal (ebox--scroll-region-ids-in-mounts-at-pos 2) + '(a-owner z-owner)))))) + +(ert-deftest ebox-scroll-fast-report-uses-boolean-proof-flag () + "Retained-window proof payload should not leak into the public report." + (ebox-test--reset-runtime-state) + (let ((layout (ebox-build + '(box :id "root" :content "A\nB" + :height 1 :overflow scroll)))) + (ebox-test--with-rendered-buffer layout + (let ((region-id (ebox-test--selector-region-id + (current-buffer) "#root"))) + (should (= (ebox--scroll-region-by region-id 1) 1)) + (let ((flag (plist-get (ebox-test--buffer-update-report) + :scroll-patch-fast-p))) + (should (memq flag '(nil t)))))))) + +(ert-deftest ebox-scroll-defaults-follow-one-line-native-buffer-scrolling () + "Default wheel input should be one immediate document line." + (should (= ebox-wheel-scroll-step 1)) + (should-not ebox-wheel-smooth-scroll)) + (ert-deftest ebox-scroll-progress-requires-real-delta-or-pending () "Scroll progress is either a non-zero consumed line count or lazy pending." (should (ebox--scroll-progress-p 1)) (should (ebox--scroll-progress-p -1)) (should (ebox--scroll-progress-p 'pending)) + (should-not (ebox--scroll-progress-p 'refreshed)) (should-not (ebox--scroll-progress-p 0)) (should-not (ebox--scroll-progress-p nil))) diff --git a/tests/ebox-docs-contract-tests.el b/tests/ebox-docs-contract-tests.el index e0d2486..ad6fba0 100644 --- a/tests/ebox-docs-contract-tests.el +++ b/tests/ebox-docs-contract-tests.el @@ -18,12 +18,12 @@ (defconst ebox-docs-test--active-files '("Makefile" ".github/workflows/ci.yml" - "ebox.el" "ebox-cache.el" "ebox-style.el" "ebox-tree.el" + "ebox.el" "ebox-cache.el" "ebox-style.el" "ebox-child-range.el" "ebox-tree.el" "ebox-measure.el" "ebox-fragment.el" "ebox-render-context.el" "ebox-layout.el" "ebox-flex.el" "ebox-grid.el" "ebox-buffer-backend.el" "ebox-incremental.el" "ebox-surface.el" "ebox-dsl.el" "ebox-selector.el" "ebox-native-reflow.el" - "tests/ebox-core-render-tests.el" "tests/ebox-grid-tests.el" + "tests/ebox-core-render-tests.el" "tests/ebox-child-range-tests.el" "tests/ebox-grid-tests.el" "tests/ebox-commit-tests.el" "tests/ebox-surface-tests.el" "tests/ebox-dsl-tests.el" "tests/ebox-flex-tests.el" "tests/ebox-selector-tests.el" "tests/ebox-package-tests.el" @@ -37,7 +37,7 @@ "Active Ebox files that the maintainer map must cover.") (defconst ebox-docs-test--targets - '("check" "ci" "load" "compile" "core-tests" "grid-tests" + '("check" "ci" "load" "compile" "core-tests" "child-range-tests" "grid-tests" "ebox-commit-tests" "surface-tests" "visual-check-tests" "package-tests" "selector-tests" "dsl-tests" "flex-tests" "docs-contract-tests" "ci-contract-tests" "performance-evaluator" diff --git a/tests/ebox-grid-tests.el b/tests/ebox-grid-tests.el index c51e5d0..b1ef77f 100644 --- a/tests/ebox-grid-tests.el +++ b/tests/ebox-grid-tests.el @@ -37,6 +37,22 @@ (should (= (length lines) 1)) (should (= (ebox--string-pixel-width (car lines)) 120)))) +(ert-deftest ebox-grid-stretch-children-fill-fractional-tracks () + "Stretch-width children must reflow to their assigned fractional tracks." + (let* ((left (ebox-create :content "left" :width 'stretch)) + (calls 0) + (entry-left (list :node left :column 1 :column-span 1)) + (rendered (make-hash-table :test #'eq))) + (puthash left "left" rendered) + (cl-letf (((symbol-function 'ebox--render-with-cache) + (lambda (&rest _) + (cl-incf calls) + "track-width"))) + (should (equal "track-width" + (ebox-grid--entry-source + entry-left rendered 100 '(:justify-items stretch)))) + (should (= calls 1))))) + (ert-deftest ebox-grid-constrains-auto-width-children-to-track-size () "Auto-width grid children should render within their assigned track." (let* ((ebox-viewport-width 120) diff --git a/tests/ebox-package-tests.el b/tests/ebox-package-tests.el index b363be0..be0b503 100644 --- a/tests/ebox-package-tests.el +++ b/tests/ebox-package-tests.el @@ -65,7 +65,8 @@ (should (commandp 'ebox-byte-compile)) (should (equal ebox--compile-sources - '("ebox-cache.el" "ebox-style.el" "ebox-tree.el" "ebox-measure.el" + '("ebox-cache.el" "ebox-style.el" "ebox-child-range.el" + "ebox-tree.el" "ebox-measure.el" "ebox-fragment.el" "ebox-render-context.el" "ebox-layout.el" "ebox-flex.el" "ebox-grid.el" "ebox-buffer-backend.el" "ebox-incremental.el" "ebox-surface.el" "ebox-dsl.el" "ebox-selector.el" "ebox.el" @@ -163,7 +164,10 @@ ebox-build ebox-buffer-mode ebox-candidate-begin + ebox-child-range ebox-candidate-replace + ebox-candidate-replace-range-ref + ebox-candidate-replace-root ebox-candidate-replace-host-ref ebox-clear-cache ebox-column diff --git a/tests/ebox-surface-tests.el b/tests/ebox-surface-tests.el index 5a46211..1c3028a 100644 --- a/tests/ebox-surface-tests.el +++ b/tests/ebox-surface-tests.el @@ -27,6 +27,135 @@ (propertize "Open" 'keymap map 'mouse-face 'highlight 'help-echo "Open this item"))) +(ert-deftest ebox-range-ref-present-p-is-a-read-only-boundary-query () + "Expose mounted Range anchor presence without leaking runtime tables." + (let ((buffer (generate-new-buffer " *ebox-range-anchor-query*")) + (table (make-hash-table :test #'equal))) + (unwind-protect + (progn + (puthash 'probe 'record table) + (cl-letf (((symbol-function 'ebox--buffer-render-state) + (lambda (_buffer) + (list :range-ref-table table)))) + (should (equal 'record + (ebox-range-ref-present-p buffer 'probe))) + (should-not (ebox-range-ref-present-p buffer 'missing)))) + (kill-buffer buffer)))) + +(ert-deftest ebox-surface-context-initializes-from-live-window () + "Use live window dimensions only when no explicit viewport is bound." + (let ((buffer (generate-new-buffer " *ebox-live-viewport-test*")) + (noninteractive nil) + (ebox-viewport-width nil) (ebox-viewport-height nil)) + (unwind-protect + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) nil)) + ((symbol-function 'window-body-width) + (lambda (_window pixelwise) + (should pixelwise) + 777)) + ((symbol-function 'window-pixel-width) + (lambda (_window) + (error "Window outer width must not be sampled"))) + ((symbol-function 'window-body-height) + (lambda (_window) 31))) + (let ((values (ebox-surface--context-values buffer nil nil))) + (should (= 776 (plist-get values :viewport-width))) + (should (= 31 (plist-get values :viewport-height))))) + (kill-buffer buffer)))) + +(ert-deftest ebox-surface-context-keeps-headless-viewport-nil () + "Keep viewport dimensions nil when BUFFER has no live window." + (let ((buffer (generate-new-buffer " *ebox-headless-viewport-test*")) + (ebox-viewport-width nil) (ebox-viewport-height nil)) + (unwind-protect + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) nil))) + (let ((values (ebox-surface--context-values buffer nil nil))) + (should-not (plist-get values :viewport-width)) + (should-not (plist-get values :viewport-height)))) + (kill-buffer buffer)))) + +(ert-deftest ebox-surface-context-rejects-half-width-pixelwise-report () + "Use the outer pixel width when a GUI body query returns a half-width." + (let ((buffer (generate-new-buffer " *ebox-half-width-viewport-test*")) + (noninteractive nil) + (ebox-viewport-width nil) (ebox-viewport-height nil)) + (unwind-protect + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) nil)) + ((symbol-function 'window-body-width) + (lambda (_window pixelwise) + (should pixelwise) + 715)) + ((symbol-function 'window-pixel-width) + (lambda (_window) 1430)) + ((symbol-function 'window-body-height) + (lambda (_window) 62))) + (let ((values (ebox-surface--context-values buffer nil nil))) + (should (= 1429 (plist-get values :viewport-width))) + (should (= 62 (plist-get values :viewport-height))))) + (kill-buffer buffer)))) + +(ert-deftest ebox-surface-context-prefers-selected-target-window () + "Ignore stale cross-frame lookup when selected window shows BUFFER." + (let* ((buffer (generate-new-buffer " *ebox-selected-viewport-test*")) + (window (selected-window)) + (old-buffer (window-buffer window)) + (ebox-viewport-width nil) (ebox-viewport-height nil)) + (unwind-protect + (progn + (set-window-buffer window buffer) + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) + (error "Stale cross-frame lookup must not run"))) + ((symbol-function 'window-body-width) + (lambda (candidate pixelwise) + (should (eq candidate window)) + (should pixelwise) + 1400)) + ((symbol-function 'window-body-height) + (lambda (candidate) + (should (eq candidate window)) + 60))) + (let ((values (ebox-surface--context-values buffer nil nil))) + (should (= 1399 (plist-get values :viewport-width))) + (should (= 60 (plist-get values :viewport-height)))))) + (when (window-live-p window) (set-window-buffer window old-buffer)) + (kill-buffer buffer)))) + +(ert-deftest ebox-surface-context-prefers-current-frame-over-stale-frame () + "Do not resize a live surface from an older client frame's window." + (let ((buffer (generate-new-buffer " *ebox-current-frame-viewport-test*")) + (noninteractive nil) + (ebox-viewport-width nil) (ebox-viewport-height nil)) + (unwind-protect + (cl-letf (((symbol-function 'selected-window) + (lambda () 'selected-window)) + ((symbol-function 'window-live-p) + (lambda (_window) t)) + ((symbol-function 'window-buffer) + (lambda (_window) (get-buffer-create " *other-window*"))) + ((symbol-function 'selected-frame) + (lambda () 'current-frame)) + ((symbol-function 'get-buffer-window) + (lambda (_buffer frame) + (if (eq frame 'current-frame) + 'current-frame-window + 'stale-frame-window))) + ((symbol-function 'window-body-width) + (lambda (window pixelwise) + (should pixelwise) + (if (eq window 'current-frame-window) 901 333))) + ((symbol-function 'window-body-height) + (lambda (_window) 31))) + (let ((values (ebox-surface--context-values buffer nil nil))) + (should (= 900 (plist-get values :viewport-width))) + (should (= 31 (plist-get values :viewport-height))))) + (kill-buffer buffer) + (when (get-buffer " *other-window*") + (kill-buffer " *other-window*"))))) + (defun ebox-surface-test--hash-fingerprint (table) "Return a stable content fingerprint for hash TABLE. The fingerprint checks entries rather than only table identity, so a failed @@ -223,6 +352,52 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (ebox--render-owned-text-value-p 'face (get-text-property 0 'face rendered))))) +(ert-deftest ebox-surface-paint-origin-captures-before-composition () + "Capture caller face once before Ebox adds a paint contribution." + (let* ((caller-face '(:weight bold)) + (rendered (propertize "x" 'face caller-face)) + (ebox--paint-origin-capture-p t)) + (ebox--add-render-face! rendered 0 1 '(:foreground "red") t) + (let ((origin (get-text-property 0 ebox--paint-origin-property rendered))) + (should (ebox--paint-origin-p origin)) + (should (equal caller-face + (ebox--paint-origin-baseline origin))) + (should (equal (list caller-face '(:foreground "red")) + (get-text-property 0 'face rendered)))) + ;; A nested contribution must not replace the original caller baseline. + (ebox--add-render-face! rendered 0 1 '(:background "blue") t) + (should (equal caller-face + (ebox--paint-origin-baseline + (get-text-property 0 ebox--paint-origin-property + rendered)))))) + +(ert-deftest ebox-surface-paint-address-is-semantic-and-ordered () + "Paint ledger addresses use owner facts, content index, and local order." + (let ((rendered (copy-sequence "ab"))) + (put-text-property 0 1 'ebox-content-owner 7 rendered) + (put-text-property 0 1 'ebox-content-idx 3 rendered) + (put-text-property 0 1 'ebox-content-owners '(7 2) rendered) + (put-text-property 0 1 'face 'bold rendered) + (put-text-property 1 2 'ebox-content-owner 7 rendered) + (put-text-property 1 2 'ebox-content-idx 3 rendered) + (put-text-property 1 2 'ebox-content-owners '(7 2) rendered) + (put-text-property 1 2 'face 'italic rendered) + (let* ((origin (ebox--paint-origin-create :baseline '(:weight bold))) + (_ (put-text-property 0 2 ebox--paint-origin-property + origin rendered)) + (fragments (ebox-surface--rendered-fragments rendered)) + (first (car fragments)) + (second (cadr fragments)) + (address (plist-get first :paint-address))) + (should (= (length fragments) 2)) + (should (equal (plist-get address :content-owner) 7)) + (should (= (plist-get address :content-index) 3)) + (should (= (plist-get address :ordinal) 0)) + (should (= (plist-get (plist-get second :paint-address) :ordinal) 1)) + (should (equal (plist-get first :face-baseline) '(:weight bold))) + (should (plist-get first :face-baseline-known-p)) + (should-not (get-text-property 0 ebox--paint-origin-property rendered))))) + (ert-deftest ebox-surface-candidate-plan-copies-face-property-values () "Candidate plans isolate mutable face values despite provenance hints." (let* ((color (copy-sequence "#192233")) @@ -1110,15 +1285,19 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (kill-buffer buffer))))) (ert-deftest ebox-viewport-reflow-falls-back-for-scroll-and-visible-overflow () - "Scroll state and visible overflow must not enter retained reflow." + "Nested scroll state and visible overflow must not enter retained reflow." (dolist (fixture (list - (cons 'scroll + (cons 'nested-scroll (lambda () - (ebox-create :content "zero\none\ntwo" + (ebox-create :content "outer" :width '(viewport) :height 2 - :overflow 'scroll))) + :overflow 'scroll + :ebox-content-node + (ebox-create :content "zero\none\ntwo" + :height 2 + :overflow 'scroll)))) (cons 'visible-overflow (lambda () (ebox-create :content "one\ntwo" @@ -1147,6 +1326,47 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (when (buffer-live-p buffer) (kill-buffer buffer)))))) +(ert-deftest ebox-viewport-reflow-retains-viewport-dependent-root-scroll () + "A sole root scroll owner may reflow its own viewport-dependent content." + (ebox-surface-test--reset-render-state) + (let ((buffer (generate-new-buffer " *ebox-viewport-root-scroll*")) + (ensured-node-count 0) + (original-ensure (symbol-function 'ebox-surface--ensure-node-tree))) + (unwind-protect + (let ((ebox-viewport-width 160) + (ebox-viewport-height 2) + (ebox-runtime-idle-prewarm nil) + (ebox-runtime-idle-reflow-cache-prewarm nil)) + (ebox-render-to-buffer + buffer + (ebox-create :key 'root-scroll + :content "zero\none\ntwo\nthree" + :width '(viewport) + :height '(viewport-height) + :overflow 'scroll)) + (cl-letf (((symbol-function 'ebox-surface--ensure-node-tree) + (lambda (&rest args) + (cl-incf ensured-node-count) + (apply original-ensure args)))) + (ebox-rerender-buffer-with-context buffer 240 2)) + (let* ((state (ebox--buffer-render-state buffer)) + (report (ebox-buffer-update-report buffer)) + (expected + (let ((ebox-viewport-width 240) + (ebox-viewport-height 2)) + (ebox-render (plist-get state :root-node)))) + (actual + (with-current-buffer buffer + (buffer-substring (point-min) (point-max))))) + (should (= ensured-node-count 0)) + (should (eq (plist-get report :projection-kind) + 'viewport-reflow)) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback)) + (should (equal-including-properties actual expected)))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + (ert-deftest ebox-viewport-reflow-supports-height-and-both-axis-resize () "Retained viewport reflow should cover height-only and two-axis changes." (dolist (case @@ -1400,6 +1620,200 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-style-theme-delta-reuses-cascade-facts () + "Copy a paint-only Theme delta without rerunning ECSS cascade computation." + (let* ((subject (ecss-subject-create :type "box")) + (old-declarations + '(ebox/width (100) ebox/color "#252A2E" + ebox/background-color "#F8F5EE")) + (new-declarations + '(ebox/width (100) ebox/color "#F2EEE4" + ebox/background-color "#1B1F20")) + (old-style + (ebox-style-compute-subject subject old-declarations)) + (delta + (ebox-style--theme-delta-computed + old-style old-declarations new-declarations))) + (should (ecss-computed-style-p delta)) + (should-not (eq old-style delta)) + (should (equal "#F2EEE4" + (ecss-computed-style-value delta 'ebox/color))) + (should (equal "#1B1F20" + (ecss-computed-style-value + delta 'ebox/background-color))) + (should (equal (ecss-computed-style-value old-style 'ebox/width) + (ecss-computed-style-value delta 'ebox/width))) + (should-not + (ebox-style--theme-delta-computed + old-style old-declarations + (plist-put (copy-sequence new-declarations) 'ebox/width '(120)))))) + +(ert-deftest ebox-style-theme-delta-propagates-inherited-color () + "Copy a proven inherited Theme color without rerunning ECSS. +The child has no explicit color declaration; only its static parent color +changes. Geometry and non-inherited computed values must remain identical." + (let* ((parent (ecss-subject-create :type "box")) + (child (ecss-subject-create :type "box" :parent parent)) + (parent-old + (ebox-style-compute-subject parent '(ebox/color "#111111"))) + (parent-new + (ebox-style-compute-subject parent '(ebox/color "#222222"))) + (declarations '(ebox/width (100) ebox/background-color "#eeeeee")) + (style + (ebox-style-compute-subject child declarations parent-old)) + (delta + (ebox-style--theme-inherited-delta-computed + style declarations parent-old parent-new))) + (should (ecss-computed-style-p delta)) + (should (equal "#222222" + (ecss-computed-style-value delta 'ebox/color))) + (should (equal (ecss-computed-style-value style 'ebox/width) + (ecss-computed-style-value delta 'ebox/width))) + (should (equal (ecss-computed-style-value style 'ebox/background-color) + (ecss-computed-style-value + delta 'ebox/background-color))))) + +(ert-deftest ebox-style-theme-parent-delta-reuses-explicit-child-style () + "Reuse an explicit child style when only its static parent Theme changes." + (let* ((parent (ecss-subject-create :type "box")) + (child (ecss-subject-create :type "box" :parent parent)) + (parent-old + (ebox-style-compute-subject parent '(ebox/color "#111111"))) + (parent-new + (ebox-style-compute-subject parent '(ebox/color "#222222"))) + (declarations '(ebox/color "#ffffff" ebox/width (100))) + (style + (ebox-style-compute-subject child declarations parent-old)) + (delta + (ebox-style--theme-parent-delta-computed + style declarations parent-old parent-new))) + (should (ecss-computed-style-p delta)) + (should (equal (ecss-computed-style-values style) + (ecss-computed-style-values delta))) + (let ((parent-font-new + (ebox-style-compute-subject + parent '(ebox/color "#222222" ebox/font-height 2.0)))) + (should-not + (ebox-style--theme-parent-delta-computed + style declarations parent-old parent-font-new))))) + +(ert-deftest ebox-tree-source-signature-ignores-derived-width-proof () + "A layout-derived exact-width flag must not dirty declarative content." + (let* ((old (ebox-create :content "Stable" :width '(100))) + (new (copy-tree old))) + (plist-put old :ebox-content-width-exact-p nil) + (plist-put new :ebox-content-width-exact-p t) + (should (equal (ebox-tree-node-local-source-signature old) + (ebox-tree-node-local-source-signature new))) + (should-not (memq :ebox-content-width-exact-p + (ebox-tree-node-local-changed-keys old new))))) + +(ert-deftest ebox-tree-grid-source-signature-canonicalizes-layout-aliases () + "Equivalent Grid gap/paint aliases must not become geometry dirtiness." + (let ((old (list :ebox-type 'grid + :raw-props '(:width stretch + :grid-template-columns (1fr 1fr) + :grid-row-gap 1 :grid-column-gap (12) + :color "#252A2E" :background-color "#F8F5EE"))) + (new (list :ebox-type 'grid + :raw-props '(:width stretch + :grid-template-columns (1fr 1fr) + :gap (1 (12)) + :color "#F2EEE4" :bgcolor "#1B1F20")))) + (should-not (memq :props (ebox-tree-node-local-changed-keys old new))) + (should-not (memq :raw-props (ebox-tree-node-local-changed-keys old new))))) + +(ert-deftest ebox-tree-flex-source-signature-canonicalizes-layout-aliases () + "Equivalent Flex gap aliases must not become geometry dirtiness." + (let ((old (list :ebox-type 'flex + :raw-props '(:width stretch + :row-gap 1 :column-gap (12) + :padding-block-start 0 + :padding-inline-end 2 + :padding-block-end 0 + :padding-inline-start 2 + :border-top-width (1) + :border-right-width (1) + :border-bottom-width (1) + :border-left-width (1) + :border-top-style solid + :border-right-style solid + :border-bottom-style solid + :border-left-style solid + :border-top-color "#687386" + :border-right-color "#687386" + :border-bottom-color "#687386" + :border-left-color "#687386" + :align-items center + :color "#252A2E" + :background-color "#F8F5EE"))) + (new (list :ebox-type 'flex + :raw-props '(:width stretch + :gap (1 (12)) + :padding (0 2) + :border ((1) solid "#687386") + :align-items center + :color "#F2EEE4" + :bgcolor "#1B1F20")))) + (should-not (memq :props (ebox-tree-node-local-changed-keys old new))) + (should-not (memq :raw-props (ebox-tree-node-local-changed-keys old new))))) + +(ert-deftest ebox-style-theme-delta-rejects-inherited-parent-change () + "Do not reuse a child style when its inherited parent fingerprint changes." + (let* ((parent (ecss-subject-create :type "box")) + (child (ecss-subject-create :type "box" :parent parent)) + (parent-old + (ebox-style-compute-subject + parent '(ebox/font-height 1.0))) + (parent-new + (ebox-style-compute-subject + parent '(ebox/font-height 2.0))) + (declarations '(ebox/color "#ffffff")) + (style + (ebox-style-compute-subject child declarations parent-old))) + (should-not + (ebox-style--theme-delta-computed + style declarations declarations parent-old parent-new)))) + +(ert-deftest ebox-style-theme-delta-rejects-parent-custom-property-change () + "Do not reuse a Theme delta when a parent custom property changes." + (let* ((parent (ecss-subject-create :type "box")) + (child (ecss-subject-create :type "box" :parent parent)) + (parent-old + (ebox-style-compute-subject parent '(--theme "#ffffff"))) + (parent-new + (ebox-style-compute-subject parent '(--theme "#000000"))) + (old-declarations + '(ebox/color "#ffffff" ebox/background-color "#ffffff")) + (new-declarations + '(ebox/color "#eeeeee" ebox/background-color "#eeeeee")) + (style + (ebox-style-compute-subject child old-declarations parent-old))) + (should-not + (ebox-style--theme-delta-computed + style old-declarations new-declarations parent-old parent-new)))) + +(ert-deftest ebox-style-paint-declarations-equivalent-includes-border-colors () + "Pressed/hover paint changes must not invalidate layout style closure." + (should + (ebox-style--paint-declarations-equivalent-p + '(ebox/color "#ffffff" + ebox/background-color "#2f6b43" + ebox/border-top-color "#2f6b43" + ebox/border-right-color "#2f6b43" + ebox/border-bottom-color "#2f6b43" + ebox/border-left-color "#2f6b43") + '(ebox/color "#ffffff" + ebox/background-color "#1e5a56" + ebox/border-top-color "#174a47" + ebox/border-right-color "#174a47" + ebox/border-bottom-color "#174a47" + ebox/border-left-color "#174a47"))) + (should-not + (ebox-style--paint-declarations-equivalent-p + '(ebox/color "#ffffff" ebox/width max-content) + '(ebox/color "#ffffff" ebox/width stretch)))) + (ert-deftest ebox-render-to-buffer-reuses-one-source-across-buffers () "The public mount path should never transfer ownership of its source tree." (ebox-surface-test--reset-render-state) @@ -1601,6 +2015,30 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-scroll-finalization-contains-each-error-and-quit () + "Post-TP scroll actions report failures without skipping later actions." + (let ((ebox--scroll-global-state (make-hash-table :test 'equal)) + (ebox--smooth-scroll-state-table (make-hash-table :test 'equal)) + trace diagnostics) + (cl-letf (((symbol-function 'ebox--scroll-cancel-idle-prefetch) + (lambda (region-id) + (push (list 'cancel region-id) trace) + (error "cancel failure"))) + ((symbol-function 'ebox--smooth-scroll-stop) + (lambda (region-id) + (push (list 'stop region-id) trace) + (signal 'quit nil)))) + (setq diagnostics + (ebox-incremental--finalize-declarative-scroll-publication + '(one two)))) + (should (equal (nreverse trace) + '((cancel one) (stop one) (cancel two) (stop two)))) + (should (= (length diagnostics) 4)) + (should (equal (mapcar (lambda (entry) (plist-get entry :action)) + diagnostics) + '(cancel-prefetch stop-smooth-scroll + cancel-prefetch stop-smooth-scroll))))) + (ert-deftest ebox-region-handles-are-surface-scoped () "One logical id should resolve to distinct handles on independent surfaces." (ebox-surface-test--reset-render-state) @@ -1656,6 +2094,25 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-region-update-preserves-point-after-incremental-publication () + "An incremental Ebox content update must not leave point at its patch." + (ebox-surface-test--reset-render-state) + (let ((buffer (generate-new-buffer " *ebox-point-preservation*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-create :id "target" :content "before target after" + :width '(200))) + (with-current-buffer buffer (goto-char 4)) + (let ((point-before (with-current-buffer buffer (point)))) + (ebox-region-update (ebox-region-resolve buffer "target") + :content "before changed-target after") + (should (= point-before + (with-current-buffer buffer (point)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + (ert-deftest ebox-region-update-rejects-process-global-region-ids () "Direct updates should require a surface-scoped region handle." (ebox-surface-test--reset-render-state) @@ -1761,6 +2218,171 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-scroll-patch-reuses-visible-lines-and-retains-region-index () + "A chrome-free root scroll patch must avoid layout and keep all regions indexed." + (ebox-surface-test--reset-render-state) + (let ((buffer (generate-new-buffer " *ebox-scroll-visible-window*"))) + (unwind-protect + (let ((ebox-viewport-width 240) + (ebox-viewport-height 2) + (full-renders 0)) + (ebox-render-to-buffer + buffer + (ebox-create :id "scroll" :content + (mapconcat #'number-to-string (number-sequence 0 31) "\n") + :width '(120) :height 2 :overflow 'scroll)) + (let* ((surface (with-current-buffer + buffer ebox-surface--buffer-surface)) + (region-id + (plist-get + (car (ebox-selector-query-buffer buffer "#scroll")) + :region-id)) + (old-state (tp-surface-client-state surface))) + ;; Materialize this tiny fixture so the direct visible-window + ;; proof is exercised rather than the lazy-prefix fallback. + (let ((scroll-state + (ebox--scroll-state-materialize-lines + region-id (ebox--scroll-get-state region-id)))) + (puthash region-id scroll-state ebox--scroll-global-state)) + (let ((owner-plan-calls 0) + (original-owner-plan + (symbol-function + 'ebox-incremental--layout-owner-plan))) + (cl-letf (((symbol-function 'ebox-surface--render-candidate) + (lambda (&rest _) + (cl-incf full-renders) + (error "full root render used by scroll patch"))) + ((symbol-function + 'ebox-incremental--layout-owner-plan) + (lambda (&rest args) + (cl-incf owner-plan-calls) + (apply original-owner-plan args)))) + (should (= (ebox--scroll-region-by region-id 1 1) 1))) + (should (= owner-plan-calls 0))) + (let* ((report (ebox-buffer-update-report buffer)) + (state (tp-surface-client-state surface)) + (region-table (plist-get state :region-box-table)) + (region-set (plist-get state :region-id-set)) + (text (with-current-buffer buffer + (buffer-substring-no-properties + (point-min) (point-max))))) + (should (= full-renders 0)) + (should (eq (plist-get report :projection-kind) 'scroll-patch)) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback)) + (should (= (hash-table-count region-table) + (hash-table-count region-set))) + (maphash + (lambda (id node) + (should (eq node + (gethash (gethash id + (plist-get state + :region-node-table)) + (plist-get state :node-table))))) + region-table) + (should (string-match-p "1" text)) + (should-not (string-match-p "^0$" text)) + (should (equal (plist-get (plist-get old-state :root-node) + :node-id) + (plist-get (plist-get state :root-node) + :node-id))) + (should (eq (gethash (plist-get (plist-get state :root-node) + :node-id) + (plist-get state + :surface-node-object-table)) + (gethash (plist-get (plist-get old-state :root-node) + :node-id) + (plist-get old-state + :surface-node-object-table)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))))) + +(ert-deftest ebox-scroll-patch-rolls-back-at-tp-client-state-publication () + "A scroll patch failure after TP client-state must restore the old generation." + (ebox-surface-test--reset-render-state) + (let ((buffer (generate-new-buffer " *ebox-scroll-patch-rollback*"))) + (unwind-protect + (let ((ebox-viewport-width 240) + (ebox-viewport-height 2)) + (ebox-render-to-buffer + buffer + (ebox-create :id "scroll" :content "zero\none\ntwo\nthree" + :width '(120) :height 2 :overflow 'scroll)) + (let* ((surface (with-current-buffer + buffer ebox-surface--buffer-surface)) + (region-id + (plist-get + (car (ebox-selector-query-buffer buffer "#scroll")) + :region-id)) + (state (tp-surface-client-state surface)) + (revision (tp-surface-revision surface)) + (contents (with-current-buffer buffer + (buffer-substring (point-min) (point-max)))) + (old-region-table (plist-get state :region-box-table))) + (let ((tp--surface-publication-step-function + (lambda (step _surface) + (when (eq step 'client-state) + (error "reject scroll client-state publication"))))) + (should-error (ebox--scroll-region-by region-id 1 1))) + (should (= (tp-surface-revision surface) revision)) + (should (eq (tp-surface-client-state surface) state)) + (should (eq (plist-get state :region-box-table) + old-region-table)) + (should (= (plist-get (ebox-scroll-state region-id) + :scroll-offset) + 0)) + (should (equal-including-properties + (with-current-buffer buffer + (buffer-substring (point-min) (point-max))) + contents)) + (should (= (ebox--scroll-region-by region-id 1 1) 1)))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest ebox-scroll-patch-reuses-incomplete-flex-visible-window () + "A lazy Flex prefix may use retained output when its visible slice is ready. +The prefix need not be fully materialized; a scroll step that remains inside +the staged rendered window must not rerun the Flex wrapper layout." + (let* ((children + (cl-loop for index below 80 + collect + (ebox-create :key (intern (format "flex-cell-%03d" index)) + :content (format "Cell %03d" index) + :width '(80) :height 1))) + (flex (apply #'ebox-flex :flex-flow '(row wrap) + :width '(180) :column-gap '(8) :row-gap 1 + children)) + (root (ebox-create :key 'scroll-root :width '(180) :height 6 + :overflow 'scroll :ebox-content-node flex)) + (buffer (ebox-render-to-buffer + (generate-new-buffer-name " *ebox-incomplete-flex-scroll*") + root)) + (state (ebox--buffer-render-state buffer)) + (region-id (car (plist-get state :scroll-region-ids))) + (scroll-state (gethash region-id + (plist-get state :scroll-state-table)))) + (unwind-protect + (progn + (should region-id) + (should scroll-state) + (should-not (plist-get scroll-state :content-lines-complete-p)) + (should (ebox--scroll-state-rendered-visible-window scroll-state)) + (should (ebox--scroll-state-retained-window-ready-p scroll-state)) + (with-current-buffer buffer + (ebox--scroll-region-by region-id 1 1)) + (let ((report (ebox-buffer-update-report buffer)) + (current (ebox--buffer-render-state buffer))) + (should (eq (plist-get report :projection-kind) 'scroll-patch)) + (should (plist-get report :scroll-patch-fast-p)) + (should-not (plist-get report :tp-full-root)) + (should-not (plist-get report :tp-scope-fallback)) + (should (= (hash-table-count + (plist-get current :region-id-set)) + (hash-table-count + (plist-get current :region-box-table))))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))))) + (ert-deftest ebox-scroll-update-rejects-a-runtime-replaced-by-its-hook () "A stale scroll candidate must not overwrite a hook publication." (ebox-surface-test--reset-render-state) @@ -1801,6 +2423,84 @@ candidate cannot hide mutations by restoring the old hash-table pointer." (when (buffer-live-p buffer) (kill-buffer buffer))))) +(ert-deftest ebox-native-buffer-scroll-is-transactional-and-line-oriented () + "An eligible root scroll uses the window one line at a time. +The test stubs the GUI window boundary so batch ERT can exercise the same +participant and rollback contract without creating a real frame." + (ebox-surface-test--reset-render-state) + (let ((buffer (generate-new-buffer " *ebox-native-scroll*"))) + (unwind-protect + (let ((ebox-viewport-width 120) + (ebox-viewport-height 2) + (noninteractive nil) + (ebox-runtime-idle-prewarm nil) + (window-start 1) + (window-point 1)) + (ebox-render-to-buffer + buffer + (ebox-create :id "native-scroll" :content "zero\none\ntwo\nthree" + :width '(120) :height 2 :overflow 'scroll)) + (let* ((state (ebox--buffer-render-state buffer)) + (region-id (car (plist-get state :scroll-region-ids))) + (scroll-state + (gethash region-id (plist-get state :scroll-state-table)))) + (plist-put state :native-buffer-scroll-p t) + (plist-put scroll-state :content-lines-complete-p t) + (plist-put scroll-state :rendered-content-lines + '("zero" "one" "two" "three")) + (plist-put scroll-state :content-height 2) + (puthash region-id scroll-state ebox--scroll-global-state) + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) 'ebox-test-window)) + ((symbol-function 'window-live-p) + (lambda (&rest _) t)) + ((symbol-function 'window-start) + (lambda (&rest _) window-start)) + ((symbol-function 'window-point) + (lambda (&rest _) window-point)) + ((symbol-function 'set-window-start) + (lambda (_window position &rest _) + (setq window-start position))) + ((symbol-function 'set-window-point) + (lambda (_window position) + (setq window-point position))) + ((symbol-function + 'ebox--native-buffer-scroll-root-proof-p) + (lambda (&rest _) t))) + (should (= (ebox--native-buffer-scroll-by buffer region-id 1) + 1)) + (should (= (plist-get scroll-state :scroll-offset) 1)) + (should (> window-start 1)) + (should (equal (plist-get state :last-update-report) + (ebox-buffer-update-report buffer))) + (should (eq (plist-get (ebox-buffer-update-report buffer) + :projection-kind) + 'native-buffer-scroll)) + ;; The native path is a presentation-only transaction, but it + ;; must still restore both window and Ebox state if a window + ;; primitive fails halfway through the move. + (setq window-start 1 + window-point 1) + (plist-put scroll-state :scroll-offset 0) + (ebox-put (plist-get scroll-state :box) :scroll-offset 0) + (plist-put state :last-update-report nil) + (let ((fail-once t)) + (cl-letf (((symbol-function 'set-window-point) + (lambda (_window position) + (if fail-once + (progn + (setq fail-once nil) + (error "native window point failure")) + (setq window-point position))))) + (should-error + (ebox--native-buffer-scroll-by buffer region-id 1)))) + (should (= window-start 1)) + (should (= window-point 1)) + (should (= (plist-get scroll-state :scroll-offset) 0)) + (should-not (plist-get state :last-update-report)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer)))) + (provide 'ebox-surface-tests) ;;; ebox-surface-tests.el ends here