From 8b28f278bd4bc9e6c8a741d91bc08f0ca1ca8e27 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Thu, 27 Aug 2026 23:33:23 +0800 Subject: [PATCH] perf: expose correlated Ebox publication observation --- docs/user/ebox-api-reference.en.md | 28 ++- docs/user/ebox-api-reference.zh.md | 24 +- ebox-incremental.el | 12 +- ebox-selector.el | 65 ++--- ebox-surface.el | 263 +++++++++++++++++++- ebox.el | 190 ++++++++++---- tests/ebox-commit-tests.el | 387 +++++++++++++++++++++++++++++ tests/ebox-package-tests.el | 2 + 8 files changed, 875 insertions(+), 96 deletions(-) diff --git a/docs/user/ebox-api-reference.en.md b/docs/user/ebox-api-reference.en.md index 3537939..cb45731 100644 --- a/docs/user/ebox-api-reference.en.md +++ b/docs/user/ebox-api-reference.en.md @@ -108,9 +108,10 @@ though the facade inventory below focuses on application entry points. | Function | Contract | | --- | --- | | `ebox-render` | Return a propertized string without publishing a live buffer. | -| `ebox-render-to-buffer` | Copy the built root, mount a retained TP surface, enable `ebox-buffer-mode`, and return the buffer. | +| `ebox-render-to-buffer` | Copy the built root, mount a retained TP surface, enable `ebox-buffer-mode`, and return the buffer. Its optional plist accepts only `:observer FUNCTION`. | | `ebox-display-buffer` | Render through the retained path, delete other windows, and switch to the result. | | `ebox-commit` | Atomically publish a newly built root or one-shot logical candidate. | +| `ebox-buffer-set-observer` | Set or remove one function-valued observer on an already mounted buffer. | | `ebox-buffer-update-report` | Return a defensive copy of the last successful update report. | | `ebox-rerender-buffer-with-context` | Apply explicit viewport width and optional height while retaining identity. | | `ebox-viewport-window-width` | Return Ebox's display-safe pixel width for a window. | @@ -119,6 +120,28 @@ though the facade inventory below focuses on application entry points. join the existing atomic publication; failures restore the previous buffer, surface, runtime state, and successful report. +Every public Ebox publication owns its TP transaction. Calling mount, commit, +viewport, region, selector, batch, or TP-backed scroll publication from inside +an already active outer TP transaction is rejected before Ebox mutation. + +Observation is an optional read-only boundary, not transaction authority. An +observer has the signature `(OBSERVER BUFFER REPORT)`. After one accepted TP +publication and all Ebox finalization complete, it receives two defensive flat +reports in order: TP first, then Ebox. Both carry the same `:correlation-id`, +derived from the TP transaction id. Ebox stages are `mount`, `commit`, +`viewport`, `region`, `selector`, `batch`, and `scroll`. Nested public calls +reuse the outer operation, so a multi-match selector or explicit batch still +emits one pair. No-op operations and native-window scrolls that publish no TP +surface emit no pair. Observer errors are contained after acceptance and +cannot roll back rendering. + +Pass `:observer` to `ebox-render-to-buffer` when the initial mount must be +included. That mount report is transient: observed and unobserved mounts both +leave `ebox-buffer-update-report` nil. Use `ebox-buffer-set-observer` to replace +or remove observation later; passing nil detaches the TP bridge. With no +observer, Ebox creates no observation context, timestamps, GC snapshots, or +report decoration. + `ebox-call-with-render-burst` is the exception-safe allocation/GC boundary for a framework callback. `ebox-render-burst-begin` and `ebox-render-burst-end` provide the lower-level token form and must be paired with `unwind-protect`. @@ -195,7 +218,8 @@ names every entry: `ebox-column-layout-create`, `ebox-flex-layout-create`, `ebox-grid-layout-create`, `ebox-box-create`, `ebox-child-range`. - Render/publication: `ebox-render`, `ebox-render-to-buffer`, - `ebox-display-buffer`, `ebox-commit`, `ebox-buffer-update-report`, + `ebox-display-buffer`, `ebox-commit`, `ebox-buffer-set-observer`, + `ebox-buffer-update-report`, `ebox-rerender-buffer-with-context`, `ebox-viewport-window-width`, `ebox-call-with-render-burst`, `ebox-render-burst-begin`, `ebox-render-burst-end`. diff --git a/docs/user/ebox-api-reference.zh.md b/docs/user/ebox-api-reference.zh.md index dbda8a3..7d016fb 100644 --- a/docs/user/ebox-api-reference.zh.md +++ b/docs/user/ebox-api-reference.zh.md @@ -101,9 +101,10 @@ typed 模块还公开 `ebox-node-kind`、`ebox-text-node-p`、`ebox-box-node-p` | 函数 | 契约 | | --- | --- | | `ebox-render` | 返回带属性字符串，不发布 live buffer。 | -| `ebox-render-to-buffer` | 复制 built root，挂载 retained TP surface，启用 `ebox-buffer-mode` 并返回 buffer。 | +| `ebox-render-to-buffer` | 复制 built root，挂载 retained TP surface，启用 `ebox-buffer-mode` 并返回 buffer；可选 plist 只接受 `:observer FUNCTION`。 | | `ebox-display-buffer` | 走 retained 路径渲染，删除其他 window 后切换到结果。 | | `ebox-commit` | 原子发布重新构建的 root 或 one-shot logical candidate。 | +| `ebox-buffer-set-observer` | 给已经 mounted 的 buffer 设置或移除一个 function observer。 | | `ebox-buffer-update-report` | 返回最近一次成功更新报告的防御性副本。 | | `ebox-rerender-buffer-with-context` | 应用显式 viewport width 与可选 height，同时保留 identity。 | | `ebox-viewport-window-width` | 返回 Ebox 对 window 使用的 display-safe 像素宽度。 | @@ -111,6 +112,25 @@ typed 模块还公开 `ebox-node-kind`、`ebox-text-node-p`、`ebox-box-node-p` `ebox-commit` 接受可选 framework publish/rollback callback。它们加入现有原子发布； 失败会恢复旧 buffer、surface、runtime state 与最近一次成功报告。 +每个公共 Ebox publication 都拥有自己的 TP transaction。在已经 active 的外层 TP +transaction 中调用 mount、commit、viewport、region、selector、batch 或 TP-backed +scroll publication，会在 Ebox mutation 前被拒绝。 + +观察是可选只读边界，不拥有 transaction 权限。observer 签名是 +`(OBSERVER BUFFER REPORT)`。一次 TP publication 被接受且 Ebox finalization 全部完成后， +observer 按顺序收到两份防御性 flat report：先 TP，后 Ebox。两者共享从 TP transaction +id 得到的 `:correlation-id`。Ebox stage 是 `mount`、`commit`、`viewport`、 +`region`、`selector`、`batch` 和 `scroll`。嵌套公共调用复用最外层 operation， +因此多匹配 selector 或显式 batch 仍只发送一对 report。没有 TP surface publication +的 no-op 与 native-window scroll 不发送 report。observer error 在 accept 后被包含， +不能回滚渲染。 + +需要观察首次 mount 时，把 `:observer` 传给 `ebox-render-to-buffer`。mount report 只 +瞬时发送；有无 observer 时 `ebox-buffer-update-report` 都仍为 nil。后续通过 +`ebox-buffer-set-observer` 替换 observer，传 nil 时移除并从 TP surface 解绑 bridge。 +observer 为 nil 时，Ebox 不创建 observation context，不取 timestamp/GC snapshot， +也不装饰 report。 + `ebox-call-with-render-burst` 是框架 callback 的 exception-safe allocation/GC 边界。 `ebox-render-burst-begin` 与 `ebox-render-burst-end` 提供较底层的 token 形式，必须用 `unwind-protect` 配对。它们本身不发布内容。 @@ -181,7 +201,7 @@ native 模块只是加速器，不是正确性依赖。加载包不会构建它 `ebox-flex-layout-create`、`ebox-grid-layout-create`、`ebox-box-create`、 `ebox-child-range`； - 渲染/发布：`ebox-render`、`ebox-render-to-buffer`、`ebox-display-buffer`、 - `ebox-commit`、`ebox-buffer-update-report`、 + `ebox-commit`、`ebox-buffer-set-observer`、`ebox-buffer-update-report`、 `ebox-rerender-buffer-with-context`、`ebox-viewport-window-width`、 `ebox-call-with-render-burst`、`ebox-render-burst-begin`、 `ebox-render-burst-end`； diff --git a/ebox-incremental.el b/ebox-incremental.el index 194a14e..063b3c9 100644 --- a/ebox-incremental.el +++ b/ebox-incremental.el @@ -87,6 +87,8 @@ "ebox-cache" (buffer)) (declare-function ebox-cache-restore-report "ebox-cache" (buffer snapshot)) +(declare-function ebox-surface-call-with-observation + "ebox-surface" (buffer stage function)) (declare-function ebox-style-cascade-active-p "ebox-style" ()) (declare-function ebox-native-commit-plan-eligible-p @@ -3937,8 +3939,8 @@ during `ebox-incremental-flush'." (ebox--ensure-node-id root) (ebox-incremental--batch-dirty-set buffer pending)))) -(defun ebox-incremental-flush (buffer) - "Flush BUFFER's explicit incremental update batch." +(defun ebox-incremental--flush (buffer) + "Flush BUFFER's explicit incremental update batch without observing it." (unless (buffer-live-p buffer) (error "ebox-incremental: buffer is not live: %S" buffer)) (let* ((state (ebox-incremental--batch-state buffer)) @@ -3991,6 +3993,12 @@ during `ebox-incremental-flush'." buffer pending report)) (ebox--buffer-update-report buffer))))) +(defun ebox-incremental-flush (buffer) + "Flush BUFFER's explicit incremental update batch as one operation." + (ebox-surface-call-with-observation + buffer 'batch + (lambda () (ebox-incremental--flush buffer)))) + ;;; Declarative Root Commit (defun ebox-incremental-candidate-begin (buffer) diff --git a/ebox-selector.el b/ebox-selector.el index 2ceb51b..f495db5 100644 --- a/ebox-selector.el +++ b/ebox-selector.el @@ -26,6 +26,8 @@ (declare-function ebox-incremental-begin-batch "ebox-incremental" (buffer)) (declare-function ebox-incremental-flush "ebox-incremental" (buffer)) (declare-function ebox-region-update "ebox" (handle &rest props)) +(declare-function ebox-surface-call-with-observation + "ebox-surface" (buffer stage function)) (cl-defstruct (ebox-region-handle @@ -305,35 +307,40 @@ SELECTOR locates runtime nodes, then every editable match is updated through skips, and update reports." (unless props (user-error "ebox-selector: update requires at least one property")) - (ebox--with-render-gc - (let* ((resolved-buffer (ebox-selector--resolve-buffer buffer)) - (matches (ebox-selector-query-buffer resolved-buffer selector)) - editable skipped reports) - (unless matches - (user-error "ebox-selector: no matches for %S" selector)) - (dolist (match matches) - (if (plist-get match :region-handle) - (push match editable) - (push (ebox-selector--skip-handle match 'no-region) skipped))) - (setq editable (nreverse editable) - skipped (nreverse skipped)) - (cond - ((null editable) - (setq reports nil)) - ((= (length editable) 1) - (setq reports - (list (ebox-selector--update-region (car editable) props)))) - (t - (ebox-incremental-begin-batch resolved-buffer) - (dolist (match editable) - (ebox-selector--update-region match props)) - (setq reports - (list (ebox-incremental-flush resolved-buffer))))) - (list :selector selector - :matched (length matches) - :updated (length editable) - :skipped skipped - :reports reports)))) + (let ((resolved-buffer (ebox-selector--resolve-buffer buffer))) + (ebox-surface-call-with-observation + resolved-buffer 'selector + (lambda () + (ebox--with-render-gc + (let ((matches + (ebox-selector-query-buffer resolved-buffer selector)) + editable skipped reports) + (unless matches + (user-error "ebox-selector: no matches for %S" selector)) + (dolist (match matches) + (if (plist-get match :region-handle) + (push match editable) + (push (ebox-selector--skip-handle match 'no-region) skipped))) + (setq editable (nreverse editable) + skipped (nreverse skipped)) + (cond + ((null editable) + (setq reports nil)) + ((= (length editable) 1) + (setq reports + (list (ebox-selector--update-region + (car editable) props)))) + (t + (ebox-incremental-begin-batch resolved-buffer) + (dolist (match editable) + (ebox-selector--update-region match props)) + (setq reports + (list (ebox-incremental-flush resolved-buffer))))) + (list :selector selector + :matched (length matches) + :updated (length editable) + :skipped skipped + :reports reports))))))) (provide 'ebox-selector) diff --git a/ebox-surface.el b/ebox-surface.el index a8a707d..e51ce61 100644 --- a/ebox-surface.el +++ b/ebox-surface.el @@ -163,10 +163,35 @@ the winning client state; otherwise only the candidate is disposable." (context plan rendered ranges &optional client-state full-surface-p property-contributions)) (declare-function tp-surface-report-summary "tp-surface" (surface)) +(declare-function tp-surface-add-observer + "tp-surface" (surface observer)) +(declare-function tp-surface-remove-observer + "tp-surface" (surface observer)) +(declare-function tp-transaction-active-p "tp-reactive" ()) +(defvar gcs-done) +(defvar gc-elapsed) (defvar-local ebox-surface--buffer-surface nil "Live TP content surface mounted for the current Ebox buffer.") +(defvar-local ebox-surface--buffer-observer nil + "Optional public observer for completed Ebox buffer publications.") + +(defvar-local ebox-surface--tp-observer nil + "Stable TP observer bridge installed for the current Ebox buffer.") + +(defvar-local ebox-surface--observation-contexts nil + "Pending observed Ebox calls for the current buffer.") + +(defvar ebox-surface--observation-context nil + "Dynamically bound observation context for one public Ebox call.") + +(cl-defstruct (ebox-surface--observation + (:constructor ebox-surface--make-observation)) + "Two-phase observation of one public Ebox publication." + buffer observer stage started gc-start transaction-before correlation-id + tp-report ebox-report finished gc-end finished-p) + (cl-defstruct (ebox-surface--signals (:constructor ebox-surface--make-signals)) "TP signals carrying one mounted Ebox surface's host context." @@ -181,6 +206,208 @@ the winning client state; otherwise only the candidate is disposable." (defvar-local ebox-surface--context-signals nil "Buffer-scoped TP signals consumed by the mounted Ebox producer.") +(defun ebox-surface--observation-clock () + "Return the current observation clock in seconds." + (float-time)) + +(defun ebox-surface--observation-gc-snapshot () + "Return current GC count and elapsed seconds." + (cons (if (boundp 'gcs-done) gcs-done 0) + (if (boundp 'gc-elapsed) gc-elapsed 0.0))) + +(defun ebox-surface--observation-discard (context) + "Remove pending observation CONTEXT from its owning buffer." + (when-let* ((buffer (ebox-surface--observation-buffer context)) + ((buffer-live-p buffer))) + (with-current-buffer buffer + (setq ebox-surface--observation-contexts + (delq context ebox-surface--observation-contexts))))) + +(defun ebox-surface--decorate-observation-report (context report) + "Return CONTEXT metadata attached to defensive Ebox REPORT copy." + (let* ((result (copy-tree report)) + (gc-start (ebox-surface--observation-gc-start context)) + (gc (ebox-surface--observation-gc-end context)) + (tp-report (ebox-surface--observation-tp-report context))) + (dolist (entry + `((:provider . ebox) + (:stage . ,(ebox-surface--observation-stage context)) + (:correlation-id + . ,(ebox-surface--observation-correlation-id context)) + (:duration-ms + . ,(* 1000.0 + (- (ebox-surface--observation-finished context) + (ebox-surface--observation-started context)))) + (:gc-count . ,(- (car gc) (car gc-start))) + (:gc-duration-ms . ,(* 1000.0 (- (cdr gc) (cdr gc-start)))) + (:tp-duration-ms . ,(plist-get tp-report :duration-ms)))) + (setq result (plist-put result (car entry) (cdr entry)))) + result)) + +(defun ebox-surface--observation-mount-report (context) + "Build CONTEXT's transient initial-mount Ebox report." + (let* ((buffer (ebox-surface--observation-buffer context)) + (surface (ebox-surface--live-buffer-surface buffer)) + (state (and surface (tp-surface-client-state surface))) + (tp-report (and surface (tp-surface-report-summary surface)))) + (when (and surface state) + (ebox-surface--commit-report + surface state + (ebox--update-report + nil 'surface-mount + :constraint-source 'declarative + :dirty-count 1 + :patch-count + (+ (or (plist-get tp-report :text-operations) + 0) + (or (plist-get tp-report :property-operations) + 0))))))) + +(defun ebox-surface--observation-deliver (context) + "Deliver CONTEXT's paired reports once both phases are complete." + (when (and (ebox-surface--observation-tp-report context) + (ebox-surface--observation-ebox-report context) + (not (ebox-surface--observation-finished-p context))) + (setf (ebox-surface--observation-finished-p context) t) + (ebox-surface--observation-discard context) + (let ((observer (ebox-surface--observation-observer context)) + (reports + (list + (ebox-surface--observation-tp-report context) + (ebox-surface--decorate-observation-report + context (ebox-surface--observation-ebox-report context))))) + (dolist (report reports) + (let ((inhibit-quit t) + (quit-flag nil)) + (condition-case nil + (funcall observer + (ebox-surface--observation-buffer context) + (copy-tree report)) + ((error quit) nil))))))) + +(defun ebox-surface--observation-finish (context) + "Finish CONTEXT after Ebox finalization, excluding observer callbacks." + (let ((finished (ebox-surface--observation-clock)) + (gc (ebox-surface--observation-gc-snapshot)) + (surface + (ebox-surface--live-buffer-surface + (ebox-surface--observation-buffer context)))) + ;; Public operations do not all return the Ebox update report: selector + ;; updates return a summary and scroll returns a consumed distance. The + ;; retained client state is the single completed report authority after + ;; the public call returns. + (let ((report + (unless (eq (ebox-surface--observation-stage context) 'mount) + (and surface + (plist-get (tp-surface-client-state surface) + :last-update-report))))) + (unless report + (setq report (ebox-surface--observation-mount-report context))) + (when report + (setf (ebox-surface--observation-ebox-report context) + report + (ebox-surface--observation-finished context) finished + (ebox-surface--observation-gc-end context) gc))) + (if (ebox-surface--observation-correlation-id context) + (ebox-surface--observation-deliver context) + (ebox-surface--observation-discard context)))) + +(defun ebox-surface--capture-tp-observation (buffer report) + "Capture accepted TP REPORT for BUFFER and complete matching Ebox calls." + (when (buffer-live-p buffer) + (let ((correlation-id (plist-get report :transaction-id)) + matches) + (with-current-buffer buffer + (dolist (context ebox-surface--observation-contexts) + (when (equal correlation-id + (ebox-surface--observation-correlation-id context)) + (push context matches)))) + (dolist (context (nreverse matches)) + (let ((tp-report (copy-tree report))) + (setq tp-report + (plist-put tp-report :correlation-id correlation-id)) + (setf (ebox-surface--observation-tp-report context) tp-report) + (ebox-surface--observation-deliver context)))))) + +(defun ebox-surface--ensure-tp-observer (buffer) + "Return BUFFER's stable TP observation bridge." + (with-current-buffer buffer + (or ebox-surface--tp-observer + (setq ebox-surface--tp-observer + (lambda (_surface report) + (ebox-surface--capture-tp-observation buffer report)))))) + +(defun ebox-surface-set-buffer-observer (buffer observer) + "Set BUFFER's Ebox OBSERVER, or remove it when OBSERVER is nil." + (unless (or (null observer) (functionp observer)) + (signal 'wrong-type-argument (list 'functionp observer))) + (let ((surface (ebox-surface--live-buffer-surface buffer))) + (with-current-buffer buffer + (if observer + (let ((bridge (ebox-surface--ensure-tp-observer buffer))) + (setq-local ebox-surface--buffer-observer observer) + (when surface (tp-surface-add-observer surface bridge))) + (when (and surface ebox-surface--tp-observer) + (tp-surface-remove-observer surface ebox-surface--tp-observer)) + (setq-local ebox-surface--buffer-observer nil) + (dolist (context ebox-surface--observation-contexts) + (setf (ebox-surface--observation-finished-p context) t)) + (setq-local ebox-surface--observation-contexts nil)))) + observer) + +(defun ebox-surface-buffer-observer (buffer) + "Return BUFFER's current Ebox observer, or nil." + (and (buffer-live-p buffer) + (with-current-buffer buffer ebox-surface--buffer-observer))) + +(defun ebox-surface-call-with-observation (buffer stage function) + "Call FUNCTION while observing BUFFER publication at STAGE." + (let ((current ebox-surface--observation-context) + (observer (ebox-surface-buffer-observer buffer))) + (cond + ((and current + (not (ebox-surface--observation-finished-p current)) + (eq buffer (ebox-surface--observation-buffer current))) + (funcall function)) + ((tp-transaction-active-p) + (error "Ebox public operation cannot join an outer TP transaction")) + ((null observer) + (funcall function)) + (t + (let* ((surface (ebox-surface--live-buffer-surface buffer)) + (before-report (and surface (tp-surface-report-summary surface))) + (context + (ebox-surface--make-observation + :buffer buffer :observer observer :stage stage + :started (ebox-surface--observation-clock) + :gc-start (ebox-surface--observation-gc-snapshot) + :transaction-before (plist-get before-report :transaction-id)))) + (with-current-buffer buffer + (push context ebox-surface--observation-contexts)) + (let ((ebox-surface--observation-context context) + result success) + (unwind-protect + (progn + (setq result (funcall function) + success t) + (ebox-surface--observation-finish context) + result) + (unless success + (ebox-surface--observation-discard context))))))))) + +(defun ebox-surface-cleanup-buffer-observer (buffer) + "Remove BUFFER's TP bridge and all pending observation state." + (when (buffer-live-p buffer) + (let ((surface (ebox-surface--live-buffer-surface buffer))) + (with-current-buffer buffer + (when (and surface ebox-surface--tp-observer) + (condition-case nil + (tp-surface-remove-observer surface ebox-surface--tp-observer) + (error nil))) + (setq-local ebox-surface--buffer-observer nil) + (setq-local ebox-surface--tp-observer nil) + (setq-local ebox-surface--observation-contexts nil))))) + (defvar ebox-surface--scroll-line-fragment-cache (make-hash-table :test #'eq :weakness 'key) "Cached property-run templates for immutable rendered scroll lines.") @@ -646,7 +873,7 @@ ROLES has the same filtering meaning as in `ebox-surface-region-mounts'." (defun ebox-surface--publish-runtime-state (buffer surface old-state report-base after-publication - &optional framework-participant) + &optional framework-participant observation-context) "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. @@ -681,6 +908,16 @@ FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil." (ebox-surface--framework-participant-scroll-keys framework-participant) scroll-keys)) + (when observation-context + (let* ((tp-report (tp-surface-report-summary surface)) + (transaction-id (plist-get tp-report :transaction-id))) + (if (equal transaction-id + (ebox-surface--observation-transaction-before + observation-context)) + (ebox-surface--observation-discard observation-context) + (setf (ebox-surface--observation-correlation-id + observation-context) + transaction-id)))) (when new-state (plist-put new-state :surface surface) (plist-put new-state :runtime-revision @@ -735,7 +972,10 @@ FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil." (error "Ebox declarative target died during publication"))) (lambda () (unwind-protect - (ebox-surface--participant-run-rollback framework-participant) + (progn + (ebox-surface--participant-run-rollback framework-participant) + (when observation-context + (ebox-surface--observation-discard observation-context))) (if (buffer-live-p buffer) (progn (when region-snapshot @@ -764,7 +1004,8 @@ 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. FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil." - (let* ((surface (ebox-surface--live-buffer-surface buffer)) + (let* ((observation-context ebox-surface--observation-context) + (surface (ebox-surface--live-buffer-surface buffer)) (old-state (and surface (tp-surface-client-state surface))) (context-values (ebox-surface--context-values buffer old-state state-overrides)) @@ -790,11 +1031,16 @@ FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil." (setq surface (tp-surface-mount buffer producer - '(:capability content :inhibit-read-only t - :coordinate-mounts t)))) + (append + '(:capability content :inhibit-read-only t + :coordinate-mounts t) + (when-let* ((bridge + (with-current-buffer buffer + ebox-surface--tp-observer))) + (list :observers (list bridge))))))) (ebox-surface--publish-runtime-state buffer surface old-state report-base after-publication - framework-participant)) + framework-participant observation-context)) (setq success t) (let ((scroll-keys (if framework-participant @@ -1552,7 +1798,8 @@ 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. FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil." - (let* ((surface (ebox-surface--live-buffer-surface buffer)) + (let* ((observation-context ebox-surface--observation-context) + (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")) @@ -1593,7 +1840,7 @@ FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil." (list :on-mismatch on-mismatch :return-report nil)) (ebox-surface--publish-runtime-state buffer surface old-state report-base after-publication - framework-participant)) + framework-participant observation-context)) (setq success t) (let ((scroll-keys (if framework-participant diff --git a/ebox.el b/ebox.el index e9fd0fb..abc059a 100644 --- a/ebox.el +++ b/ebox.el @@ -68,6 +68,7 @@ (declare-function ebox-native-reflow--build "ebox-native-reflow" (&optional clean)) (declare-function ebox-native-reflow--status "ebox-native-reflow" ()) +(declare-function tp-transaction-active-p "tp-reactive" ()) (defalias 'ebox-select-all #'ebox-selector-query-buffer) (defalias 'ebox-update-selector #'ebox-selector-update-buffer) @@ -444,6 +445,21 @@ publication." buffer-or-name)) (copy-tree (ebox--buffer-update-report buffer)))) +;;;###autoload +(defun ebox-buffer-set-observer (buffer-or-name observer-or-nil) + "Set BUFFER-OR-NAME's publication observer to OBSERVER-OR-NIL. +The observer receives BUFFER and one defensive flat report at a time after an +accepted publication. TP's report is delivered first, followed by Ebox's +completed report. Nil removes observation without affecting rendering." + (let ((buffer (and buffer-or-name (get-buffer buffer-or-name)))) + (unless (buffer-live-p buffer) + (user-error "Ebox observer target is not a live buffer: %S" + buffer-or-name)) + (unless (ebox-surface-buffer-mounted-p buffer) + (user-error "Ebox observer target has no rendered surface: %S" + buffer-or-name)) + (ebox-surface-set-buffer-observer buffer observer-or-nil))) + (defun ebox--ensure-region-id (box) "Return BOX's stable region id, creating one if needed." (ebox--ensure-node-id box) @@ -3356,29 +3372,36 @@ 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." - (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))))))) + (let* ((state (and region-id (ebox--scroll-get-state region-id))) + (buffer (and state (ebox--scroll-state-buffer state))) + (execute + (lambda () + ;; 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 + (and buffer + (ebox--native-buffer-scroll-by + buffer region-id delta)))) + (if (not (eq native 'native-unavailable)) + native + (let ((run + (lambda () + (when buffer + (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))))) + (if noninteractive + (funcall run) + (ebox--with-deferred-render-gc + (funcall run))))))))) + (if buffer + (ebox-surface-call-with-observation buffer 'scroll execute) + (funcall execute)))) (defun ebox--scroll-progress-p (result) "Return non-nil when RESULT represents consumed or pending scroll work." @@ -3830,6 +3853,7 @@ Defaults to the current buffer." (defun ebox--cleanup-current-buffer () "Remove Ebox runtime state owned by the current buffer." + (ebox-surface-cleanup-buffer-observer (current-buffer)) (ebox--clear-buffer-runtime-state (current-buffer)) (setq-local ebox-surface--buffer-surface nil)) @@ -4260,12 +4284,6 @@ REGION-ID and CHANGED-KEYS describe one update; CHANGES describes a batch." (ebox--constraint-change-report-props constraint-change))))))))) -(defun ebox--surface-region-update (handle props) - "Apply PROPS to surface-scoped region HANDLE through one TP commit." - (pcase-let ((`(,buffer . ,region-id) - (ebox-selector--region-target handle))) - (ebox--surface-region-update-target buffer region-id handle props))) - ;;;###autoload (defun ebox-region-update (handle &rest props) "Update the box identified by surface-scoped HANDLE with PROPS. @@ -4284,8 +4302,16 @@ Examples: (unless (ebox-region-handle-p handle) (signal (quote wrong-type-argument) (list (quote ebox-region-handle-p) handle))) - (ebox--with-render-gc - (ebox--surface-region-update handle props))) + (pcase-let ((`(,buffer . ,region-id) + (ebox-selector--region-target handle))) + (let ((execute + (lambda () + (ebox--with-render-gc + (ebox--surface-region-update-target + buffer region-id handle props))))) + (if (ebox-incremental-batching-p buffer) + (funcall execute) + (ebox-surface-call-with-observation buffer 'region execute))))) (defvar ebox-scroll-map nil "Keymap for scroll interaction within ebox.") @@ -4347,24 +4373,65 @@ Examples: (ebox--install-scroll-map-overrides) (ebox--clear-scroll-map-overrides))) +(defun ebox--render-observer-option (options) + "Validate OPTIONS and return `(PRESENT . OBSERVER)'." + (unless (proper-list-p options) + (signal 'wrong-type-argument (list 'proper-list-p options))) + (let ((rest options) + present observer) + (while rest + (unless (cdr rest) + (error "Ebox render option has no value: %S" (car rest))) + (let ((key (pop rest)) + (value (pop rest))) + (unless (eq key :observer) + (error "Unknown Ebox render option: %S" key)) + (when present + (error "Duplicate Ebox render option: :observer")) + (setq present t observer value))) + (unless (or (null observer) (functionp observer)) + (signal 'wrong-type-argument (list 'functionp observer))) + (cons present observer))) + ;;;###autoload -(defun ebox-render-to-buffer (buffer-or-name node) +(defun ebox-render-to-buffer (buffer-or-name node &optional options) "Render layout NODE into BUFFER-OR-NAME and return the buffer. -NODE is a typed TextNode/BoxNode or a pre-rendered string." +NODE is a typed TextNode/BoxNode or a pre-rendered string. +OPTIONS accepts only `:observer'. Its function receives the buffer and flat +TP/Ebox reports after accepted initial publication and later commits." (declare (indent 1)) (unless (stringp node) ;; Validate opaque host identities before preparing a target generation. (ebox-tree-validate-host-refs node)) - (let ((buffer (get-buffer-create buffer-or-name))) - (ebox--with-render-gc - (ebox-surface-mount-buffer buffer node) - (with-current-buffer buffer - (goto-char (point-min)) - (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 nil nil) - buffer)))) + (let* ((observer-option (ebox--render-observer-option options)) + (buffer (get-buffer-create buffer-or-name)) + (old-observer (ebox-surface-buffer-observer buffer)) + (old-bridge (with-current-buffer buffer ebox-surface--tp-observer)) + success result) + (unwind-protect + (progn + (when (car observer-option) + (ebox-surface-set-buffer-observer buffer (cdr observer-option))) + (setq result + (ebox-surface-call-with-observation + buffer 'mount + (lambda () + (ebox--with-render-gc + (ebox-surface-mount-buffer buffer node) + (with-current-buffer buffer + (goto-char (point-min)) + (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 nil nil) + buffer)))) + success t) + result) + (when (and (not success) (car observer-option)) + (ebox-surface-set-buffer-observer buffer old-observer) + (unless old-bridge + (ebox-surface-cleanup-buffer-observer buffer)))))) (defun ebox--host-ref-buffer (buffer-or-name) "Return the live buffer named by BUFFER-OR-NAME, or nil." @@ -4536,6 +4603,8 @@ a later transaction phase fails, and is contained if it violates no-throw. Return the successful publication report stored by `ebox-buffer-update-report'." (let ((execute (lambda () + (when (tp-transaction-active-p) + (error "Ebox public operation cannot join an outer TP transaction")) (unless (or (null framework-publish) (functionp framework-publish)) (signal 'wrong-type-argument (list 'functionp framework-publish))) (unless (or (null framework-rollback) @@ -4580,11 +4649,22 @@ Return the successful publication report stored by `ebox-buffer-update-report'." (plist-get commit-input :state-overrides) participant)))) (ebox-surface--framework-participant-report participant)))))) - (if noninteractive - (ebox--with-render-gc - (funcall execute)) - (ebox--with-deferred-render-gc - (funcall execute))))) + (let ((buffer (get-buffer buffer-or-name))) + (if (and (buffer-live-p buffer) + (ebox-surface-buffer-observer buffer)) + (ebox-surface-call-with-observation + buffer 'commit + (lambda () + (if noninteractive + (ebox--with-render-gc + (funcall execute)) + (ebox--with-deferred-render-gc + (funcall execute))))) + (if noninteractive + (ebox--with-render-gc + (funcall execute)) + (ebox--with-deferred-render-gc + (funcall execute))))))) ;;;###autoload (defun ebox-rerender-buffer-with-context @@ -4608,11 +4688,14 @@ through dirty-set and patch-set execution before falling back to root rerender." (ebox--schedule-buffer-runtime-prewarm buffer nil t) (ebox--schedule-buffer-reflow-cache-prewarm buffer old-viewport-width viewport-width)))))) - (if noninteractive - (ebox--with-render-gc - (funcall execute)) - (ebox--with-deferred-render-gc - (funcall execute))))) + (ebox-surface-call-with-observation + buffer 'viewport + (lambda () + (if noninteractive + (ebox--with-render-gc + (funcall execute)) + (ebox--with-deferred-render-gc + (funcall execute))))))) (defun ebox--rerender-buffer-preserving-runtime (buffer) "Rerender BUFFER from stored runtime state without rebuilding identity." @@ -4632,6 +4715,7 @@ through dirty-set and patch-set execution before falling back to root rerender." (defconst ebox-public-api '(ebox-buffer-mode + ebox-buffer-set-observer ebox-buffer-update-report ebox-build ebox-byte-compile diff --git a/tests/ebox-commit-tests.el b/tests/ebox-commit-tests.el index 19b5b59..e2efed4 100644 --- a/tests/ebox-commit-tests.el +++ b/tests/ebox-commit-tests.el @@ -34,6 +34,393 @@ (or (plist-get proof :owner-proofs) (and proof (list proof)))) +(defun ebox-commit-test--observed-root (content) + "Return one stable declarative root containing CONTENT." + (ebox-test-box :key 'root :content content)) + +(defun ebox-commit-test--hash-facts (table &optional values) + "Return sorted TABLE keys, or key/value pairs when VALUES is non-nil." + (let (facts) + (maphash (lambda (key value) + (push (if values (cons key value) key) facts)) + table) + (sort facts + (lambda (left right) + (string< (prin1-to-string left) + (prin1-to-string right)))))) + +(defun ebox-commit-test--runtime-facts (buffer) + "Return stable retained runtime facts for BUFFER equivalence checks." + (let* ((surface (with-current-buffer buffer + ebox-surface--buffer-surface)) + (state (tp-surface-client-state surface))) + (list :surface-revision (tp-surface-revision surface) + :runtime-revision (plist-get state :runtime-revision) + :last-update-report (plist-get state :last-update-report) + :viewport-width (plist-get state :viewport-width) + :viewport-height (plist-get state :viewport-height) + :projection-kind (plist-get state :projection-kind) + :node-ids + (ebox-commit-test--hash-facts (plist-get state :node-table)) + :region-ids + (ebox-commit-test--hash-facts (plist-get state :region-id-set)) + :parents + (ebox-commit-test--hash-facts (plist-get state :parent-table) t) + :type-counts + (ebox-commit-test--hash-facts + (plist-get state :runtime-type-count-table) t) + :scroll-region-ids (copy-sequence + (plist-get state :scroll-region-ids))))) + +(defun ebox-commit-test--assert-observer-pair (events stage) + "Assert reversed EVENTS contain one TP/Ebox pair for STAGE." + (should (= (length events) 2)) + (let ((ordered (nreverse events))) + (should (equal (mapcar (lambda (report) + (plist-get report :provider)) + ordered) + '(tp ebox))) + (should (equal (mapcar (lambda (report) + (plist-get report :stage)) + ordered) + (list 'publication stage))) + (should (equal (plist-get (car ordered) :correlation-id) + (plist-get (cadr ordered) :correlation-id))))) + +(ert-deftest ebox-observer-initial-mount-preserves-state-and-report-contract () + "Observed mount is equivalent and does not retain its transient report." + (let ((plain (generate-new-buffer " *ebox-observer-plain*")) + (observed (generate-new-buffer " *ebox-observer-mounted*")) + events) + (unwind-protect + (progn + (let ((ebox--region-id-counter 0) + (ebox--runtime-node-id-counter 0)) + (ebox-render-to-buffer + plain (ebox-commit-test--observed-root "same"))) + (let ((ebox--region-id-counter 0) + (ebox--runtime-node-id-counter 0)) + (ebox-render-to-buffer + observed (ebox-commit-test--observed-root "same") + (list :observer + (lambda (buffer report) + (push (list buffer report) events))))) + (should + (equal-including-properties + (ebox-commit-test--buffer-string plain) + (ebox-commit-test--buffer-string observed))) + (should (equal (ebox-commit-test--runtime-facts plain) + (ebox-commit-test--runtime-facts observed))) + (should-not (ebox-buffer-update-report plain)) + (should-not (ebox-buffer-update-report observed)) + (should (= (length events) 2)) + (let* ((ordered (nreverse events)) + (tp-report (cadar ordered)) + (ebox-report (cadadr ordered))) + (should (eq (caar ordered) observed)) + (should (eq (caadr ordered) observed)) + (should (eq (plist-get tp-report :provider) 'tp)) + (should (eq (plist-get tp-report :stage) 'publication)) + (should (eq (plist-get ebox-report :provider) 'ebox)) + (should (eq (plist-get ebox-report :stage) 'mount)) + (should (equal (plist-get tp-report :correlation-id) + (plist-get ebox-report :correlation-id))) + (dolist (key '(:duration-ms :gc-count :gc-duration-ms + :tp-duration-ms)) + (should (plist-member ebox-report key))))) + (when (buffer-live-p plain) (kill-buffer plain)) + (when (buffer-live-p observed) (kill-buffer observed))))) + +(ert-deftest ebox-observer-covers-public-update-boundaries-once () + "Viewport, region, selector, batch, and scroll each emit one flat pair." + (let ((buffer (generate-new-buffer " *ebox-observer-operations*")) + (scroll-buffer (generate-new-buffer " *ebox-observer-scroll*")) + events) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer + (ebox-build + '(column :width (viewport) + (box :id first :class card "One") + (box :id second :class card "Two"))) + (list :observer + (lambda (_buffer report) (push report events)))) + (setq events nil) + (ebox-rerender-buffer-with-context buffer 80) + (ebox-commit-test--assert-observer-pair events 'viewport) + + (setq events nil) + (ebox-region-update + (ebox-region-resolve buffer 'first) :color "#123456") + (ebox-commit-test--assert-observer-pair events 'region) + + (setq events nil) + (ebox-selector-update-buffer buffer ".card" :bgcolor "#eeeeee") + (ebox-commit-test--assert-observer-pair events 'selector) + + (setq events nil) + (ebox-incremental-begin-batch buffer) + (ebox-region-update + (ebox-region-resolve buffer 'first) :color "#654321") + (should-not events) + (ebox-incremental-flush buffer) + (ebox-commit-test--assert-observer-pair events 'batch) + + (setq events nil) + (ebox-incremental-begin-batch buffer) + (ebox-incremental-flush buffer) + (should-not events) + + (let* ((root + (ebox-build + '(box :id scroll-root :height 1 :overflow scroll + "A\nB\nC"))) + (scroll-id (car (ebox-region-ids root)))) + (ebox-render-to-buffer + scroll-buffer root + (list :observer + (lambda (_buffer report) (push report events)))) + (setq events nil) + (should (= (ebox--scroll-region-by scroll-id 1) 1)) + (ebox-commit-test--assert-observer-pair events 'scroll))) + (when (buffer-live-p buffer) (kill-buffer buffer)) + (when (buffer-live-p scroll-buffer) (kill-buffer scroll-buffer))))) + +(ert-deftest ebox-observer-commit-emits-one-flat-pair-after-completion () + "One accepted commit emits TP then the completed Ebox report exactly once." + (let (events + (buffer (generate-new-buffer " *ebox-observer-commit*"))) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "old") + (list :observer + (lambda (_buffer report) (push report events)))) + (setq events nil) + (let ((report + (ebox-commit + buffer (ebox-commit-test--observed-root "new")))) + (should (eq (plist-get report :framework-participant-state) + 'completed))) + (should (= (length events) 2)) + (let ((ordered (nreverse events))) + (should (equal (mapcar (lambda (report) + (plist-get report :provider)) + ordered) + '(tp ebox))) + (should (equal (mapcar (lambda (report) + (plist-get report :stage)) + ordered) + '(publication commit))) + (should (equal (plist-get (car ordered) :correlation-id) + (plist-get (cadr ordered) :correlation-id))) + (should (eq (plist-get (cadr ordered) + :framework-participant-state) + 'completed)))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-observer-disabled-path-does-no-instrumentation-work () + "An unobserved mount and commit bypass every Ebox instrumentation helper." + (let ((calls 0) + (buffer (generate-new-buffer " *ebox-observer-disabled*"))) + (unwind-protect + (cl-letf (((symbol-function 'ebox-surface--make-observation) + (lambda (&rest _args) (cl-incf calls))) + ((symbol-function 'ebox-surface--observation-clock) + (lambda () (cl-incf calls))) + ((symbol-function 'ebox-surface--observation-gc-snapshot) + (lambda () (cl-incf calls))) + ((symbol-function 'ebox-surface--decorate-observation-report) + (lambda (&rest _args) (cl-incf calls)))) + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "old")) + (ebox-commit buffer (ebox-commit-test--observed-root "new")) + (should (= calls 0))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-buffer-observer-setter-keeps-one-stable-tp-bridge () + "Add and replacement reuse one bridge; nil removes it from TP." + (let ((buffer (generate-new-buffer " *ebox-observer-setter*")) + first-events second-events) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "zero")) + (let ((first + (lambda (_buffer report) (push report first-events)))) + (should (eq (ebox-buffer-set-observer buffer first) first))) + (should-error (ebox-buffer-set-observer buffer 'not-a-function) + :type 'wrong-type-argument) + (let ((bridge (with-current-buffer buffer + ebox-surface--tp-observer)) + (surface (with-current-buffer buffer + ebox-surface--buffer-surface))) + (should (memq bridge (tp--surface-observers surface))) + (ebox-buffer-set-observer + buffer (lambda (_buffer report) (push report second-events))) + (should (eq bridge (with-current-buffer buffer + ebox-surface--tp-observer))) + (should (= (length (tp--surface-observers surface)) 1)) + (ebox-commit buffer (ebox-commit-test--observed-root "one")) + (should-not first-events) + (should (= (length second-events) 2)) + (should-not (ebox-buffer-set-observer buffer nil)) + (should-not (memq bridge (tp--surface-observers surface))) + (setq second-events nil) + (ebox-commit buffer (ebox-commit-test--observed-root "two")) + (should-not second-events))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-observer-render-failure-releases-new-observation-state () + "A failed observed first mount leaves no observer, bridge, or context." + (let ((buffer (generate-new-buffer " *ebox-observer-mount-failure*"))) + (unwind-protect + (progn + (cl-letf (((symbol-function 'ebox-surface-mount-buffer) + (lambda (&rest _args) (error "mount failed")))) + (should-error + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "never") + (list :observer (lambda (&rest _args)))) + :type 'error)) + (with-current-buffer buffer + (should-not ebox-surface--buffer-observer) + (should-not ebox-surface--tp-observer) + (should-not ebox-surface--observation-contexts))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-observer-boundary-rejects-outer-tp-before-operation () + "A public observation boundary cannot finish before an outer TP accept." + (let ((buffer (generate-new-buffer " *ebox-observer-outer-tp*")) + events) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-build '(box :id target "old")) + (list :observer + (lambda (_buffer report) (push report events)))) + (setq events nil) + (let ((before (ebox-commit-test--buffer-string buffer))) + (tp-with-transaction + (let ((failure + (condition-case condition + (progn + (ebox-region-update + (ebox-region-resolve buffer 'target) + :color "#123456") + nil) + (error condition)))) + (should + (equal + (cdr failure) + '("Ebox public operation cannot join an outer TP transaction"))))) + (should (equal-including-properties + before (ebox-commit-test--buffer-string buffer)))) + (should-not events) + (should-not (ebox-buffer-update-report buffer)) + (should-not (with-current-buffer buffer + ebox-surface--observation-contexts))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-observer-reentrant-publication-gets-a-new-context () + "A publication started by an observer emits its own correlated pair." + (let ((buffer (generate-new-buffer " *ebox-observer-reentrant*")) + events allow nested) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "initial") + (list + :observer + (lambda (_buffer report) + (push report events) + (when (and allow + (not nested) + (eq (plist-get report :provider) 'tp)) + (setq nested t) + (ebox-commit + buffer (ebox-commit-test--observed-root "nested")))))) + (setq events nil allow t) + (ebox-commit buffer (ebox-commit-test--observed-root "outer")) + (let* ((ordered (nreverse events)) + (outer-correlation + (plist-get (nth 0 ordered) :correlation-id)) + (nested-correlation + (plist-get (nth 1 ordered) :correlation-id))) + (should (= (length ordered) 4)) + (should (equal (mapcar (lambda (report) + (plist-get report :provider)) + ordered) + '(tp tp ebox ebox))) + (should (equal outer-correlation + (plist-get (nth 3 ordered) :correlation-id))) + (should (equal nested-correlation + (plist-get (nth 2 ordered) :correlation-id))) + (should-not (equal outer-correlation nested-correlation))) + (should + (equal (substring-no-properties + (ebox-commit-test--buffer-string buffer)) + "nested")) + (should-not (with-current-buffer buffer + ebox-surface--observation-contexts))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-observer-error-cannot-roll-back-publication () + "Each observer failure is contained after the accepted state is visible." + (let ((buffer (generate-new-buffer " *ebox-observer-error*")) + (calls 0)) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "old") + (list :observer + (lambda (_buffer _report) + (cl-incf calls) + (error "observer failure")))) + (setq calls 0) + (let ((report + (ebox-commit + buffer (ebox-commit-test--observed-root "committed")))) + (should (eq (plist-get report :framework-participant-state) + 'completed))) + (should (= calls 2)) + (should (equal (substring-no-properties + (ebox-commit-test--buffer-string buffer)) + "committed"))) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest ebox-commit-rejects-outer-tp-transaction-before-mutation () + "Observed and plain commits reject an outer TP transaction before mutation." + (dolist (observed '(nil t)) + (let ((buffer (generate-new-buffer " *ebox-outer-transaction*")) + events) + (unwind-protect + (progn + (ebox-render-to-buffer + buffer (ebox-commit-test--observed-root "old") + (and observed + (list :observer + (lambda (_buffer report) (push report events))))) + (setq events nil) + (let ((failure + (condition-case condition + (progn + (tp-with-transaction + (ebox-commit + buffer (ebox-commit-test--observed-root "new"))) + nil) + (error condition)))) + (should (equal (cdr failure) + '("Ebox public operation cannot join an outer TP transaction")))) + (should-not events) + (should (equal (substring-no-properties + (ebox-commit-test--buffer-string buffer)) + "old")) + (should-not (with-current-buffer buffer + ebox-surface--observation-contexts))) + (when (buffer-live-p buffer) (kill-buffer buffer)))))) + (ert-deftest ebox-native-fragment-style-delta-copies-only-changed-records () "A native style delta keeps the retained template immutable." (let* ((first [0 1 0 nil nil nil nil (1)]) diff --git a/tests/ebox-package-tests.el b/tests/ebox-package-tests.el index fce1cbe..02035d4 100644 --- a/tests/ebox-package-tests.el +++ b/tests/ebox-package-tests.el @@ -202,6 +202,7 @@ ("ebox-scroll-up" . "defun") ("ebox-region-update" . "defun") ("ebox-region-resolve" . "defun") + ("ebox-buffer-set-observer" . "defun") ("ebox-buffer-update-report" . "defun") ("ebox-byte-compile" . "defun") ("ebox-native-build" . "defun") @@ -219,6 +220,7 @@ (ert-deftest ebox-public-api-includes-all-public-autoloaded-entry-points () "The facade inventory should not omit an autoloaded public entry point." (dolist (entry '(ebox-byte-compile + ebox-buffer-set-observer ebox-buffer-update-report ebox-build ebox-buffer-mode