perf: expose correlated Ebox publication observation
This commit is contained in:
parent
d0ffe112e6
commit
8b28f278bd
@ -108,9 +108,10 @@ though the facade inventory below focuses on application entry points.
|
|||||||
| Function | Contract |
|
| Function | Contract |
|
||||||
| --- | --- |
|
| --- | --- |
|
||||||
| `ebox-render` | Return a propertized string without publishing a live buffer. |
|
| `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-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-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-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-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. |
|
| `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,
|
join the existing atomic publication; failures restore the previous buffer,
|
||||||
surface, runtime state, and successful report.
|
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
|
`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`
|
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`.
|
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-column-layout-create`, `ebox-flex-layout-create`,
|
||||||
`ebox-grid-layout-create`, `ebox-box-create`, `ebox-child-range`.
|
`ebox-grid-layout-create`, `ebox-box-create`, `ebox-child-range`.
|
||||||
- Render/publication: `ebox-render`, `ebox-render-to-buffer`,
|
- 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-rerender-buffer-with-context`, `ebox-viewport-window-width`,
|
||||||
`ebox-call-with-render-burst`, `ebox-render-burst-begin`,
|
`ebox-call-with-render-burst`, `ebox-render-burst-begin`,
|
||||||
`ebox-render-burst-end`.
|
`ebox-render-burst-end`.
|
||||||
|
|||||||
@ -101,9 +101,10 @@ typed 模块还公开 `ebox-node-kind`、`ebox-text-node-p`、`ebox-box-node-p`
|
|||||||
| 函数 | 契约 |
|
| 函数 | 契约 |
|
||||||
| --- | --- |
|
| --- | --- |
|
||||||
| `ebox-render` | 返回带属性字符串,不发布 live buffer。 |
|
| `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-display-buffer` | 走 retained 路径渲染,删除其他 window 后切换到结果。 |
|
||||||
| `ebox-commit` | 原子发布重新构建的 root 或 one-shot logical candidate。 |
|
| `ebox-commit` | 原子发布重新构建的 root 或 one-shot logical candidate。 |
|
||||||
|
| `ebox-buffer-set-observer` | 给已经 mounted 的 buffer 设置或移除一个 function observer。 |
|
||||||
| `ebox-buffer-update-report` | 返回最近一次成功更新报告的防御性副本。 |
|
| `ebox-buffer-update-report` | 返回最近一次成功更新报告的防御性副本。 |
|
||||||
| `ebox-rerender-buffer-with-context` | 应用显式 viewport width 与可选 height,同时保留 identity。 |
|
| `ebox-rerender-buffer-with-context` | 应用显式 viewport width 与可选 height,同时保留 identity。 |
|
||||||
| `ebox-viewport-window-width` | 返回 Ebox 对 window 使用的 display-safe 像素宽度。 |
|
| `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。它们加入现有原子发布;
|
`ebox-commit` 接受可选 framework publish/rollback callback。它们加入现有原子发布;
|
||||||
失败会恢复旧 buffer、surface、runtime state 与最近一次成功报告。
|
失败会恢复旧 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-call-with-render-burst` 是框架 callback 的 exception-safe allocation/GC 边界。
|
||||||
`ebox-render-burst-begin` 与 `ebox-render-burst-end` 提供较底层的 token 形式,必须用
|
`ebox-render-burst-begin` 与 `ebox-render-burst-end` 提供较底层的 token 形式,必须用
|
||||||
`unwind-protect` 配对。它们本身不发布内容。
|
`unwind-protect` 配对。它们本身不发布内容。
|
||||||
@ -181,7 +201,7 @@ native 模块只是加速器,不是正确性依赖。加载包不会构建它
|
|||||||
`ebox-flex-layout-create`、`ebox-grid-layout-create`、`ebox-box-create`、
|
`ebox-flex-layout-create`、`ebox-grid-layout-create`、`ebox-box-create`、
|
||||||
`ebox-child-range`;
|
`ebox-child-range`;
|
||||||
- 渲染/发布:`ebox-render`、`ebox-render-to-buffer`、`ebox-display-buffer`、
|
- 渲染/发布:`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-rerender-buffer-with-context`、`ebox-viewport-window-width`、
|
||||||
`ebox-call-with-render-burst`、`ebox-render-burst-begin`、
|
`ebox-call-with-render-burst`、`ebox-render-burst-begin`、
|
||||||
`ebox-render-burst-end`;
|
`ebox-render-burst-end`;
|
||||||
|
|||||||
@ -87,6 +87,8 @@
|
|||||||
"ebox-cache" (buffer))
|
"ebox-cache" (buffer))
|
||||||
(declare-function ebox-cache-restore-report
|
(declare-function ebox-cache-restore-report
|
||||||
"ebox-cache" (buffer snapshot))
|
"ebox-cache" (buffer snapshot))
|
||||||
|
(declare-function ebox-surface-call-with-observation
|
||||||
|
"ebox-surface" (buffer stage function))
|
||||||
(declare-function ebox-style-cascade-active-p
|
(declare-function ebox-style-cascade-active-p
|
||||||
"ebox-style" ())
|
"ebox-style" ())
|
||||||
(declare-function ebox-native-commit-plan-eligible-p
|
(declare-function ebox-native-commit-plan-eligible-p
|
||||||
@ -3937,8 +3939,8 @@ during `ebox-incremental-flush'."
|
|||||||
(ebox--ensure-node-id root)
|
(ebox--ensure-node-id root)
|
||||||
(ebox-incremental--batch-dirty-set buffer pending))))
|
(ebox-incremental--batch-dirty-set buffer pending))))
|
||||||
|
|
||||||
(defun ebox-incremental-flush (buffer)
|
(defun ebox-incremental--flush (buffer)
|
||||||
"Flush BUFFER's explicit incremental update batch."
|
"Flush BUFFER's explicit incremental update batch without observing it."
|
||||||
(unless (buffer-live-p buffer)
|
(unless (buffer-live-p buffer)
|
||||||
(error "ebox-incremental: buffer is not live: %S" buffer))
|
(error "ebox-incremental: buffer is not live: %S" buffer))
|
||||||
(let* ((state (ebox-incremental--batch-state buffer))
|
(let* ((state (ebox-incremental--batch-state buffer))
|
||||||
@ -3991,6 +3993,12 @@ during `ebox-incremental-flush'."
|
|||||||
buffer pending report))
|
buffer pending report))
|
||||||
(ebox--buffer-update-report buffer)))))
|
(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
|
;;; Declarative Root Commit
|
||||||
|
|
||||||
(defun ebox-incremental-candidate-begin (buffer)
|
(defun ebox-incremental-candidate-begin (buffer)
|
||||||
|
|||||||
@ -26,6 +26,8 @@
|
|||||||
(declare-function ebox-incremental-begin-batch "ebox-incremental" (buffer))
|
(declare-function ebox-incremental-begin-batch "ebox-incremental" (buffer))
|
||||||
(declare-function ebox-incremental-flush "ebox-incremental" (buffer))
|
(declare-function ebox-incremental-flush "ebox-incremental" (buffer))
|
||||||
(declare-function ebox-region-update "ebox" (handle &rest props))
|
(declare-function ebox-region-update "ebox" (handle &rest props))
|
||||||
|
(declare-function ebox-surface-call-with-observation
|
||||||
|
"ebox-surface" (buffer stage function))
|
||||||
|
|
||||||
(cl-defstruct
|
(cl-defstruct
|
||||||
(ebox-region-handle
|
(ebox-region-handle
|
||||||
@ -305,35 +307,40 @@ SELECTOR locates runtime nodes, then every editable match is updated through
|
|||||||
skips, and update reports."
|
skips, and update reports."
|
||||||
(unless props
|
(unless props
|
||||||
(user-error "ebox-selector: update requires at least one property"))
|
(user-error "ebox-selector: update requires at least one property"))
|
||||||
(ebox--with-render-gc
|
(let ((resolved-buffer (ebox-selector--resolve-buffer buffer)))
|
||||||
(let* ((resolved-buffer (ebox-selector--resolve-buffer buffer))
|
(ebox-surface-call-with-observation
|
||||||
(matches (ebox-selector-query-buffer resolved-buffer selector))
|
resolved-buffer 'selector
|
||||||
editable skipped reports)
|
(lambda ()
|
||||||
(unless matches
|
(ebox--with-render-gc
|
||||||
(user-error "ebox-selector: no matches for %S" selector))
|
(let ((matches
|
||||||
(dolist (match matches)
|
(ebox-selector-query-buffer resolved-buffer selector))
|
||||||
(if (plist-get match :region-handle)
|
editable skipped reports)
|
||||||
(push match editable)
|
(unless matches
|
||||||
(push (ebox-selector--skip-handle match 'no-region) skipped)))
|
(user-error "ebox-selector: no matches for %S" selector))
|
||||||
(setq editable (nreverse editable)
|
(dolist (match matches)
|
||||||
skipped (nreverse skipped))
|
(if (plist-get match :region-handle)
|
||||||
(cond
|
(push match editable)
|
||||||
((null editable)
|
(push (ebox-selector--skip-handle match 'no-region) skipped)))
|
||||||
(setq reports nil))
|
(setq editable (nreverse editable)
|
||||||
((= (length editable) 1)
|
skipped (nreverse skipped))
|
||||||
(setq reports
|
(cond
|
||||||
(list (ebox-selector--update-region (car editable) props))))
|
((null editable)
|
||||||
(t
|
(setq reports nil))
|
||||||
(ebox-incremental-begin-batch resolved-buffer)
|
((= (length editable) 1)
|
||||||
(dolist (match editable)
|
(setq reports
|
||||||
(ebox-selector--update-region match props))
|
(list (ebox-selector--update-region
|
||||||
(setq reports
|
(car editable) props))))
|
||||||
(list (ebox-incremental-flush resolved-buffer)))))
|
(t
|
||||||
(list :selector selector
|
(ebox-incremental-begin-batch resolved-buffer)
|
||||||
:matched (length matches)
|
(dolist (match editable)
|
||||||
:updated (length editable)
|
(ebox-selector--update-region match props))
|
||||||
:skipped skipped
|
(setq reports
|
||||||
:reports reports))))
|
(list (ebox-incremental-flush resolved-buffer)))))
|
||||||
|
(list :selector selector
|
||||||
|
:matched (length matches)
|
||||||
|
:updated (length editable)
|
||||||
|
:skipped skipped
|
||||||
|
:reports reports)))))))
|
||||||
|
|
||||||
(provide 'ebox-selector)
|
(provide 'ebox-selector)
|
||||||
|
|
||||||
|
|||||||
263
ebox-surface.el
263
ebox-surface.el
@ -163,10 +163,35 @@ the winning client state; otherwise only the candidate is disposable."
|
|||||||
(context plan rendered ranges &optional client-state
|
(context plan rendered ranges &optional client-state
|
||||||
full-surface-p property-contributions))
|
full-surface-p property-contributions))
|
||||||
(declare-function tp-surface-report-summary "tp-surface" (surface))
|
(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
|
(defvar-local ebox-surface--buffer-surface nil
|
||||||
"Live TP content surface mounted for the current Ebox buffer.")
|
"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
|
(cl-defstruct (ebox-surface--signals
|
||||||
(:constructor ebox-surface--make-signals))
|
(:constructor ebox-surface--make-signals))
|
||||||
"TP signals carrying one mounted Ebox surface's host context."
|
"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
|
(defvar-local ebox-surface--context-signals nil
|
||||||
"Buffer-scoped TP signals consumed by the mounted Ebox producer.")
|
"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
|
(defvar ebox-surface--scroll-line-fragment-cache
|
||||||
(make-hash-table :test #'eq :weakness 'key)
|
(make-hash-table :test #'eq :weakness 'key)
|
||||||
"Cached property-run templates for immutable rendered scroll lines.")
|
"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
|
(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)
|
&optional framework-participant observation-context)
|
||||||
"Register BUFFER runtime publication for SURFACE after OLD-STATE.
|
"Register BUFFER runtime publication for SURFACE after OLD-STATE.
|
||||||
REPORT-BASE requests an Ebox commit report. AFTER-PUBLICATION, when non-nil,
|
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.
|
||||||
@ -681,6 +908,16 @@ FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil."
|
|||||||
(ebox-surface--framework-participant-scroll-keys
|
(ebox-surface--framework-participant-scroll-keys
|
||||||
framework-participant)
|
framework-participant)
|
||||||
scroll-keys))
|
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
|
(when new-state
|
||||||
(plist-put new-state :surface surface)
|
(plist-put new-state :surface surface)
|
||||||
(plist-put new-state :runtime-revision
|
(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")))
|
(error "Ebox declarative target died during publication")))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(unwind-protect
|
(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)
|
(if (buffer-live-p buffer)
|
||||||
(progn
|
(progn
|
||||||
(when region-snapshot
|
(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
|
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."
|
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)))
|
(old-state (and surface (tp-surface-client-state surface)))
|
||||||
(context-values
|
(context-values
|
||||||
(ebox-surface--context-values buffer old-state state-overrides))
|
(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
|
(setq surface
|
||||||
(tp-surface-mount
|
(tp-surface-mount
|
||||||
buffer producer
|
buffer producer
|
||||||
'(:capability content :inhibit-read-only t
|
(append
|
||||||
:coordinate-mounts t))))
|
'(: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
|
(ebox-surface--publish-runtime-state
|
||||||
buffer surface old-state report-base after-publication
|
buffer surface old-state report-base after-publication
|
||||||
framework-participant))
|
framework-participant observation-context))
|
||||||
(setq success t)
|
(setq success t)
|
||||||
(let ((scroll-keys
|
(let ((scroll-keys
|
||||||
(if framework-participant
|
(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;
|
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."
|
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))))
|
(old-state (and surface (tp-surface-client-state surface))))
|
||||||
(unless surface
|
(unless surface
|
||||||
(error "Ebox scoped update requires a mounted TP 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))
|
(list :on-mismatch on-mismatch :return-report nil))
|
||||||
(ebox-surface--publish-runtime-state
|
(ebox-surface--publish-runtime-state
|
||||||
buffer surface old-state report-base after-publication
|
buffer surface old-state report-base after-publication
|
||||||
framework-participant))
|
framework-participant observation-context))
|
||||||
(setq success t)
|
(setq success t)
|
||||||
(let ((scroll-keys
|
(let ((scroll-keys
|
||||||
(if framework-participant
|
(if framework-participant
|
||||||
|
|||||||
190
ebox.el
190
ebox.el
@ -68,6 +68,7 @@
|
|||||||
(declare-function ebox-native-reflow--build
|
(declare-function ebox-native-reflow--build
|
||||||
"ebox-native-reflow" (&optional clean))
|
"ebox-native-reflow" (&optional clean))
|
||||||
(declare-function ebox-native-reflow--status "ebox-native-reflow" ())
|
(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-select-all #'ebox-selector-query-buffer)
|
||||||
(defalias 'ebox-update-selector #'ebox-selector-update-buffer)
|
(defalias 'ebox-update-selector #'ebox-selector-update-buffer)
|
||||||
@ -444,6 +445,21 @@ publication."
|
|||||||
buffer-or-name))
|
buffer-or-name))
|
||||||
(copy-tree (ebox--buffer-update-report buffer))))
|
(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)
|
(defun ebox--ensure-region-id (box)
|
||||||
"Return BOX's stable region id, creating one if needed."
|
"Return BOX's stable region id, creating one if needed."
|
||||||
(ebox--ensure-node-id box)
|
(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)
|
(defun ebox--scroll-region-by (region-id delta &optional prefix-budget-lines)
|
||||||
"Scroll REGION-ID by DELTA through its runtime using PREFIX-BUDGET-LINES."
|
"Scroll REGION-ID by DELTA through its runtime using PREFIX-BUDGET-LINES."
|
||||||
(let ((run
|
(let* ((state (and region-id (ebox--scroll-get-state region-id)))
|
||||||
(lambda ()
|
(buffer (and state (ebox--scroll-state-buffer state)))
|
||||||
(when-let* ((state (and region-id (ebox--scroll-get-state region-id)))
|
(execute
|
||||||
(buffer (ebox--scroll-state-buffer state)))
|
(lambda ()
|
||||||
(unless (ebox-surface-buffer-mounted-p buffer)
|
;; Scroll publication allocates a short-lived candidate
|
||||||
(error "Ebox scroll update requires a mounted TP surface"))
|
;; text/ownership plan. Keep GC out of the visible event and let
|
||||||
(ebox--surface-scroll-region-by
|
;; the existing deferred render-GC lease collect after the
|
||||||
buffer region-id delta prefix-budget-lines)))))
|
;; interaction burst; batch tests keep their deterministic
|
||||||
;; Scroll publication allocates a short-lived candidate text/ownership
|
;; threshold and never install a timer.
|
||||||
;; plan. Keep GC out of the visible event and let the existing deferred
|
(let ((native
|
||||||
;; render-GC lease collect after the interaction burst; batch tests keep
|
(and buffer
|
||||||
;; their deterministic threshold and never install a timer.
|
(ebox--native-buffer-scroll-by
|
||||||
(let ((native
|
buffer region-id delta))))
|
||||||
(when-let* ((state (and region-id
|
(if (not (eq native 'native-unavailable))
|
||||||
(ebox--scroll-get-state region-id)))
|
native
|
||||||
(buffer (ebox--scroll-state-buffer state)))
|
(let ((run
|
||||||
(ebox--native-buffer-scroll-by buffer region-id delta))))
|
(lambda ()
|
||||||
(if (not (eq native 'native-unavailable))
|
(when buffer
|
||||||
native
|
(unless (ebox-surface-buffer-mounted-p buffer)
|
||||||
(if noninteractive
|
(error
|
||||||
(funcall run)
|
"Ebox scroll update requires a mounted TP surface"))
|
||||||
(ebox--with-deferred-render-gc
|
(ebox--surface-scroll-region-by
|
||||||
(funcall run)))))))
|
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)
|
(defun ebox--scroll-progress-p (result)
|
||||||
"Return non-nil when RESULT represents consumed or pending scroll work."
|
"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 ()
|
(defun ebox--cleanup-current-buffer ()
|
||||||
"Remove Ebox runtime state owned by the 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))
|
(ebox--clear-buffer-runtime-state (current-buffer))
|
||||||
(setq-local ebox-surface--buffer-surface nil))
|
(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
|
(ebox--constraint-change-report-props
|
||||||
constraint-change)))))))))
|
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
|
;;;###autoload
|
||||||
(defun ebox-region-update (handle &rest props)
|
(defun ebox-region-update (handle &rest props)
|
||||||
"Update the box identified by surface-scoped HANDLE with PROPS.
|
"Update the box identified by surface-scoped HANDLE with PROPS.
|
||||||
@ -4284,8 +4302,16 @@ Examples:
|
|||||||
(unless (ebox-region-handle-p handle)
|
(unless (ebox-region-handle-p handle)
|
||||||
(signal (quote wrong-type-argument)
|
(signal (quote wrong-type-argument)
|
||||||
(list (quote ebox-region-handle-p) handle)))
|
(list (quote ebox-region-handle-p) handle)))
|
||||||
(ebox--with-render-gc
|
(pcase-let ((`(,buffer . ,region-id)
|
||||||
(ebox--surface-region-update handle props)))
|
(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
|
(defvar ebox-scroll-map nil
|
||||||
"Keymap for scroll interaction within ebox.")
|
"Keymap for scroll interaction within ebox.")
|
||||||
@ -4347,24 +4373,65 @@ Examples:
|
|||||||
(ebox--install-scroll-map-overrides)
|
(ebox--install-scroll-map-overrides)
|
||||||
(ebox--clear-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
|
;;;###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.
|
"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))
|
(declare (indent 1))
|
||||||
(unless (stringp node)
|
(unless (stringp node)
|
||||||
;; Validate opaque host identities before preparing a target generation.
|
;; Validate opaque host identities before preparing a target generation.
|
||||||
(ebox-tree-validate-host-refs node))
|
(ebox-tree-validate-host-refs node))
|
||||||
(let ((buffer (get-buffer-create buffer-or-name)))
|
(let* ((observer-option (ebox--render-observer-option options))
|
||||||
(ebox--with-render-gc
|
(buffer (get-buffer-create buffer-or-name))
|
||||||
(ebox-surface-mount-buffer buffer node)
|
(old-observer (ebox-surface-buffer-observer buffer))
|
||||||
(with-current-buffer buffer
|
(old-bridge (with-current-buffer buffer ebox-surface--tp-observer))
|
||||||
(goto-char (point-min))
|
success result)
|
||||||
(add-hook 'kill-buffer-hook #'ebox--cleanup-current-buffer nil t)
|
(unwind-protect
|
||||||
(ebox-buffer-mode 1)
|
(progn
|
||||||
(read-only-mode 1)
|
(when (car observer-option)
|
||||||
(ebox--schedule-buffer-runtime-prewarm buffer nil nil)
|
(ebox-surface-set-buffer-observer buffer (cdr observer-option)))
|
||||||
buffer))))
|
(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)
|
(defun ebox--host-ref-buffer (buffer-or-name)
|
||||||
"Return the live buffer named by BUFFER-OR-NAME, or nil."
|
"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'."
|
Return the successful publication report stored by `ebox-buffer-update-report'."
|
||||||
(let ((execute
|
(let ((execute
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
(when (tp-transaction-active-p)
|
||||||
|
(error "Ebox public operation cannot join an outer TP transaction"))
|
||||||
(unless (or (null framework-publish) (functionp framework-publish))
|
(unless (or (null framework-publish) (functionp framework-publish))
|
||||||
(signal 'wrong-type-argument (list 'functionp framework-publish)))
|
(signal 'wrong-type-argument (list 'functionp framework-publish)))
|
||||||
(unless (or (null framework-rollback)
|
(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)
|
(plist-get commit-input :state-overrides)
|
||||||
participant))))
|
participant))))
|
||||||
(ebox-surface--framework-participant-report participant))))))
|
(ebox-surface--framework-participant-report participant))))))
|
||||||
(if noninteractive
|
(let ((buffer (get-buffer buffer-or-name)))
|
||||||
(ebox--with-render-gc
|
(if (and (buffer-live-p buffer)
|
||||||
(funcall execute))
|
(ebox-surface-buffer-observer buffer))
|
||||||
(ebox--with-deferred-render-gc
|
(ebox-surface-call-with-observation
|
||||||
(funcall execute)))))
|
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
|
;;;###autoload
|
||||||
(defun ebox-rerender-buffer-with-context
|
(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-runtime-prewarm buffer nil t)
|
||||||
(ebox--schedule-buffer-reflow-cache-prewarm
|
(ebox--schedule-buffer-reflow-cache-prewarm
|
||||||
buffer old-viewport-width viewport-width))))))
|
buffer old-viewport-width viewport-width))))))
|
||||||
(if noninteractive
|
(ebox-surface-call-with-observation
|
||||||
(ebox--with-render-gc
|
buffer 'viewport
|
||||||
(funcall execute))
|
(lambda ()
|
||||||
(ebox--with-deferred-render-gc
|
(if noninteractive
|
||||||
(funcall execute)))))
|
(ebox--with-render-gc
|
||||||
|
(funcall execute))
|
||||||
|
(ebox--with-deferred-render-gc
|
||||||
|
(funcall execute)))))))
|
||||||
|
|
||||||
(defun ebox--rerender-buffer-preserving-runtime (buffer)
|
(defun ebox--rerender-buffer-preserving-runtime (buffer)
|
||||||
"Rerender BUFFER from stored runtime state without rebuilding identity."
|
"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
|
(defconst ebox-public-api
|
||||||
'(ebox-buffer-mode
|
'(ebox-buffer-mode
|
||||||
|
ebox-buffer-set-observer
|
||||||
ebox-buffer-update-report
|
ebox-buffer-update-report
|
||||||
ebox-build
|
ebox-build
|
||||||
ebox-byte-compile
|
ebox-byte-compile
|
||||||
|
|||||||
@ -34,6 +34,393 @@
|
|||||||
(or (plist-get proof :owner-proofs)
|
(or (plist-get proof :owner-proofs)
|
||||||
(and proof (list proof))))
|
(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 ()
|
(ert-deftest ebox-native-fragment-style-delta-copies-only-changed-records ()
|
||||||
"A native style delta keeps the retained template immutable."
|
"A native style delta keeps the retained template immutable."
|
||||||
(let* ((first [0 1 0 nil nil nil nil (1)])
|
(let* ((first [0 1 0 nil nil nil nil (1)])
|
||||||
|
|||||||
@ -202,6 +202,7 @@
|
|||||||
("ebox-scroll-up" . "defun")
|
("ebox-scroll-up" . "defun")
|
||||||
("ebox-region-update" . "defun")
|
("ebox-region-update" . "defun")
|
||||||
("ebox-region-resolve" . "defun")
|
("ebox-region-resolve" . "defun")
|
||||||
|
("ebox-buffer-set-observer" . "defun")
|
||||||
("ebox-buffer-update-report" . "defun")
|
("ebox-buffer-update-report" . "defun")
|
||||||
("ebox-byte-compile" . "defun")
|
("ebox-byte-compile" . "defun")
|
||||||
("ebox-native-build" . "defun")
|
("ebox-native-build" . "defun")
|
||||||
@ -219,6 +220,7 @@
|
|||||||
(ert-deftest ebox-public-api-includes-all-public-autoloaded-entry-points ()
|
(ert-deftest ebox-public-api-includes-all-public-autoloaded-entry-points ()
|
||||||
"The facade inventory should not omit an autoloaded public entry point."
|
"The facade inventory should not omit an autoloaded public entry point."
|
||||||
(dolist (entry '(ebox-byte-compile
|
(dolist (entry '(ebox-byte-compile
|
||||||
|
ebox-buffer-set-observer
|
||||||
ebox-buffer-update-report
|
ebox-buffer-update-report
|
||||||
ebox-build
|
ebox-build
|
||||||
ebox-buffer-mode
|
ebox-buffer-mode
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user