ebox/ebox-surface.el
Kinneyzhang 2a64573d42
Some checks are pending
CI / test (29.1) (push) Waiting to run
CI / test (30.2) (push) Waiting to run
CI / native-build (macos-latest) (push) Waiting to run
CI / native-build (ubuntu-latest) (push) Waiting to run
CI / native-build (windows-latest) (push) Waiting to run
CI / native-msrv (macos-latest) (push) Waiting to run
CI / native-msrv (ubuntu-latest) (push) Waiting to run
CI / native-msrv (windows-latest) (push) Waiting to run
Complete retained layer update and packaging contracts
2026-09-10 03:00:05 +08:00

6786 lines
336 KiB
EmacsLisp

;;; ebox-surface.el --- Retained projection and publication -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Owns the boundary from an Ebox candidate runtime to a generic TP surface
;; plan, and the atomic publication participant that mirrors the committed TP
;; generation into Ebox's buffer-local runtime indexes.
;;; Code:
(require 'cl-lib)
(require 'seq)
(require 'ebox-buffer-backend)
(require 'ebox-font)
(require 'ebox-style)
(require 'ebox-tree)
(require 'ebox-layout)
(require 'ebox-incremental)
(require 'ebox-runtime-index)
(require 'tp-reactive)
(require 'tp-surface)
(require 'tp)
(defvar ebox-region-types)
(declare-function ebox--runtime-node-ids "ebox" (node))
(defvar ebox--region-id-counter)
(defvar ebox--runtime-node-id-counter)
(defvar ebox--region-box-table)
(defvar ebox--scroll-global-state)
(defvar ebox--paint-origin-property)
(declare-function ebox--paint-origin-baseline
"ebox-render-context" (origin))
(defvar ebox--scroll-idle-prefetch-timers)
(defvar ebox--smooth-scroll-state-table)
(defvar ebox--buffer-render-state-table)
(defvar ebox--viewport-dependent-node-ids-cache)
(defvar ebox--viewport-dependent-subtree-cache)
(defvar ebox--viewport-height-dependent-subtree-cache)
(defvar ebox--render-runtime-revision)
(defvar ebox--render-source-index)
(defvar ebox-layer--active-p)
(defvar ebox--render-root-parent-kind)
(defvar ebox--render-cache-table)
(defvar ebox--render-cache-signature-cache)
(defvar ebox--layout-fragments-table)
(defvar ebox--layout-fragments-reuse-p)
(defvar ebox--flex-content-min-width-table)
(defvar ebox--scroll-window-initial-lookahead-lines-override)
(defvar ebox-viewport-width)
(defvar ebox-viewport-height)
(defvar ebox--render-display-signature)
(defvar ebox-incremental--allocated-slot-proof-cache)
(defvar ebox-incremental--buffer-render-state-override)
(declare-function tp-runtime-manifest "tp" ())
(declare-function ebox--region-ids-visible-in-buffer-p "ebox" (buffer region-ids))
(declare-function ebox--scroll-line-region-ids "ebox" (line))
(declare-function ebox--scroll-build-region-line-span-index "ebox" (lines))
(declare-function tp-transaction-participate-v2 "tp-reactive" (&rest args))
(define-error 'ebox-surface-tp-protocol-error
"Ebox requires TP 2.0.0 or newer with structured transactions")
(defun ebox-surface--validate-tp-v2-capability (manifest)
"Validate MANIFEST as the required public TP v2 participant capability."
(let ((version (plist-get manifest :version))
(api (plist-get manifest :structured-participant-api))
(protocol (plist-get manifest :transaction-protocol)))
(unless (and (stringp version)
(condition-case nil
(not (version< version "2.0.0"))
(error nil))
(memq protocol
'(tp-transaction-protocol-v1+v2
tp-transaction-protocol-v2))
(eq api 'tp-transaction-participate-v2)
(fboundp api))
(signal 'ebox-surface-tp-protocol-error
(list :accepted-protocols
'(tp-transaction-protocol-v1+v2
tp-transaction-protocol-v2)
:manifest manifest)))
t))
(defconst ebox-surface--tp-v2-capability-valid-p
(ebox-surface--validate-tp-v2-capability (tp-runtime-manifest))
"Non-nil after the loaded TP manifest passes the required v2 contract.")
(defun ebox-surface--transaction-participate (key stage rollback)
"Register KEY with paired STAGE and ROLLBACK through TP v2."
(tp-transaction-participate-v2
:key key :stage stage :rollback rollback))
(defvar ebox-surface--inline-style-value-cache nil
"Per-projection cache for selector-free computed inline styles.")
(defvar ebox-surface--font-window nil
"Canonical target window frozen for one Surface projection.")
(defvar ebox-surface--integral-local-output-required-p nil
"Non-nil while a partial render must prove an integral pixel origin.")
(defun ebox-surface--check-local-pixel-output (output)
"Decline fractional local OUTPUT before footprint or ownership proofs.
The enclosing producer catches the decline and renders the complete root."
(when (and ebox-surface--integral-local-output-required-p
(stringp output) (ebox--fractional-pixel-spaces-p output))
(throw 'ebox/fractional-local-output nil))
output)
(defun ebox-surface--mixed-range-splice-p (state)
"Return non-nil when STATE's mixed proof contains one Range splice."
(let ((proof (plist-get (plist-get state :mixed-owner-proof) :geometry-proof)))
(or (plist-get proof :range-splice-p)
(cl-some (lambda (owner-proof)
(plist-get owner-proof :range-splice-p))
(plist-get proof :owner-proofs)))))
(declare-function ebox--render-layout "ebox-layout" (node))
(declare-function ebox--maplines "ebox" (function string))
(declare-function ebox--ensure-node-id "ebox" (node))
(declare-function ebox-native-commit-render
"ebox-native-commit" (state node))
(declare-function ebox-native-commit-confirm-published-frame
"ebox-native-commit" (state published-revision))
(declare-function ebox-native-commit-attach-confirmed-base
"ebox-native-commit" (previous-state state))
(declare-function ebox-native-reflow-frame-fragments
"ebox-native-reflow" (frame))
(declare-function ebox-native-reflow-layout-ready-p
"ebox-native-reflow" ())
(declare-function ebox-native-reflow-release-session
"ebox-native-reflow" (session))
(declare-function ebox-native-commit-projection-eligible-p
"ebox-native-commit"
(previous-state state-overrides stylesheet-active-p))
(defun ebox-surface--release-native-session (session)
"Release native SESSION when it is present."
(when (and session (require 'ebox-native-reflow nil t))
(ebox-native-reflow-release-session session)))
(defun ebox-surface--settle-native-session
(old-state state-overrides surface committed-p)
"Retire the losing native session after one candidate publication.
OLD-STATE owns the committed session before publication. STATE-OVERRIDES
owns the isolated candidate. When COMMITTED-P is non-nil, SURFACE identifies
the winning client state; otherwise only the candidate is disposable."
(let ((old-session (plist-get old-state :native-sync-session))
(candidate-session
(plist-get state-overrides :native-sync-session))
(committed-session
(and committed-p surface
(plist-get (tp-surface-client-state surface)
:native-sync-session)))
diagnostics)
(cl-labels
((release-loser
(session)
(let ((inhibit-quit t) (quit-flag nil))
(condition-case condition
(ebox-surface--release-native-session session)
((error quit)
(push (list :phase 'native-session-retirement
:session-id (sxhash-eq session)
:condition (copy-tree condition))
diagnostics))))))
(if committed-p
(dolist (session
(delete-dups
(delq nil (list old-session candidate-session))))
(unless (eq session committed-session)
(release-loser session)))
(when (and candidate-session
(not (eq candidate-session old-session)))
(release-loser candidate-session))))
(nreverse diagnostics)))
(declare-function tp-object-reuse "tp-surface" (context object))
(declare-function tp-object-ensure-at
"tp-surface" (context parent key kind position))
(declare-function tp-bind-precomputed
"tp-reactive"
(owner key compute value dependencies &rest options))
(declare-function ebox--record-render-output-provenance
"ebox-render-context" (rendered))
(declare-function ebox--render-owned-text-value-p
"ebox-render-context" (property value &optional registry))
(declare-function ebox-incremental--hash-snapshot
"ebox-incremental" (table keys))
(declare-function ebox-incremental--restore-hash-snapshot
"ebox-incremental" (table entries))
(declare-function ebox-incremental--replace-hash-entries
"ebox-incremental" (target keys source))
(declare-function ebox--runtime-region-id-conflict
"ebox-incremental" (region-id-set target-buffer))
(declare-function ebox--region-id-set
"ebox-incremental" (region-ids))
(declare-function ebox--flex-item-slot-sized-node
"ebox-incremental"
(buffer node-id snapshot &optional changed-keys))
(declare-function ebox--layout-snapshot-strip-details
"ebox-incremental" (snapshot))
(declare-function ebox--viewport-dependent-node-id-axes
"ebox-incremental" (node))
(declare-function ebox--update-report
"ebox-incremental" (region-id strategy &rest props))
(declare-function ebox-incremental--finalize-declarative-scroll-publication
"ebox-incremental" (scroll-keys &optional prefetch-delay))
(declare-function ebox--scroll-schedule-idle-prefetch
"ebox" (region-id &optional delay))
(declare-function ebox--scroll-clear-state "ebox" (region-id))
(declare-function ebox--smooth-scroll-stop "ebox" (region-id))
(declare-function ebox-put "ebox" (box property value))
(declare-function ebox-get "ebox" (box property))
(declare-function ebox-string-lines "ebox" (string))
(declare-function ebox-lines-join "ebox" (lines))
(declare-function ebox--scroll-state-rendered-visible-window
"ebox" (state))
(declare-function ebox--scroll-state-retained-window-ready-p
"ebox" (state))
(declare-function ebox--scroll-box-contains-grid-p
"ebox" (box))
(declare-function ebox--scroll-line-region-span
"ebox" (line region-set))
(declare-function ebox-buffer--span-slot-width
"ebox-buffer-backend" (span))
(declare-function ebox-pixel-space "ebox" (pixel-width))
(declare-function tp-object-mounted-p "tp-surface" (object))
(declare-function tp-object-attach-content-ranges-owned
"tp-surface" (context leaf ranges))
(declare-function tp-text-snapshot
"tp-core" (text &optional reuse-property-p))
(declare-function tp-surface-plan-create-owned
"tp-surface" (&rest arguments))
(declare-function tp-surface-result-create-owned
"tp-surface" (context plan &optional client-state))
(declare-function tp-surface-retained-content-result-create
"tp-surface"
(context plan rendered ranges &optional client-state
full-surface-p 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."
buffer viewport-width viewport-height display scroll)
(cl-defstruct (ebox-surface--framework-participant
(:constructor ebox-surface--make-framework-participant))
"One Ebox-owned framework publication participant."
publish rollback state report diagnostics runtime-state scroll-keys
scroll-diagnostics)
(defun ebox-surface--record-native-retirement-diagnostics
(surface participant diagnostics)
"Record native retirement DIAGNOSTICS for SURFACE and PARTICIPANT."
(let ((state (tp-surface-client-state surface)))
(if diagnostics
(progn
(plist-put state :native-retirement-diagnostics
(copy-tree diagnostics))
(when participant
(setf (ebox-surface--framework-participant-diagnostics participant)
(append
(ebox-surface--framework-participant-diagnostics participant)
(copy-tree diagnostics)))))
(cl-remf state :native-retirement-diagnostics)))
diagnostics)
(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.")
(defun ebox-surface--scroll-line-fragment-template (line)
"Return a reusable fragment template for rendered LINE, or nil.
The cache is keyed by the immutable line string object retained by scroll
state. Lines whose ownership is only implied through a neighboring line are
left on the conservative full fragment scanner path."
(or (gethash line ebox-surface--scroll-line-fragment-cache)
(let ((fragments (ebox-surface--rendered-fragments line)))
(when (and fragments
(cl-every (lambda (fragment)
(plist-get fragment :role-ids))
fragments))
(puthash line fragments ebox-surface--scroll-line-fragment-cache)
fragments))))
(defun ebox-surface--scroll-fragment-data (lines rendered)
"Return offset fragments for visible LINES in RENDERED, or nil.
Each cached line template is copied only at the plist spine and points at the
single joined RENDERED string. The text and role values remain candidate
owned; no per-fragment substring is allocated."
(cl-block ebox-surface--scroll-fragment-data
(let ((offset 0)
(line-index 0)
result)
(dolist (line lines)
(let ((template (ebox-surface--scroll-line-fragment-template line)))
(unless template
(cl-return-from ebox-surface--scroll-fragment-data nil))
(dolist (fragment template)
(let ((copy (copy-sequence fragment)))
(plist-put copy :text rendered)
(plist-put copy :start (+ offset (plist-get fragment :start)))
(plist-put copy :end (+ offset (plist-get fragment :end)))
(plist-put copy :line line-index)
(push copy result))))
(setq offset (+ offset (length line) 1))
(setq line-index (1+ line-index)))
(nreverse result))))
(defun ebox-surface--scroll-lines-owned-p (lines)
"Return non-nil when every rendered line has an owned fragment template."
(and lines
(cl-every #'ebox-surface--scroll-line-fragment-template lines)))
(defun ebox-surface--style-state-table (previous-state)
"Copy retained style state from PREVIOUS-STATE into a weak table."
(let ((table (make-hash-table :test 'eq :weakness 'key)))
(when-let* ((previous (plist-get previous-state :style-binding-states)))
(maphash (lambda (object state) (puthash object state table)) previous))
table))
(defun ebox-surface--stylesheet-signature ()
"Return one immutable snapshot of the active Ebox stylesheet."
(list (ecss-stylesheet-rules ebox-style-stylesheet)
(ecss-stylesheet-layers ebox-style-stylesheet)))
(defun ebox-surface--subject-signature (subject)
"Return SUBJECT's complete selector subtree without retaining parent cycles."
(cl-labels
((subtree (node)
(list (ecss-subject-type node) (ecss-subject-id node)
(ecss-subject-classes node)
(ecss-subject-attributes node)
(ecss-subject-states node)
(mapcar #'subtree (ecss-subject-children node)))))
(subtree subject)))
(defun ebox-surface--subject-local-equal-p (left right)
"Return non-nil when LEFT and RIGHT expose equal local selector fields."
(and left right
(equal (ecss-subject-type left) (ecss-subject-type right))
(equal (ecss-subject-id left) (ecss-subject-id right))
(equal (ecss-subject-classes left) (ecss-subject-classes right))
(equal (ecss-subject-attributes left)
(ecss-subject-attributes right))
(equal (ecss-subject-states left) (ecss-subject-states right))))
(defun ebox-surface--stylesheet-subject-local-p (stylesheet-signature)
"Return non-nil when STYLESHEET-SIGNATURE has only local selector rules.
Scoped rules remain tree-dependent because scope distance reads ancestors."
(cl-every
(lambda (rule)
(and (null (ecss-rule-scope rule))
(ecss-selector-subject-local-p (ecss-rule-selector rule))))
(car stylesheet-signature)))
(defconst ebox-surface--root-key 'ebox/surface
"Stable TP key for an Ebox surface projection root.")
(defconst ebox-surface--nodes-key 'ebox/nodes
"Stable TP key for the retained logical Ebox node tree.")
(defconst ebox-surface--fragments-key 'ebox/fragments
"Stable TP key for linear rendered fragments.")
(defconst ebox-surface--text-key 'ebox/text
"Stable TP key for the shared rendered text leaf.")
(defconst ebox-surface--inherited-style-properties
ebox-style--inherited-properties
"ECSS properties whose inline values can flow to descendants.")
(defun ebox-surface--style-consuming-node-p (node)
"Return non-nil when NODE owns a paintable style surface."
(eq (plist-get node :ebox-type) 'box))
(defun ebox-surface--inherited-style-consumer-p (node)
"Return non-nil when NODE materializes inherited text style.
Canonical Box passes inherited facts through to descendants; canonical Text
is their final paint/typography owner. A legacy Box without a canonical kind
continues to own its inline text directly."
(and (eq (plist-get node :ebox-type) 'box)
(or (eq (plist-get node :ebox-kind) 'text)
(null (plist-get node :ebox-kind)))))
(defun ebox-surface--inline-inheritance-required-p (root source-index)
"Return non-nil when ROOT in SOURCE-INDEX requires an ECSS cascade.
An empty stylesheet still needs a cascade when an inherited declaration can
reach a descendant that does not declare the same property. Other inline
declarations are already projected into the candidate engine fields at node
construction time and can use the static projection path."
(let ((pending (list (cons root nil)))
required)
(while (and pending (not required))
(let* ((entry (pop pending))
(node (car entry))
(inherited (cdr entry))
(declarations
(ebox-style-node-declarations source-index node)))
(when (cl-some (lambda (property)
(and (ebox-surface--inherited-style-consumer-p node)
(memq property inherited)
(not (plist-member declarations property))))
ebox-surface--inherited-style-properties)
(setq required t))
(unless required
(let ((next (copy-sequence inherited)))
(dolist (property ebox-surface--inherited-style-properties)
(when (plist-member declarations property)
(cl-pushnew property next)))
(ebox-tree-for-each-direct-child
node (lambda (child) (push (cons child next) pending)))))))
required))
(defun ebox-surface--signals-live-p (signals)
"Return non-nil when every signal in SIGNALS is live."
(and (ebox-surface--signals-p signals)
(buffer-live-p (ebox-surface--signals-buffer signals))
(cl-every
#'tp-signal-live-p
(list (ebox-surface--signals-viewport-width signals)
(ebox-surface--signals-viewport-height signals)
(ebox-surface--signals-display signals)
(ebox-surface--signals-scroll signals)))))
(defun ebox-surface--dispose-signals (signals)
"Dispose live TP SIGNALS owned by an abandoned Ebox mount."
(when (ebox-surface--signals-p signals)
(dolist (signal
(list (ebox-surface--signals-viewport-width signals)
(ebox-surface--signals-viewport-height signals)
(ebox-surface--signals-display signals)
(ebox-surface--signals-scroll signals)))
(when (tp-signal-live-p signal)
(tp-signal-dispose signal)))
(when-let* ((buffer (ebox-surface--signals-buffer signals)))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (eq ebox-surface--context-signals signals)
(setq-local ebox-surface--context-signals nil)))))))
(defun ebox-surface--scroll-offsets (table)
"Return immutable sorted scroll offsets copied from TABLE."
(let (offsets)
(when (hash-table-p table)
(maphash
(lambda (region-id state)
(push (cons region-id (or (plist-get state :scroll-offset) 0))
offsets))
table))
(sort offsets (lambda (left right) (< (car left) (car right))))))
(defun ebox-surface--buffer-display-window (buffer)
"Return the canonical live display window for BUFFER.
Prefer the window the user is interacting with, then the selected frame, then
another visible frame. One mounted surface owns one viewport, so all context
and resize paths must consume this same choice."
(or (and (window-live-p (selected-window))
(eq (window-buffer (selected-window)) buffer)
(selected-window))
(get-buffer-window buffer (selected-frame))
(get-buffer-window buffer t)
(and (not noninteractive) (selected-window))))
(defun ebox-surface--context-values
(buffer old-state state-overrides)
"Return BUFFER context values after OLD-STATE and STATE-OVERRIDES."
(cl-labels
((value (key fallback)
(if (plist-member state-overrides key)
(plist-get state-overrides key)
(if (plist-member old-state key)
(plist-get old-state key)
fallback))))
(let ((scroll-table
(value :scroll-state-table
(plist-get old-state :scroll-state-table)))
(window (ebox-surface--buffer-display-window buffer)))
(list :viewport-width
(value :viewport-width
(or ebox-viewport-width
(and (window-live-p window)
(ebox-surface--window-content-width window))))
:viewport-height
(value :viewport-height
(or ebox-viewport-height
(and (window-live-p window)
(window-body-height window))))
:display-signature
(value :display-signature
(with-current-buffer buffer
(ebox--display-signature-for-window window)))
:display-window window
:scroll-offsets
(ebox-surface--scroll-offsets scroll-table)))))
(defun ebox-surface--window-content-width (window)
"Return a safe pixel content width for live WINDOW.
Some Emacs GUI builds return a column-like half-width even when
`window-body-width' is called with PIXELWISE non-nil. When the result is
clearly inconsistent with the outer pixel width, prefer the outer width and
reserve two character columns for Emacs continuation/truncation display.
Headless/test windows retain the body width fallback."
(let ((body
(condition-case nil
(window-body-width window t)
(wrong-number-of-arguments nil)))
(outer
(condition-case nil
(window-pixel-width window)
(error nil))))
(let* ((char-width
(condition-case nil
(frame-char-width (window-frame window))
(error 1)))
(reserve (max 2 (* 2 (max 1 char-width)))))
(max 0
(- (if (and body outer (> outer (* 1.8 body)))
outer
(or body outer 0))
reserve)))))
(defun ebox-surface--ensure-signals (buffer values)
"Return BUFFER's context signals for VALUES and whether they were created."
(let ((signals
(with-current-buffer buffer ebox-surface--context-signals)))
(if (ebox-surface--signals-live-p signals)
(cons signals nil)
(when signals (ebox-surface--dispose-signals signals))
(setq signals
(ebox-surface--make-signals
:buffer buffer
:viewport-width
(tp-signal-create (plist-get values :viewport-width)
:scope buffer)
:viewport-height
(tp-signal-create (plist-get values :viewport-height)
:scope buffer)
:display
(tp-signal-create (plist-get values :display-signature)
:scope buffer)
:scroll
(tp-signal-create (plist-get values :scroll-offsets)
:scope buffer)))
(with-current-buffer buffer
(setq-local ebox-surface--context-signals signals))
(cons signals t))))
(defun ebox-surface--stage-signal-values (signals values)
"Stage VALUES into TP context SIGNALS in the active transaction."
(tp-signal-set (ebox-surface--signals-viewport-width signals)
(plist-get values :viewport-width))
(tp-signal-set (ebox-surface--signals-viewport-height signals)
(plist-get values :viewport-height))
(tp-signal-set (ebox-surface--signals-display signals)
(plist-get values :display-signature))
(tp-signal-set (ebox-surface--signals-scroll signals)
(plist-get values :scroll-offsets)))
(defun ebox-surface--live-buffer-surface (buffer)
"Return BUFFER's live Ebox TP surface, or nil."
(when (buffer-live-p buffer)
(let ((surface
(with-current-buffer buffer ebox-surface--buffer-surface)))
(and (tp-surface-live-p surface) surface))))
(defun ebox-surface--buffer-client-state (buffer)
"Return BUFFER's live TP client state for incremental context reads."
(when-let* ((surface (ebox-surface--live-buffer-surface buffer)))
(tp-surface-client-state surface)))
(defun ebox-surface-buffer-mounted-p (buffer)
"Return non-nil when BUFFER has a live Ebox TP surface."
(not (null (ebox-surface--live-buffer-surface buffer))))
(defun ebox-surface-buffer-revision (buffer)
"Return BUFFER's committed TP surface revision or fail when unmounted."
(if-let* ((surface (ebox-surface--live-buffer-surface buffer)))
(tp-surface-revision surface)
(error "Ebox buffer has no committed surface revision: %S" buffer)))
(defun ebox-surface--snapshot-root (root)
"Detach ROOT's structural and mutable input data from a live mount.
Opaque capabilities, including functions, keymaps and source handles, keep
identity. No runtime identity, cache or TP attachment is exported."
(let ((copy (ebox-tree-copy-node-structure root))
(copies (make-hash-table :test #'eq)))
(cl-labels
((data (value)
(cond
((or (functionp value) (keymapp value)) value)
((gethash value copies))
((ebox-layout-config-p value)
(let ((result (ebox-layout-config--copy value)))
(puthash value result copies)
result))
((recordp value) value)
((stringp value)
(let ((result (copy-sequence value)) (position 0))
(puthash value result copies)
(while (< position (length value))
(let ((end (next-property-change position value (length value))))
(set-text-properties position end
(data (text-properties-at position value))
result)
(setq position end)))
result))
((consp value)
(let ((result (cons nil nil)))
(puthash value result copies)
(setcar result (data (car value)))
(setcdr result (data (cdr value)))
result))
((hash-table-p value)
(let ((result (copy-hash-table value)))
(puthash value result copies)
(clrhash result)
(maphash (lambda (key item) (puthash (data key) (data item) result))
value)
result))
((char-table-p value)
(let* ((result (copy-sequence value))
(default (char-table-range value nil))
(parent (char-table-parent value))
(missing (make-symbol "no-extra-slot"))
(index 0)
extra)
(puthash value result copies)
;; Traverse only explicit entries; materializing inherited or
;; default values would change later lookup semantics.
(set-char-table-parent result nil)
(set-char-table-range result nil nil)
(map-char-table
(lambda (range item) (set-char-table-range result range (data item)))
result)
(set-char-table-range result nil (data default))
(set-char-table-parent result (data parent))
(while (not (eq missing
(setq extra
(condition-case nil
(char-table-extra-slot value index)
(args-out-of-range missing)))))
(set-char-table-extra-slot result index (data extra))
(setq index (1+ index)))
result))
((vectorp value)
(let ((result (copy-sequence value)))
(puthash value result copies)
(dotimes (index (length result))
(aset result index (data (aref value index))))
result))
((bool-vector-p value)
(let ((result (copy-sequence value)))
(puthash value result copies)
result))
(t value)))
(visit (node)
(cl-loop for tail on node by #'cddr
for key = (car tail)
unless (memq key ebox-tree--child-source-keys)
do (setcar (cdr tail)
(unless (memq key ebox-tree--runtime-source-keys)
(data (cadr tail)))))
(ebox-tree-for-each-direct-child node #'visit)))
(visit copy))
copy))
(defun ebox-surface-buffer-snapshot (buffer)
"Export BUFFER's current committed canonical input on explicit request.
Return a plist with :input, :revision and :mount-id. The integer mount ID
distinguishes remounts whose revisions may coincide. Query is rejected while
a TP transaction is active or BUFFER has no live Ebox surface.
This explicit operation copies node structure and mutable input data, retaining
exact immutable source facts and opaque capabilities such as callbacks and
keymaps. It neither renders nor publishes, and never advances the revision.
Cost is linear in exported data plus TP's latest retained diagnostic report.
The returned input survives later commits and unmounting; it can be rendered
independently. It does not freeze external capabilities or the display
environment, and old Host references gain no authority over another mount."
(when (tp-transaction-active-p)
(error "Ebox committed snapshot is unavailable during a TP transaction"))
(let* ((surface (or (ebox-surface--live-buffer-surface buffer)
(error "Ebox buffer has no committed snapshot: %S" buffer)))
(state (tp-surface-client-state surface))
(revision (tp-surface-revision surface))
(root (ebox-surface--snapshot-root (plist-get state :root-node)))
(builder (ebox-source-builder-create)))
(ebox-source-builder-import builder (plist-get state :source-index))
(list :input (ebox-canonical-input-create
(list root) (ebox-source-builder-finish builder))
:revision revision
:mount-id (plist-get (tp-surface-inspect surface) :id))))
(defun ebox-surface-region-mounts (buffer region-id &optional roles)
"Return REGION-ID's TP-owned output mounts in BUFFER.
When ROLES is non-nil, keep only direct mounts owning a listed Ebox role.
Without ROLES, include descendant output attached to the region's object.
The returned ranges are numeric snapshots; TP retains marker ownership."
(when-let* ((surface (ebox-surface--live-buffer-surface buffer))
(state (tp-surface-client-state surface))
(table (plist-get state :region-surface-object-table))
(object (gethash region-id table)))
(cl-remove-if-not
(lambda (mount)
(let ((tags (plist-get mount :tags)))
(if roles
(and (equal (plist-get tags :ebox/region-id) region-id)
(cl-intersection roles (plist-get tags :ebox/roles)))
(or (equal (plist-get tags :ebox/region-id) region-id)
(plist-get tags :ebox/descendant-output)))))
(tp-object-mounts object))))
(defun ebox-surface-region-bounds (buffer region-id &optional roles)
"Return numeric bounds for REGION-ID's TP mounts in BUFFER.
ROLES has the same filtering meaning as in `ebox-surface-region-mounts'."
(when-let* ((mounts (ebox-surface-region-mounts buffer region-id roles)))
(cons (apply #'min (mapcar (lambda (mount) (plist-get mount :start)) mounts))
(apply #'max (mapcar (lambda (mount) (plist-get mount :end)) mounts)))))
(defun ebox-surface--runtime-keys (state key)
"Return hash keys stored under KEY in runtime STATE."
(when-let* ((table (plist-get state key)))
(ebox-surface--hash-keys table)))
(defun ebox-surface--bind-scroll-states-to-buffer (state buffer)
"Bind every semantic scroll state in STATE to its owning BUFFER."
(when-let* ((table (plist-get state :scroll-state-table)))
(maphash
(lambda (region-id scroll-state)
(puthash region-id (plist-put scroll-state :buffer buffer) table))
table)))
(defun ebox-surface--commit-report (surface state report-base)
"Return Ebox's compact report for SURFACE, STATE, and REPORT-BASE."
(let* ((tp-report (tp-surface-report-summary surface))
(text-operations (or (plist-get tp-report :text-operations) 0))
(property-operations
(or (plist-get tp-report :property-operations) 0))
(patch-count (+ text-operations property-operations))
(report (copy-sequence report-base))
(native-fallback-reason
(or (plist-get state :native-render-fallback)
(plist-get state :native-session-setup-failure)))
(scoped-p (and (not (plist-get tp-report :full-root))
(> (or (plist-get tp-report :scope-count) 0) 0)))
(planned-publication-scope (plist-get report :publication-scope)))
(dolist (entry
`((:runtime-published . t)
(:runtime-revision . ,(plist-get state :runtime-revision))
(:projection-kind . ,(plist-get state :projection-kind))
(:native-frame-kind . ,(plist-get state :native-frame-kind))
(:surface-revision . ,(tp-surface-revision surface))
(:publication-scope . tp-surface)
(:planned-publication-scope . ,planned-publication-scope)
(:tp-render-scope . ,(if scoped-p 'objects 'surface-plan))
(:tp-full-root . ,(plist-get tp-report :full-root))
(:tp-scope-count . ,(plist-get tp-report :scope-count))
(:tp-scope-range-count
. ,(plist-get tp-report :scope-range-count))
(:tp-scope-fallback . ,(plist-get tp-report :scope-fallback))
(:tp-retained-content . ,(plist-get tp-report :retained-content-p))
(:tp-operation-count . ,patch-count)
(:tp-transaction-id . ,(plist-get tp-report :transaction-id))
(:tp-text-operations . ,text-operations)
(:tp-property-operations . ,property-operations)
(:reconciled-objects
. ,(plist-get tp-report :reconciled-objects))
(:created-objects . ,(plist-get tp-report :created-objects))
(:removed-objects . ,(plist-get tp-report :removed-objects))
(:moved-objects . ,(plist-get tp-report :moved-objects))))
(setq report (plist-put report (car entry) (cdr entry))))
(when native-fallback-reason
;; Planner fields describe the rejected native attempt. Replace them
;; with the ordinary full-surface publication that actually committed;
;; preserve the attempt only as report diagnostics.
(dolist (key '(:owner-ids :owner-type
:constraint-owner-id :constraint-owner-type))
(cl-remf report key))
(setq report (plist-put report :strategy 'ordinary-fallback))
(setq report
(plist-put report :patch-ops
(and (> patch-count 0) '(tp-surface))))
(setq report (plist-put report :patch-count patch-count))
(setq report (plist-put report :render-scope 'surface))
(setq report (plist-put report :publication-scope 'root))
(setq report (plist-put report :root-rerender t))
(setq report (plist-put report :native-attempt 'failed))
(setq report
(plist-put report :native-fallback-reason
native-fallback-reason))
(cl-remf state :native-render-fallback)
(cl-remf state :native-session-setup-failure))
(unless (plist-member report :strategy)
(setq report
(plist-put report :strategy
(if (zerop patch-count) 'no-op 'surface-commit))))
(unless (plist-member report :constraint-source)
(setq report (plist-put report :constraint-source 'declarative)))
(unless (plist-member report :constraint-root-node-id)
(setq report
(plist-put report :constraint-root-node-id
(plist-get (plist-get state :root-node) :node-id))))
(unless (plist-member report :dirty-count)
(setq report
(plist-put report :dirty-count
(if (zerop patch-count) 0 1))))
(unless (plist-member report :patch-count)
(setq report (plist-put report :patch-count patch-count)))
(unless (plist-member report :patch-ops)
(setq report
(plist-put report :patch-ops
(and (> patch-count 0) '(tp-surface)))))
report))
(defun ebox-surface--participant-report (participant report state)
"Attach PARTICIPANT's read-only STATE and diagnostics to REPORT."
(when participant
(setq report (plist-put report :framework-participant-state state))
(setq report
(plist-put report :framework-participant-diagnostics
(copy-tree
(ebox-surface--framework-participant-diagnostics
participant))))
(setq report
(plist-put report :scroll-finalization-diagnostics
(copy-tree
(ebox-surface--framework-participant-scroll-diagnostics
participant))))
(setf (ebox-surface--framework-participant-report participant) report))
report)
(defun ebox-surface--participant-run-publish (participant report)
"Publish PARTICIPANT with REPORT exactly once and return updated REPORT."
(unless (eq (ebox-surface--framework-participant-state participant)
'unpublished)
(error "Ebox framework participant is not unpublished"))
(setf (ebox-surface--framework-participant-state participant) 'published)
(setq report (ebox-surface--participant-report participant report 'published))
(when-let* ((publish (ebox-surface--framework-participant-publish participant)))
(funcall publish report))
report)
(defun ebox-surface--participant-run-rollback (participant)
"Run PARTICIPANT's paired rollback once without allowing failure to escape."
(when (and participant
(eq (ebox-surface--framework-participant-state participant)
'published))
(setf (ebox-surface--framework-participant-state participant) 'rolled-back)
(ebox-surface--participant-report
participant (ebox-surface--framework-participant-report participant)
'rolled-back)
(when-let* ((rollback
(ebox-surface--framework-participant-rollback participant)))
(let ((inhibit-quit t)
(quit-flag nil))
(condition-case failure
(funcall rollback
(ebox-surface--framework-participant-report participant))
((error quit)
(push (list :phase 'framework-rollback :condition failure)
(ebox-surface--framework-participant-diagnostics
participant))))))
(ebox-surface--participant-report
participant (ebox-surface--framework-participant-report participant)
'rolled-back)))
(defun ebox-surface--participant-complete (participant diagnostics)
"Complete PARTICIPANT after scroll DIAGNOSTICS are contained."
(when participant
(setf (ebox-surface--framework-participant-scroll-diagnostics participant)
diagnostics)
(let* ((state
(ebox-surface--framework-participant-runtime-state participant))
(report (ebox-surface--framework-participant-report participant))
(started
(plist-get report :framework-initial-observation-started)))
(when started
(let* ((surface (plist-get state :surface))
(tp-report (tp-surface-report surface))
(transaction-id (plist-get tp-report :transaction-id))
(ebox-report (copy-tree report)))
(cl-remf report :framework-initial-observation-started)
(cl-remf ebox-report :framework-initial-observation-started)
(dolist (entry `((:provider . tp)
(:stage . publication)
(:status . success)
(:correlation-id . ,transaction-id)))
(setq tp-report (plist-put tp-report (car entry) (cdr entry))))
(dolist (entry `((:provider . ebox)
(:stage . mount)
(:status . success)
(:duration-ms
. ,(* 1000.0 (- (float-time) started)))
(:correlation-id . ,transaction-id)
(:framework-participant-state . completed)))
(setq ebox-report (plist-put ebox-report (car entry) (cdr entry))))
(setq report
(plist-put
report :framework-initial-observation-reports
(list tp-report ebox-report)))))
(plist-put state :last-update-report
(ebox-surface--participant-report
participant report 'completed)))
(setf (ebox-surface--framework-participant-state participant) 'completed)))
(defun ebox-surface--participant-complete-postaccept (participant diagnostics)
"Complete PARTICIPANT with DIAGNOSTICS after accept without throwing."
(when participant
(let ((inhibit-quit t) (quit-flag nil) completion-condition)
(condition-case condition
(ebox-surface--participant-complete participant diagnostics)
((error quit) (setq completion-condition condition)))
(when completion-condition
(let* ((diagnostic
(list :phase 'framework-report-finalization
:condition (copy-tree completion-condition)))
(state
(ebox-surface--framework-participant-runtime-state participant))
(report
(ebox-surface--framework-participant-report participant)))
(push diagnostic
(ebox-surface--framework-participant-diagnostics participant))
(setf (ebox-surface--framework-participant-scroll-diagnostics
participant)
diagnostics)
(unwind-protect
(condition-case secondary
(progn
(cl-remf report :framework-initial-observation-started)
(setq report
(plist-put report :framework-participant-state
'completed)
report
(plist-put
report :framework-participant-diagnostics
(copy-tree
(ebox-surface--framework-participant-diagnostics
participant)))
report
(plist-put report :scroll-finalization-diagnostics
(copy-tree diagnostics)))
(setf (ebox-surface--framework-participant-report participant)
report)
(when state
(plist-put state :last-update-report report)))
((error quit)
(push (list :phase 'framework-report-finalization-diagnostic
:condition (copy-tree secondary))
(ebox-surface--framework-participant-diagnostics
participant))))
(setf (ebox-surface--framework-participant-state participant)
'completed)))))
participant))
(defun ebox-surface--publish-runtime-state
(buffer surface old-state report-base after-publication
&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.
FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil."
(let (new-state region-snapshot scroll-snapshot
old-surface old-mirror region-keys scroll-keys)
(ebox-surface--transaction-participate
(list 'ebox/runtime buffer)
(lambda ()
(setq new-state (tp-surface-client-state surface)
old-surface
(with-current-buffer buffer ebox-surface--buffer-surface)
old-mirror (gethash buffer ebox--buffer-render-state-table)
region-keys
(delete-dups
(append (ebox-surface--runtime-keys old-state :region-id-set)
(ebox-surface--runtime-keys new-state :region-id-set)))
scroll-keys
(delete-dups
(append (copy-sequence (plist-get old-state :scroll-region-ids))
(copy-sequence (plist-get new-state :scroll-region-ids)))))
(setq region-snapshot
(ebox-incremental--hash-snapshot
ebox--region-box-table region-keys)
scroll-snapshot
(ebox-incremental--hash-snapshot
ebox--scroll-global-state scroll-keys))
(when framework-participant
(setf (ebox-surface--framework-participant-runtime-state
framework-participant)
new-state
(ebox-surface--framework-participant-scroll-keys
framework-participant)
scroll-keys))
(when 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
(1- (tp-surface-revision surface)))
;; TP now exposes this exact candidate revision, but the surrounding
;; transaction can still restore both TP and Ebox state. Confirm the
;; private Rust frame here so a failure aborts publication and the
;; old confirmed session remains untouched.
(when (plist-get new-state :native-sync-pending)
(ebox-native-commit-confirm-published-frame
new-state (tp-surface-revision surface)))
;; A fixed-basis role-owned patch rendered against the previous
;; allocation. Its installed details describe that proof render,
;; not the now-committed TP mounts. Drop only those owners' derived
;; geometry so the next transaction lazily captures the committed
;; spans and cannot drift across a repeated selection round trip.
(when-let* ((snapshots (plist-get new-state :layout-snapshots)))
(dolist (proof (plist-get new-state :owner-scoped-proofs))
(when (plist-get proof :role-owned-lines-p)
(let ((owner-id (plist-get proof :owner-id)))
(when-let* ((snapshot (gethash owner-id snapshots)))
(puthash owner-id
(ebox--layout-snapshot-strip-details snapshot)
snapshots))))))
(when (plist-get report-base :scroll-state-transaction)
;; Scroll changes invalidate every buffer-span coordinate. Keep
;; the committed generation structurally snapshot-free so a later
;; hidden-owner update recaptures spans from the current buffer,
;; never from the pre-scroll marker positions.
(plist-put new-state :layout-snapshots
(make-hash-table :test 'equal))
(plist-put new-state :layout-snapshots-complete-p nil))
(ebox-surface--bind-scroll-states-to-buffer new-state buffer)
(when report-base
(plist-put new-state :last-update-report
(ebox-surface--commit-report
surface new-state report-base))))
(with-current-buffer buffer
(setq-local ebox-surface--buffer-surface surface))
(if new-state
(puthash buffer new-state ebox--buffer-render-state-table)
(remhash buffer ebox--buffer-render-state-table))
(ebox-incremental--replace-hash-entries
ebox--region-box-table region-keys
(plist-get new-state :region-box-table))
(ebox-incremental--replace-hash-entries
ebox--scroll-global-state scroll-keys
(plist-get new-state :scroll-state-table))
(if framework-participant
(plist-put
new-state :last-update-report
(ebox-surface--participant-run-publish
framework-participant
(plist-get new-state :last-update-report)))
(when after-publication
(funcall after-publication
(plist-get new-state :last-update-report))))
(unless (buffer-live-p buffer)
(error "Ebox declarative target died during publication")))
(lambda ()
(unwind-protect
(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
(ebox-incremental--restore-hash-snapshot
ebox--region-box-table region-snapshot))
(when scroll-snapshot
(ebox-incremental--restore-hash-snapshot
ebox--scroll-global-state scroll-snapshot))
(with-current-buffer buffer
(setq-local ebox-surface--buffer-surface old-surface))
(if old-mirror
(puthash buffer old-mirror ebox--buffer-render-state-table)
(remhash buffer ebox--buffer-render-state-table)))
(remhash buffer ebox--buffer-render-state-table)
(dolist (region-id region-keys)
(remhash region-id ebox--region-box-table))
(dolist (region-id scroll-keys)
(ebox--scroll-clear-state region-id)
(ebox--smooth-scroll-stop region-id))))))))
(defun ebox-surface-mount-buffer
(buffer source &optional report-base after-publication
preserve-identities-p state-overrides framework-participant)
"Mount or atomically update BUFFER from Ebox SOURCE and return its surface.
REPORT-BASE requests a committed Ebox report. AFTER-PUBLICATION runs inside
the rollback-capable transaction. PRESERVE-IDENTITIES-P retains identities
already present in a logical candidate. STATE-OVERRIDES augments its runtime.
FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil."
(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))
(signals-result
(ebox-surface--ensure-signals buffer context-values))
(signals (car signals-result))
(signals-created-p (cdr signals-result))
(preserve-identities-p
(or preserve-identities-p
(and (null old-state)
(ebox-surface--source-identities-available-p
source buffer))))
(producer
(ebox-surface-producer
source old-state preserve-identities-p state-overrides signals))
success native-settled-p)
(unwind-protect
(progn
(let ((ebox-surface--font-window
(plist-get context-values :display-window)))
(tp-with-transaction
(ebox-surface--stage-signal-values signals context-values)
(if surface
(tp-surface-update surface producer)
(setq surface
(tp-surface-mount
buffer producer
(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 observation-context)))
(setq success t)
(let* ((scroll-keys
(if framework-participant
(ebox-surface--framework-participant-scroll-keys
framework-participant)
(let ((new-state (tp-surface-client-state surface)))
(delete-dups
(append
(copy-sequence
(plist-get old-state :scroll-region-ids))
(copy-sequence
(plist-get new-state :scroll-region-ids)))))))
(scroll-diagnostics
(ebox-incremental--finalize-declarative-scroll-publication
scroll-keys))
(native-diagnostics
(ebox-surface--settle-native-session
old-state state-overrides surface t)))
(setq native-settled-p t)
(ebox-surface--record-native-retirement-diagnostics
surface framework-participant native-diagnostics)
(ebox-surface--participant-complete-postaccept
framework-participant scroll-diagnostics))
surface)
(unless native-settled-p
;; Candidate cleanup is post-transaction and must not hide the primary
;; publication condition. The helper contains every release fault.
(ebox-surface--settle-native-session
old-state state-overrides surface success))
(when (and signals-created-p (not success))
(ebox-surface--dispose-signals signals)))))
(defun ebox-surface--viewport-report (state width height axes strategy)
"Return a viewport report for STATE, WIDTH, HEIGHT, AXES, and STRATEGY."
(let ((root (plist-get state :root-node)))
(ebox--update-report
nil strategy
:constraint-source 'viewport
:constraint-owner-id 'viewport
:constraint-owner-type 'viewport
:constraint-root-node-id (plist-get root :node-id)
:viewport-axes axes
:target-viewport-width width
:target-viewport-height height
:dirty-kinds (unless (eq axes 'none) '(geometry))
:dirty-count (if (eq axes 'none) 0 1)
:patch-count (if (eq axes 'none) 0 1)
:patch-ops (unless (eq axes 'none) '(root-rerender))
:owner-ids (unless (eq axes 'none)
(list (plist-get root :node-id)))
:root-rerender (not (eq axes 'none)))))
(defun ebox-surface--publish-context-no-op
(buffer surface state values state-overrides report)
"Commit VALUES and no-op STATE-OVERRIDES into STATE for BUFFER and SURFACE."
(let ((signals
(with-current-buffer buffer ebox-surface--context-signals))
(old-width (plist-get state :viewport-width))
(old-height (plist-get state :viewport-height))
(old-display (plist-get state :display-signature))
(old-report (plist-get state :last-update-report)))
(unless (ebox-surface--signals-live-p signals)
(error "Ebox mounted surface has no live context signals"))
(tp-with-transaction
(ebox-surface--stage-signal-values signals values)
(ebox-surface--transaction-participate
(list 'ebox/context-no-op buffer)
(lambda ()
(unless (eq state (tp-surface-client-state surface))
(error "Ebox no-op context unexpectedly published a surface"))
(plist-put state :viewport-width
(plist-get state-overrides :viewport-width))
(plist-put state :viewport-height
(plist-get state-overrides :viewport-height))
(plist-put state :display-signature
(plist-get state-overrides :display-signature))
(plist-put state :last-update-report report))
(lambda ()
(plist-put state :viewport-width old-width)
(plist-put state :viewport-height old-height)
(plist-put state :display-signature old-display)
(plist-put state :last-update-report old-report))))
report))
(defun ebox-surface-update-buffer-viewport (buffer width &optional height)
"Publish BUFFER for viewport WIDTH and optional HEIGHT through TP."
(let* ((surface (ebox-surface--live-buffer-surface buffer))
(state (and surface (tp-surface-client-state surface))))
(unless state
(error "Ebox viewport update requires a mounted TP surface"))
(let* ((old-width (plist-get state :viewport-width))
(old-height (plist-get state :viewport-height))
(target-height (or height old-height))
(window (ebox-surface--buffer-display-window buffer))
(display-signature
(with-current-buffer buffer
(ebox--display-signature-for-window window)))
(display-changed
(not (equal display-signature
(plist-get state :display-signature))))
(width-changed (not (equal width old-width)))
(height-changed (not (equal target-height old-height)))
(style-context-stable-p
(equal (ebox-surface--stylesheet-signature)
(plist-get state :stylesheet-signature)))
(axes (cond ((and width-changed height-changed) 'both)
(width-changed 'width)
(height-changed 'height)
(t 'none))))
(if (and (eq axes 'none) (not display-changed))
(let ((report
(ebox-surface--viewport-report
state width target-height axes 'no-op)))
(plist-put state :last-update-report report)
report)
(ebox-incremental--notify-before-runtime-mutation buffer 'viewport)
(unless (eq state (tp-surface-client-state surface))
(error "Ebox runtime changed during viewport update notification"))
(let ((commit-input
(ebox-incremental-prepare-viewport-commit
buffer width target-height axes display-signature
style-context-stable-p)))
(if (plist-get commit-input :no-op)
(let* ((state-overrides
(plist-get commit-input :state-overrides))
(values
(ebox-surface--context-values
buffer state state-overrides)))
(ebox-surface--publish-context-no-op
buffer surface state values state-overrides
(plist-get commit-input :report-base)))
(ebox-surface-update-buffer-scoped
buffer
(plist-get commit-input :root)
(plist-get commit-input :scope-node-ids)
(plist-get commit-input :report-base)
(plist-get commit-input :state-overrides)
nil nil 0
(plist-get commit-input :projection-kind)
;; The incremental viewport candidate aliases the published root
;; while it proves the reflow shape. Let the surface create its
;; own copy before layout can attach caches or TP handles.
nil)
(plist-get (tp-surface-client-state surface)
:last-update-report)))))))
(defun ebox-surface--projection-start
(context root &optional style-required-p projection-kind previous-state
state-overrides)
"Create retained TP identities and optional computed styles for ROOT.
STYLE-REQUIRED-P is non-nil when the candidate must refresh cascade results.
When it is nil, inline declarations already projected by node construction
are sufficient for the static layout pass. PROJECTION-KIND may request a
strict span patch or retained viewport reflow, both of which reuse
PREVIOUS-STATE's node-object table."
(let* ((surface-root
(tp-object-ensure context nil ebox-surface--root-key 'ebox/surface))
(node-root
(tp-object-ensure context surface-root
ebox-surface--nodes-key 'ebox/nodes))
(source-index
(or (plist-get state-overrides :source-index)
(and (eq root (plist-get previous-state :root-node))
(plist-get previous-state :source-index))
(ebox-tree-source-index root)))
(range-splice-p
(and (eq projection-kind 'mixed-owner-reflow)
(ebox-surface--mixed-range-splice-p state-overrides)))
(retained-span-style-p
;; Variable content can change its slot's text extent without
;; changing the already prepared cascade. Rebuilding subjects here
;; discarded its validated Host index and triggered a full reindex.
(and (eq projection-kind 'span-patch)
(plist-get state-overrides :computed-participation-validated-p)
(let ((proofs (plist-get state-overrides :owner-scoped-proofs)))
(and proofs
(cl-every (lambda (proof)
(plist-get proof :static-cascade-p))
proofs)))))
(objects-by-node
(if (memq projection-kind
'(span-patch owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow
viewport-reflow viewport-reflow-mixed-scroll
native-frame))
(if (or (eq projection-kind 'native-frame) range-splice-p)
(make-hash-table :test 'eq)
(or (plist-get previous-state :surface-node-object-table)
(error "Ebox span projection has no retained node table")))
(make-hash-table :test 'eq)))
(style-state-table
(ebox-surface--style-state-table previous-state))
(ebox-surface--inline-style-value-cache
(and style-required-p
(not (ebox-style-cascade-active-p))
(make-hash-table :test 'equal)))
(stylesheet-signature
(and style-required-p
(if (or retained-span-style-p
(and (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow))
(not range-splice-p)))
nil
(ebox-surface--stylesheet-signature))))
(stylesheet-subject-local-p
(and stylesheet-signature
(ebox-surface--stylesheet-subject-local-p
stylesheet-signature)))
(bindings-by-subject (make-hash-table :test 'eq))
(states-by-subject (make-hash-table :test 'eq))
(subjects-required-p
(and style-required-p
(not (and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p)))
(not (or retained-span-style-p
(and (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow
mixed-owner-reflow))
(not range-splice-p))))))
(_materialized-source-index
(when (and subjects-required-p
(ebox-source--index-derived-stale-p source-index)
(not
(when-let* ((previous-index
(plist-get previous-state :source-index)))
(and
(ebox-source--index-node-subjects source-index)
(not (ebox-source--index-derived-stale-p previous-index))
(eq (ebox-source--index-subjects source-index)
(ebox-source--index-subjects previous-index))))))
;; A local delta copies touched subjects, while unchanged children
;; can still reference their previous parent subjects. A full
;; style projection needs coherent ancestry for its eq-keyed
;; bindings. A declaration-only rebind instead shares an already
;; validated subject tree and merely invalidates query entries;
;; retain that persistent tree. Never certify a previously stale
;; tree from table identity alone. Local projections above do not
;; request subjects and retain their O(changed) source-index path.
(setq source-index
(ebox-tree-source-index
root t ebox--render-root-parent-kind source-index))))
(subjects (when subjects-required-p
(ebox-tree-subject-index root source-index)))
(selector-tree-snapshot
(if (or retained-span-style-p
(and (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow
native-frame))
(not range-splice-p)))
(plist-get previous-state :selector-tree-snapshot)
(and subjects
(ebox-surface--subject-signature
(plist-get subjects :root-subject)))))
(selector-tree-token
(if (or retained-span-style-p
(and (memq projection-kind
'(owner-scoped scroll-patch native-frame))
(not range-splice-p)))
(plist-get previous-state :selector-tree-token)
(and selector-tree-snapshot
(if (and (equal selector-tree-snapshot
(plist-get previous-state
:selector-tree-snapshot))
(plist-get previous-state :selector-tree-token))
(plist-get previous-state :selector-tree-token)
(cons 'ebox/selector-tree nil))))))
(cond
((eq projection-kind 'native-frame)
(ebox-surface--project-node-delta
context root source-index previous-state state-overrides
node-root objects-by-node
(and subjects (plist-get subjects :node-subject-table))
bindings-by-subject states-by-subject style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p))
(range-splice-p
(ebox-surface--project-node-delta
context root source-index previous-state state-overrides
node-root objects-by-node
(and subjects (plist-get subjects :node-subject-table))
bindings-by-subject states-by-subject style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p))
((memq projection-kind
'(span-patch owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow
viewport-reflow viewport-reflow-mixed-scroll))
(tp-object-reuse-subtree context node-root))
(t
(tp-object-retain context node-root)
(ebox-surface--ensure-node-tree
context node-root root source-index objects-by-node
(and subjects (plist-get subjects :node-subject-table))
bindings-by-subject states-by-subject style-state-table
stylesheet-signature
selector-tree-token stylesheet-subject-local-p
ebox--render-root-parent-kind)))
(when (and subjects (> (ebox-tree-author-style-count root) 0))
(ebox-tree-clear-author-style-pending root))
(list :surface-root surface-root
:node-root node-root
:source-index source-index
:objects-by-node objects-by-node
:style-binding-states style-state-table
:stylesheet-signature stylesheet-signature
:selector-tree-snapshot selector-tree-snapshot
:selector-tree-token selector-tree-token)))
(defun ebox-surface--project-stable-node-table
(context nodes node-root old-objects objects-by-node)
"Reuse native NODES whose object topology is proven unchanged."
(tp-object-reuse-subtree context node-root)
(ebox-runtime-index-map
(lambda (node-id node)
(let ((object (gethash node-id old-objects)))
(unless object
(error "Ebox native projection lost retained node %S" node-id))
(plist-put node :surface-object object)
(puthash node object objects-by-node)))
nodes)
objects-by-node)
(defun ebox-surface--project-node-delta
(context root source-index previous-state state-overrides
node-root objects-by-node
subject-table bindings-by-subject states-by-subject
style-state-table stylesheet-signature selector-tree-token
stylesheet-subject-local-p)
"Project ROOT objects from its exact native touched-node delta."
(let* ((nodes (plist-get state-overrides :node-table))
(parents (plist-get state-overrides :parent-table))
(touched-ids (plist-get state-overrides :native-touched-node-ids))
(old-objects (plist-get previous-state :surface-node-object-table))
(touched (make-hash-table :test 'equal))
(objects-by-id (make-hash-table :test 'equal)))
(unless (and (ebox-runtime-index-like-p nodes) (ebox-runtime-index-like-p parents)
(hash-table-p old-objects)
(or (plist-get state-overrides :native-topology-stable-p)
touched-ids))
(error "Ebox native projection has no candidate object delta"))
(if (plist-get state-overrides :native-topology-stable-p)
(ebox-surface--project-stable-node-table
context nodes node-root old-objects objects-by-node)
(tp-object-retain context node-root)
(dolist (node-id touched-ids) (puthash node-id t touched))
(ebox-runtime-index-map
(lambda (node-id node)
(when subject-table
(when-let* ((subject
(ebox-source--subject-table-get
subject-table (ebox-tree-node-source-handle node)))
(object (gethash node-id old-objects))
(style-state (gethash object style-state-table))
(binding (plist-get style-state :binding)))
(puthash subject binding bindings-by-subject)
(puthash subject style-state states-by-subject)))
(unless (gethash node-id touched)
(let ((object (gethash node-id old-objects)))
(unless object
(error "Ebox native projection lost retained node %S" node-id))
(tp-object-reuse context object)
(puthash node object objects-by-node)
(puthash node-id object objects-by-id))))
nodes)
(dolist (node-id touched-ids)
(let* ((node (ebox-runtime-index-get node-id nodes))
(parent-id (and node (ebox-runtime-index-get node-id parents)))
(old-object (and node (gethash node-id old-objects)))
(parent-node (and parent-id (ebox-runtime-index-get parent-id nodes)))
(position
(if parent-node
(or (cl-position
node (ebox-tree--children-raw parent-node) :test #'eq)
(error "Ebox native projection lost child position"))
0))
(parent (if parent-id
(gethash parent-id objects-by-id)
node-root)))
(unless (and node parent)
(error "Ebox native projection has an unordered node delta"))
(let ((object
(tp-object-ensure-at context parent
(ebox-surface--node-key
source-index node)
(ebox-surface--node-kind node)
position)))
(tp-object-retain context object)
(if (eq object old-object)
(tp-object-reuse context object)
(when subject-table
(ebox-surface--apply-node-style
source-index object node subject-table bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token stylesheet-subject-local-p)))
(plist-put node :surface-object object)
(puthash node object objects-by-node)
(puthash node-id object objects-by-id))))
(unless (gethash (plist-get root :node-id) objects-by-id)
(error "Ebox native projection lost its root object"))
(when (and subject-table
(not (plist-get state-overrides
:computed-participation-validated-p)))
(ebox-tree-validate-indexed-participation
nodes parents touched-ids 'computed)))
objects-by-node))
(defun ebox-surface--complete-projection
(context root source-index style-required-p projection)
"Complete a retained PROJECTION for ROOT after a local proof miss.
The local attempt already owns the surface and node-root identities in
CONTEXT, so full fallback must populate those same objects instead of creating
the projection roots a second time."
(when (and style-required-p
(ebox-source--index-derived-stale-p source-index))
;; Local subject deltas can retain a child's old parent object. The full
;; style walk requires one coherent ancestry for its eq-keyed bindings.
(setq source-index
(ebox-tree-source-index
root t ebox--render-root-parent-kind source-index)))
(let* ((node-root (plist-get projection :node-root))
;; The retained projection may share the published node-id table.
;; Full projection visits every node and writes node-keyed entries.
(objects-by-node (make-hash-table :test 'eq))
(style-state-table
(plist-get projection :style-binding-states))
(stylesheet-signature
(or (plist-get projection :stylesheet-signature)
(and style-required-p
(ebox-surface--stylesheet-signature))))
(stylesheet-subject-local-p
(and stylesheet-signature
(ebox-surface--stylesheet-subject-local-p
stylesheet-signature)))
(selector-tree-token
(plist-get projection :selector-tree-token))
(bindings-by-subject (make-hash-table :test 'eq))
(states-by-subject (make-hash-table :test 'eq))
(subjects (when style-required-p
(ebox-tree-subject-index root source-index))))
(plist-put projection :source-index source-index)
(plist-put projection :objects-by-node objects-by-node)
(tp-object-retain context node-root)
(ebox-surface--ensure-node-tree
context node-root root source-index objects-by-node
(and subjects (plist-get subjects :node-subject-table))
bindings-by-subject states-by-subject style-state-table
stylesheet-signature
selector-tree-token stylesheet-subject-local-p
ebox--render-root-parent-kind)
(when (> (ebox-tree-author-style-count root) 0)
(ebox-tree-clear-author-style-pending root))
projection))
(defun ebox-surface--native-full-frame-p (state projection-kind)
"Return non-nil when STATE owns a complete native surface frame."
(and (eq projection-kind 'native-frame)
(plist-get state :native-topology-stable-p)
(let ((frame (plist-get state :native-render-frame)))
(and (plist-get frame :native-frame)
(not (plist-get frame :native-patch))))))
(defun ebox-surface--projection-result
(context projection state output &optional projection-kind)
"Complete CONTEXT PROJECTION for STATE from rendered OUTPUT."
(let* ((surface-root (plist-get projection :surface-root))
(objects-by-node (plist-get projection :objects-by-node))
(root-node (plist-get state :root-node))
(root-id (and root-node (plist-get root-node :node-id)))
(owner-id (plist-get state :span-patch-owner-id))
(scroll-fast-p (and (eq projection-kind 'scroll-patch)
(plist-get state :scroll-fast-window-p)))
(native-retained-p
(and (eq projection-kind 'native-frame)
(plist-get state :native-topology-stable-p)
(plist-get state :native-render-frame)
(plist-get (plist-get state :native-render-frame)
:native-patch)))
(full-surface-p
(or (and scroll-fast-p
(plist-get state :retained-scroll-content-p)
root-id owner-id (= root-id owner-id))
(ebox-surface--native-full-frame-p state projection-kind)))
(previous-owned-ranges
(plist-get state :previous-surface-owned-ranges))
(retained-owned-ranges
(and (or (and (eq projection-kind 'mixed-owner-reflow)
(eq (plist-get (plist-get state :mixed-owner-proof)
:geometry-kind)
'span-patch)
(not (ebox-surface--mixed-range-splice-p state)))
(and (memq projection-kind '(span-patch owner-scoped))
(null (plist-get state :paint-property-contributions))
(let ((proofs (plist-get state :owner-scoped-proofs)))
(and (= (length proofs) 1)
(not (plist-get (car proofs) :range-splice-p))))))
(plist-get state :span-patch-retained-owned-ranges)))
(node-objects
(or (and scroll-fast-p
(plist-get state :surface-node-object-table))
(ebox-surface--node-object-table objects-by-node)))
(region-objects
(or (and scroll-fast-p
(plist-get state :region-surface-object-table))
(ebox-surface--region-object-table state node-objects)))
(property-contributions
(plist-get state :paint-property-contributions)))
;; Paint contributions belong to this one publication. Keep them out of
;; the transferred client state so later paint cannot replay old layers.
(cl-remf state :paint-property-contributions)
(cl-remf state :span-patch-retained-owned-ranges)
(plist-put state :surface-node-object-table node-objects)
(plist-put state :region-surface-object-table region-objects)
(unless (and scroll-fast-p
(plist-get state :surface-object-region-table))
(plist-put state :surface-object-region-table
(ebox-surface--object-region-table region-objects)))
(unless (and scroll-fast-p
(plist-get state :logical-id-region-table))
(plist-put state :logical-id-region-table
(ebox-surface--logical-id-region-table state region-objects)))
(or (and native-retained-p
(ebox-surface--native-patch-result
context projection state output node-objects region-objects))
(and (or (null property-contributions) retained-owned-ranges)
(memq projection-kind
'(span-patch owner-scoped mixed-owner-reflow))
(ebox-surface--span-coordinate-result
context projection state output previous-owned-ranges
property-contributions retained-owned-ranges))
(let* ((range-splice-p
(and (eq projection-kind 'mixed-owner-reflow)
(ebox-surface--mixed-range-splice-p state)))
(prepared
(ebox-surface--surface-plan
context surface-root output state node-objects region-objects
scroll-fast-p))
(plan (car prepared))
(rendered (cadr prepared))
(owned-ranges (nth 2 prepared)))
(or (and (null property-contributions)
(memq projection-kind
'(span-patch owner-scoped mixed-owner-reflow))
(when-let* ((batch
(ebox-surface--coordinate-batch
state rendered previous-owned-ranges)))
(tp-commit-batch-result-create
context batch
:mount-specs
(ebox-surface--commit-mount-specs
(nth 3 prepared) owned-ranges)
:client-state state)))
(if (and (not range-splice-p)
(or full-surface-p native-retained-p
property-contributions))
(tp-surface-retained-content-result-create
context plan rendered owned-ranges state
full-surface-p property-contributions)
(tp-surface-result-create-owned context plan state)))))))
(defun ebox-surface--native-patch-result
(context projection state rendered node-objects region-objects)
"Return a TP batch directly from STATE's exact native patch, or nil."
(let ((frame (plist-get state :native-render-frame)))
(when (and (plist-get frame :native-patch)
(plist-get state :native-topology-stable-p)
(stringp rendered))
(let* ((surface-root (plist-get projection :surface-root))
(fragment-root
(tp-object-ensure context surface-root
ebox-surface--fragments-key 'ebox/fragments))
(text-leaf
(tp-object-ensure context fragment-root
ebox-surface--text-key 'ebox/text))
(fragment-data
(plist-get state :native-render-fragment-template))
(reuse-mount-projection-p
(and (plist-get state :native-reuse-mount-projection-p) t))
(owned-ranges
(if (or reuse-mount-projection-p
(plist-get state :native-reuse-ownership-p))
(let ((ranges
(plist-get state :native-committed-owned-ranges)))
(unless ranges
(error "Native retained frame has no ownership base"))
ranges)
(unless (vectorp fragment-data)
(error "Native retained patch has no target fragments"))
(ebox-surface--native-owned-ranges
context text-leaf fragment-data state node-objects
region-objects nil)))
(rendered-length (length rendered))
(mount-records
(list (list :object text-leaf :start 0 :end rendered-length
:props nil :tags nil :leaf t)
(list :object fragment-root :start 0 :end rendered-length
:props nil :tags nil :leaf nil)
(list :object surface-root :start 0 :end rendered-length
:props nil :tags nil :leaf nil))))
(plist-put state :surface-owned-ranges owned-ranges)
(plist-put state :native-committed-rendered rendered)
(plist-put state :native-committed-owned-ranges owned-ranges)
(plist-put state :native-committed-fragment-template fragment-data)
(plist-put state :surface-fragments (list :native-frame frame))
(cl-remf state :native-reuse-ownership-p)
(cl-remf state :native-reuse-mount-projection-p)
(cl-remf state :native-coordinate-patches)
(cl-remf state :native-render-output)
(cl-remf state :native-render-fragments)
(cl-remf state :native-render-fragment-template)
(cl-remf state :native-render-frame)
(cl-remf state :previous-surface-owned-ranges)
(ebox-surface--native-commit-batch
context state mount-records owned-ranges
reuse-mount-projection-p)))))
(defun ebox-surface--coordinate-patches-identity-p (frame)
"Return non-nil when FRAME preserves every character coordinate."
(and (= (plist-get frame :base-character-count)
(plist-get frame :target-character-count))
(cl-every
(lambda (patch)
(and (= (plist-get patch :old-start)
(plist-get patch :new-start))
(= (plist-get patch :old-end)
(plist-get patch :new-end))))
(plist-get frame :coordinate-patches))))
(defun ebox-surface--commit-mount-specs (records owned-ranges)
"Return exact target mount specs from RECORDS and OWNED-RANGES.
The text record precedes logical ownership ranges, matching TP's normal
content projection order; fragment and surface records follow unchanged."
(unless records
(error "Ebox native commit has no target mount records"))
(append (list (car records)) owned-ranges (cdr records)))
(defun ebox-surface--native-commit-batch
(context state mount-records owned-ranges &optional retain-mount-state-p)
"Return a strict TP batch result for STATE's stable-topology native patch."
(let* ((frame (or (plist-get state :native-render-frame)
(plist-get (plist-get state :surface-fragments)
:native-frame)))
(patches (and frame (plist-get frame :patches)))
(base (and frame (plist-get frame :base-character-count)))
(target (and frame (plist-get frame :target-character-count))))
(when (and (plist-get frame :native-patch)
(plist-get state :native-topology-stable-p)
(integerp base) (integerp target)
(proper-list-p patches))
(let ((batch
(tp-commit-batch-create
:base-revision (plist-get state :runtime-revision)
:target-revision (1+ (plist-get state :runtime-revision))
:base-extent base :target-extent target
:patches patches
:coordinate-patches (plist-get frame :coordinate-patches))))
(if retain-mount-state-p
(tp-commit-batch-result-create
context batch :client-state state :reuse-mount-projection t)
(tp-commit-batch-result-create
context batch
:mount-specs
(ebox-surface--commit-mount-specs mount-records owned-ranges)
:client-state state))))))
(defun ebox-surface--patch-property-contributions
(patches contributions extent)
"Return fresh PATCHES carrying completely covered CONTRIBUTIONS, or nil.
CONTRIBUTIONS use target coordinates bounded by EXTENT. Preserve their order
inside every patch; a gap rejects the batch rather than dropping paint."
(when (proper-list-p contributions)
(catch 'uncovered
(let* ((targets (vconcat (mapcar #'copy-sequence patches)))
(count (length targets))
(layers (make-vector count nil)))
(dolist (contribution contributions)
(let ((start (plist-get contribution :start))
(end (plist-get contribution :end))
(props (plist-get contribution :props)))
;; Validate the original interval before clipping. On a proof
;; miss the retained-content path reports invalid inputs through
;; TP's ordinary contribution validator.
(unless (and (integerp start) (integerp end)
(<= 0 start end extent)
(ebox-style--valid-plist-p props)
(cl-loop for (key _value) on props by #'cddr
always (symbolp key)))
(throw 'uncovered nil))
(when (< start end)
(let ((low 0) (high count) (position start))
;; Patches are ordered and disjoint. Locate the first one
;; once per layer, then visit only its actual intersections.
(while (< low high)
(let ((middle (/ (+ low high) 2)))
(if (<= (plist-get (aref targets middle) :new-end) start)
(setq low (1+ middle))
(setq high middle))))
(while (< position end)
(when (>= low count) (throw 'uncovered nil))
(let* ((patch (aref targets low))
(patch-start (plist-get patch :new-start))
(next (min end (plist-get patch :new-end))))
(when (> patch-start position) (throw 'uncovered nil))
(when (< position next)
(push (list :start (- position patch-start)
:end (- next patch-start) :props props)
(aref layers low)))
(setq position next low (1+ low))))))))
(dotimes (index count)
(when (aref layers index)
(aset targets index
(plist-put (aref targets index) :property-contributions
(nreverse (aref layers index))))))
(append targets nil)))))
(defun ebox-surface--coordinate-batch
(state rendered previous-owned-ranges
&optional property-contributions retained-origin)
"Return STATE's exact proven-owner coordinate batch, or nil.
RENDERED is the candidate text. PREVIOUS-OWNED-RANGES identify the committed
owner intervals. The mixed
projection has already produced exact coordinate patches and final text; this
function composes those retained facts into TP's standard validated commit
batch without asking TP to rediscover the same diff from a full plan.
PROPERTY-CONTRIBUTIONS add ordered target paint. RETAINED-ORIGIN is the live
surface origin when an exact ownership proof permits indexed owner lookup.
This proof step does not register objects in the active prepare context."
(let* ((proof (plist-get state :mixed-owner-proof))
(owner-ids
(or (plist-get proof :owner-ids)
(mapcar (lambda (owner-proof)
(plist-get owner-proof :owner-id))
(plist-get state :owner-scoped-proofs))
(and (plist-get state :span-patch-owner-id)
(list (plist-get state :span-patch-owner-id)))))
(objects (plist-get state :surface-node-object-table))
(coordinate-patches (plist-get state :content-coordinate-patches))
(target-extent (and (stringp rendered) (length rendered)))
(source-extent (plist-get state :content-base-extent))
owner-set intervals)
(when (and owner-ids (hash-table-p objects) coordinate-patches
(integerp source-extent) (integerp target-extent)
previous-owned-ranges)
(setq owner-set (make-hash-table :test #'eq))
(dolist (owner-id owner-ids)
(when-let* ((object (gethash owner-id objects)))
(puthash object t owner-set)))
;; Coordinate patches are the authoritative old-to-new mapping for
;; changed content. Owner mounts supplement that mapping with
;; property-only intervals (for example a button whose enabled face
;; changes after a preceding Range grows). Starting from owner mounts
;; alone loses every boundary inside a replacement by design, leaving
;; later intervals shifted without the patch that introduced the shift.
(setq intervals
(mapcar
(lambda (patch)
(list :old-start (plist-get patch :old-start)
:old-end (plist-get patch :old-end)
:new-start (plist-get patch :new-start)
:new-end (plist-get patch :new-end)))
coordinate-patches))
(if retained-origin
;; The strict retained-property witness preserves the complete
;; mount projection. Read just the changed owners from TP's
;; existing index, including baseline-only paint removals.
(maphash
(lambda (object _present)
(dolist (mount (tp-object-mounts object))
(let ((start (- (plist-get mount :start) retained-origin))
(end (- (plist-get mount :end) retained-origin)))
(push (list :old-start start :old-end end
:new-start start :new-end end)
intervals))))
owner-set)
(dolist (range previous-owned-ranges)
(when (gethash (plist-get range :object) owner-set)
(when-let* ((new-start
(ebox-surface--rebase-coordinate
(plist-get range :start) coordinate-patches))
(new-end
(ebox-surface--rebase-coordinate
(plist-get range :end) coordinate-patches)))
(push (list :old-start (plist-get range :start)
:old-end (plist-get range :end)
:new-start (car new-start)
:new-end (car new-end))
intervals)))))
(setq intervals
(sort intervals
(lambda (left right)
(< (plist-get left :old-start)
(plist-get right :old-start)))))
(let (coalesced)
(dolist (interval intervals)
(let ((previous (car coalesced)))
(if (and previous
(<= (plist-get interval :old-start)
(plist-get previous :old-end))
(<= (plist-get interval :new-start)
(plist-get previous :new-end)))
(progn
(plist-put previous :old-end
(max (plist-get previous :old-end)
(plist-get interval :old-end)))
(plist-put previous :new-end
(max (plist-get previous :new-end)
(plist-get interval :new-end))))
(push (copy-sequence interval) coalesced))))
(setq intervals (nreverse coalesced)))
(when intervals
(let* ((patches
(mapcar
(lambda (interval)
(append
interval
(list :replacement
(substring rendered
(plist-get interval :new-start)
(plist-get interval :new-end)))))
intervals))
(delta
(cl-loop for patch in intervals
sum (- (- (plist-get patch :new-end)
(plist-get patch :new-start))
(- (plist-get patch :old-end)
(plist-get patch :old-start)))))
(derived-base-extent (- target-extent delta))
(base-revision (plist-get state :runtime-revision))
(batch
(and (= source-extent derived-base-extent)
;; TP's constructor is the canonical coordinate validator.
;; A composed local proof may still expose overlapping
;; owner intervals after all geometry owners are united;
;; that is a fast-path proof miss, so preserve the normal
;; Surface plan instead of surfacing an internal batch
;; construction error to the application.
(condition-case nil
(tp-commit-batch-create
:base-revision base-revision
:target-revision (1+ base-revision)
:base-extent source-extent
:target-extent target-extent
:patches patches
:coordinate-patches intervals)
(tp-surface-error nil)))))
(when (and batch property-contributions)
(setq batch
(when-let* ((layered
(ebox-surface--patch-property-contributions
patches property-contributions target-extent)))
;; The bare batch above proves geometry. Composition
;; runs outside its proof-miss catch: a merger can signal
;; any condition, including `tp-surface-error', and must
;; preserve ordinary transaction failure and rollback.
(tp-commit-batch-create
:base-revision base-revision
:target-revision (1+ base-revision)
:base-extent source-extent :target-extent target-extent
:patches layered :coordinate-patches intervals))))
(when batch
(cl-remf state :content-base-extent)
batch))))))
(defun ebox-surface--span-coordinate-result
(context projection state rendered previous-owned-ranges
&optional property-contributions retained-owned-ranges)
"Return a direct span commit from retained coordinate metadata, or nil.
CONTEXT and PROJECTION supply retained object identities. STATE and RENDERED
hold the candidate coordinates and text; PREVIOUS-OWNED-RANGES is the committed
ownership snapshot. PROPERTY-CONTRIBUTIONS are ordered candidate paint layers.
RETAINED-OWNED-RANGES witnesses unchanged ownership when it is that snapshot."
(let* ((patches (plist-get state :content-coordinate-patches))
(surface-root (plist-get projection :surface-root))
(retained-origin
(when (and surface-root patches retained-owned-ranges
(eq retained-owned-ranges previous-owned-ranges)
(equal (plist-get state :content-base-extent)
(length rendered))
(cl-every
(lambda (patch)
(and (= (plist-get patch :old-start)
(plist-get patch :new-start))
(= (plist-get patch :old-end)
(plist-get patch :new-end))))
patches))
(let ((mounts (tp-object-mounts surface-root)))
(when (and (= (length mounts) 1)
(= (- (plist-get (car mounts) :end)
(plist-get (car mounts) :start))
(length rendered)))
(plist-get (car mounts) :start))))))
(when-let* ((fragments
(and surface-root patches
(or (plist-get state :mixed-owner-fragment-data)
(plist-get state :span-patch-fragment-data))))
(rebased
(if retained-origin
(cons t previous-owned-ranges)
(and (null property-contributions) previous-owned-ranges
(ebox-surface--rebase-owned-ranges
previous-owned-ranges patches (length rendered)))))
(batch
(ebox-surface--coordinate-batch
state rendered previous-owned-ranges
property-contributions retained-origin))
(fragment-root
(tp-object-ensure context surface-root
ebox-surface--fragments-key 'ebox/fragments))
(text-leaf
(tp-object-ensure context fragment-root
ebox-surface--text-key 'ebox/text)))
(let* ((owned-ranges (cdr rebased))
(rendered-length (length rendered))
(mount-records
(unless retained-origin
(list (list :object text-leaf :start 0 :end rendered-length
:props nil :tags nil :leaf t)
(list :object fragment-root :start 0 :end rendered-length
:props nil :tags nil :leaf nil)
(list :object surface-root :start 0 :end rendered-length
:props nil :tags nil :leaf nil))))
(result
(if retained-origin
(tp-commit-batch-result-create
context batch :client-state state :reuse-mount-projection t)
(tp-commit-batch-result-create
context batch
:mount-specs
(ebox-surface--commit-mount-specs mount-records owned-ranges)
:client-state state))))
(when result
(plist-put state :surface-owned-ranges
(if retained-origin
owned-ranges
(ebox-surface--snapshot-owned-ranges owned-ranges)))
(plist-put state :surface-fragments fragments)
(cl-remf state :previous-surface-owned-ranges)
(cl-remf state :mixed-owner-fragment-data)
(cl-remf state :mixed-owner-content-p)
(cl-remf state :span-patch-fragment-data)
(cl-remf state :span-patch-content-p)
result)))))
(defun ebox-surface--mounted-object-for-node (state node-id)
"Return NODE-ID's nearest live retained object with mounts in STATE."
(let ((objects (plist-get state :surface-node-object-table))
(parents (plist-get state :parent-table))
object)
(while (and node-id
(progn
(setq object (and objects (gethash node-id objects)))
(or (not object) (not (tp-object-mounted-p object)))))
(setq node-id (and parents (ebox-runtime-index-get node-id parents))))
(unless (and object (tp-object-live-p object)
(tp-object-mounted-p object))
(error "Ebox scoped owner has no mounted TP object"))
object))
(defun ebox-surface--objects-for-node-ids (state node-ids)
"Return mounted retained objects in STATE for Ebox NODE-IDS."
(delete-dups
(mapcar (lambda (node-id)
(ebox-surface--mounted-object-for-node state node-id))
node-ids)))
(defun ebox-surface-update-buffer-scoped
(buffer source scope-node-ids report-base state-overrides
&optional after-publication on-mismatch scroll-prefetch-delay
projection-kind source-isolated-p framework-participant)
"Publish BUFFER SOURCE within SCOPE-NODE-IDS through TP.
STATE-OVERRIDES augments the isolated candidate runtime. REPORT-BASE and
AFTER-PUBLICATION have the same meaning as in `ebox-surface-mount-buffer'.
ON-MISMATCH is forwarded to TP's scoped publication policy.
SCROLL-PREFETCH-DELAY controls post-publication lazy scroll warming.
PROJECTION-KIND may request a proven non-spatial candidate projection.
SOURCE-ISOLATED-P means SOURCE is an internally copied runtime candidate and
may be adopted without another structural copy or identity reconciliation.
When SOURCE-PATH-COPIED-P is non-nil, SOURCE shares untouched published nodes;
the surface must preserve those shared nodes while consuming the candidate.
FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil."
;; Ebox owns the complete mounted TP surface. Caller narrowing is an editor
;; view and must neither constrain candidate coordinates nor become an
;; accidental publication scope. Isolate it while every full-buffer fact
;; and TP operation runs against the complete target.
(with-current-buffer buffer
(save-restriction
(widen)
(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"))
(let ((objects
(condition-case nil
(ebox-surface--objects-for-node-ids old-state scope-node-ids)
(error nil))))
(if (null objects)
(ebox-surface-mount-buffer
buffer source
(append report-base
'(:tp-scope-fallback t :empty-range-owner-fallback t))
after-publication t state-overrides
framework-participant)
(let* ((context-values
(ebox-surface--context-values
buffer old-state state-overrides))
(signals-result
(ebox-surface--ensure-signals buffer context-values))
(signals (car signals-result))
(signals-created-p (cdr signals-result))
(producer
(ebox-surface-producer
source old-state t state-overrides signals projection-kind
source-isolated-p
(plist-get state-overrides :source-path-copied-p)))
success native-settled-p)
(when (and (null on-mismatch)
(or (plist-get state-overrides :owner-scoped-proofs)
(plist-get report-base :layer-recompose-p)
(plist-get state-overrides
:scroll-state-transaction)
(> (length scope-node-ids) 1)))
(setq on-mismatch 'root))
(unwind-protect
(progn
(let ((ebox-surface--font-window
(plist-get context-values :display-window)))
(tp-with-transaction
(ebox-surface--stage-signal-values
signals context-values)
(tp-surface-update-scoped
surface objects producer
(list :on-mismatch on-mismatch :return-report nil))
(ebox-surface--publish-runtime-state
buffer surface old-state report-base after-publication
framework-participant observation-context)))
(setq success t)
(let* ((scroll-keys
(if framework-participant
(ebox-surface--framework-participant-scroll-keys
framework-participant)
(let ((new-state
(tp-surface-client-state surface)))
(delete-dups
(append
(copy-sequence
(plist-get old-state :scroll-region-ids))
(copy-sequence
(plist-get new-state
:scroll-region-ids)))))))
(scroll-diagnostics
(ebox-incremental--finalize-declarative-scroll-publication
scroll-keys scroll-prefetch-delay))
(native-diagnostics
(ebox-surface--settle-native-session
old-state state-overrides surface t)))
(setq native-settled-p t)
(ebox-surface--record-native-retirement-diagnostics
surface framework-participant native-diagnostics)
(ebox-surface--participant-complete-postaccept
framework-participant scroll-diagnostics))
surface)
(unless native-settled-p
(ebox-surface--settle-native-session
old-state state-overrides surface success))
(when (and signals-created-p (not success))
(ebox-surface--dispose-signals signals))))))))))
(defun ebox-surface--clear-runtime-attachments (root)
"Clear TP handles and render-cache attachments below ROOT."
(cl-labels
((visit (node)
(when (and (listp node) (not (stringp node)))
(when (plist-member node :surface-object)
(plist-put node :surface-object nil))
(when (plist-member node :render-cache)
(plist-put node :render-cache nil))
(ebox-tree-for-each-direct-child node #'visit))))
(visit root))
root)
(defun ebox-surface--candidate-root
(source preserve-identities-p &optional validated-p)
"Return an isolated runtime copy of SOURCE.
When PRESERVE-IDENTITIES-P is non-nil, retain existing Ebox node and region
identities while always discarding TP handles and render-cache attachments.
VALIDATED-P means the caller owns a current topology certificate for SOURCE."
(unless (and (listp source) (not (stringp source)))
(error "Ebox surface source must be an Ebox node"))
(ignore validated-p)
(let ((candidate (ebox-tree-copy-node-structure source)))
(if preserve-identities-p
(ebox-surface--clear-runtime-attachments candidate)
(ebox-tree-clear-runtime-identities candidate))
candidate))
(defun ebox-surface--isolated-viewport-overrides (overrides)
"Isolate persistent viewport caches in OVERRIDES for a reflow candidate.
Keep writes to retained output and layout fragments out of the published
generation. Node memos follow the source-copy policy in the projector."
(let ((copy (copy-sequence overrides)))
(dolist (key '(:render-cache :layout-fragments))
(when (plist-member copy key)
(let ((value (plist-get copy key)))
(when (hash-table-p value)
(setq copy (plist-put copy key (copy-hash-table value)))))))
copy))
(defun ebox-surface--reconcile-candidate
(root source-index previous-state)
"Reconcile ROOT identities using SOURCE-INDEX and PREVIOUS-STATE."
(when-let* ((previous-root (plist-get previous-state :root-node)))
(ebox-tree-reconcile-runtime
previous-root (plist-get previous-state :source-index)
root source-index))
root)
(defun ebox-surface--source-region-id-set (source)
"Return region ids already present in Ebox SOURCE without mutating it."
(let ((ids (make-hash-table :test 'equal)))
(cl-labels
((visit (node)
(when (and (listp node) (not (stringp node)))
(when-let* ((region-id (plist-get node :region-id)))
(puthash region-id t ids))
(dolist (child (ebox-tree--children-raw node))
(visit child)))))
(visit source))
ids))
(defun ebox-surface--source-identities-available-p (source buffer)
"Return non-nil when SOURCE's migration ids are available for BUFFER."
(or (stringp source)
(not (ebox--runtime-region-id-conflict
(ebox-surface--source-region-id-set source) buffer))))
(defun ebox-surface--node-key (source-index node &optional positional-p)
"Return NODE's SOURCE-INDEX sibling key, or nil when positional."
(when-let* ((key (and (not positional-p)
(not (plist-get node :ebox-sequence-location))
(ebox-tree-node-author-key source-index node))))
(list 'ebox/key key)))
(defun ebox-surface--node-kind (node)
"Return the TP kind discriminator for Ebox NODE."
(list 'ebox/node (plist-get node :ebox-type)))
(defun ebox-surface--node-style-binding
(source-index object node subject bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p)
"Install and return NODE style binding on OBJECT for SUBJECT."
(let* ((parent (ecss-subject-parent subject))
(parent-binding (and parent (gethash parent bindings-by-subject)))
(parent-style-state (and parent (gethash parent states-by-subject)))
(declarations
(ebox-tree-node-source-declarations source-index node))
(old-state (gethash object style-state-table))
(old-binding (and old-state (plist-get old-state :binding)))
(selector-context-stable-p
(and old-state
(or (eq selector-tree-token
(plist-get old-state :selector-tree-token))
(and stylesheet-subject-local-p
(ebox-surface--subject-local-equal-p
subject (plist-get old-state :subject))))))
(old-parent-style
(and old-state
(plist-get old-state :parent-binding)
(tp-binding-last-value
(plist-get old-state :parent-binding))))
(new-parent-style
(and parent-binding (tp-binding-last-value parent-binding)))
(theme-explicit-delta-style
(and old-state old-binding
selector-context-stable-p
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))
(ebox-style--theme-delta-computed
(tp-binding-last-value old-binding)
(plist-get old-state :declarations)
declarations
old-parent-style
new-parent-style)))
(theme-parent-delta-style
(and old-state old-binding
(equal (plist-get old-state :declarations)
declarations)
selector-context-stable-p
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))
(ebox-style--theme-parent-delta-computed
(tp-binding-last-value old-binding)
declarations old-parent-style new-parent-style)))
(theme-delta-style
(or theme-explicit-delta-style theme-parent-delta-style))
(theme-parent-delta-p
(and (null theme-explicit-delta-style)
theme-parent-delta-style))
(reused-p
(and old-state
(not (plist-get node :ebox-candidate-computed-style-p))
(null theme-delta-style)
selector-context-stable-p
(equal declarations (plist-get old-state :declarations))
(eq parent-binding (plist-get old-state :parent-binding))
(= (if parent-binding 1 0)
(or (plist-get old-state
:inherited-dependency-count)
-1))
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))))
(state
(if reused-p
(let ((reused-state (copy-sequence old-state)))
(plist-put reused-state :selector-tree-token
selector-tree-token)
(plist-put reused-state :subject subject)
(plist-put reused-state :node node)
(plist-put reused-state :parent-style-state
parent-style-state)
reused-state)
(let ((new-state
(list :selector-tree-token selector-tree-token
:declarations (copy-tree declarations)
:parent-binding parent-binding
:parent-style-state parent-style-state
:inherited-dependency-count
(if theme-parent-delta-p
1
(if theme-explicit-delta-style
0
(if parent-binding 1 0)))
:stylesheet-signature stylesheet-signature
:subject subject
:node node)))
(plist-put
new-state :compute
(let ((captured new-state)
(delta-style theme-delta-style)
(parent-delta-p theme-parent-delta-p)
(last-style (and old-binding
(tp-binding-last-value old-binding)))
(last-parent-style old-parent-style))
(if parent-delta-p
(lambda ()
(let ((parent-style
(and (plist-get captured :parent-binding)
(tp-binding-read
(plist-get captured :parent-binding)))))
(setq last-style
(or
(ebox-style--theme-parent-delta-computed
last-style
(plist-get captured :declarations)
last-parent-style parent-style)
(ebox-surface--compute-node-style
(plist-get captured :subject)
(plist-get captured :declarations)
parent-style)))
(setq last-parent-style parent-style)
last-style))
(lambda ()
(or delta-style
(ebox-surface--compute-node-style
(plist-get captured :subject)
(plist-get captured :declarations)
(and (plist-get captured :parent-binding)
(tp-binding-read
(plist-get captured :parent-binding)))))))))
new-state)))
(precomputed-style
(and (not reused-p)
(or (and (null old-state)
(plist-get node :ebox-candidate-computed-style-p)
(plist-get node :ebox-computed-style))
(and (null old-state)
(hash-table-p ebox-surface--inline-style-value-cache)
(ebox-surface--compute-node-style
subject declarations new-parent-style)))))
(binding
(if precomputed-style
(tp-bind-precomputed
object 'ebox/computed-style (plist-get state :compute)
precomputed-style (and parent-binding (list parent-binding)))
(tp-bind
object 'ebox/computed-style
(plist-get state :compute)))))
(unless reused-p
(plist-put state :binding binding))
(puthash object state style-state-table)
(puthash subject binding bindings-by-subject)
(puthash subject state states-by-subject)
(when (plist-get node :ebox-candidate-computed-style-p)
(cl-remf node :ebox-candidate-computed-style-p))
binding))
(defun ebox-surface--compute-node-style (subject declarations parent-style)
"Compute one node style, reusing selector-free immutable results."
(if (not (hash-table-p ebox-surface--inline-style-value-cache))
(ebox-style-compute-subject subject declarations parent-style)
(let* ((key (list (ecss-subject-type subject)
(ecss-subject-id subject)
(ecss-subject-classes subject)
(ecss-subject-attributes subject)
(ecss-subject-states subject)
declarations
(ebox-style--inherited-style-signature parent-style)))
(missing (make-symbol "ebox-inline-style-cache-missing"))
(cached (gethash key ebox-surface--inline-style-value-cache
missing)))
(if (not (eq cached missing))
cached
(let ((style
(ebox-style-compute-subject
subject declarations parent-style)))
(puthash key style ebox-surface--inline-style-value-cache)
style)))))
(defun ebox-surface--project-font
(node style &optional parent-font-fact snapshot)
"Install NODE's font fact from STYLE, capability, and PARENT-FONT-FACT."
(let ((snapshot (or snapshot (ebox-style--computed-snapshot style t))))
(plist-put
node :ebox-font-fact
(ebox-font-project-values
(car snapshot) (nth 2 snapshot)
(ebox--current-display-signature)
(or ebox-surface--font-window
(ebox-surface--buffer-display-window (current-buffer)))
parent-font-fact)))
node)
(defun ebox-surface--refresh-font-projections (root)
"Re-resolve retained computed font facts below candidate ROOT.
This is a host-capability projection only: it reuses each immutable computed
style and never re-runs selector matching or cascade."
(cl-labels
((visit (node parent-font-fact)
(when (and (listp node) (not (stringp node)))
(when-let* ((style (plist-get node :ebox-computed-style))
((ecss-computed-style-p style)))
(ebox-surface--project-font
node style parent-font-fact
(ebox-style--computed-snapshot style t)))
(let ((fact (plist-get node :ebox-font-fact)))
(ebox-tree-for-each-direct-child
node (lambda (child) (visit child fact)))))))
(visit root nil))
root)
(defun ebox-surface--closed-canonical-node-p (source-index node)
"Return non-nil when NODE in SOURCE-INDEX needs closed inheritance."
(let ((declarations
(ebox-tree-node-source-declarations source-index node)))
(and (eq (plist-get node :ebox-type) 'box)
(memq (plist-get node :ebox-kind) '(box text))
(not (ebox-style-cascade-active-p))
(ebox-style--closed-declarations-p declarations)
(cl-loop for (property _value) on declarations by #'cddr
never (ebox-style--custom-property-p property)))))
(defun ebox-surface-prepare-inline-candidate-styles
(old-state candidate-index node-ids)
"Prepare selector-free computed styles for candidate NODE-IDS.
OLD-STATE supplies published immutable computed styles. CANDIDATE-INDEX owns
the unpublished node and parent tables. Unchanged declaration/subject chains
reuse their exact prior style; changed nodes compute once against the prepared
candidate parent style. Stylesheet rules deliberately disable this local
path because selector scope may extend outside NODE-IDS. Return the prepared
source-handle-to-subject table when the requested local preparation completed."
(let ((stylesheet-signature (ebox-surface--stylesheet-signature)))
(when (and node-ids
(ebox-surface--stylesheet-subject-local-p
stylesheet-signature))
(let ((old-nodes (plist-get old-state :node-table))
(new-nodes (plist-get candidate-index :node-table))
(parents (plist-get candidate-index :parent-table))
(old-source-index (plist-get old-state :source-index))
(new-source-index (plist-get candidate-index :source-index))
(resolved (make-hash-table :test 'equal))
(visiting (make-hash-table :test 'equal))
(subjects-by-id (make-hash-table :test 'equal))
(subjects-by-handle (make-hash-table :test 'eq))
(ebox-surface--inline-style-value-cache
(make-hash-table :test 'equal)))
(cl-labels
((resolve
(node-id)
(let ((missing (make-symbol "ebox-style-unresolved")))
(let ((cached (gethash node-id resolved missing)))
(if (not (eq cached missing))
cached
(when (gethash node-id visiting)
(error "Ebox candidate style parent cycle at %S" node-id))
(puthash node-id t visiting)
(let* ((node (ebox-runtime-index-get node-id new-nodes))
(old-node (ebox-runtime-index-get node-id old-nodes))
(parent-id (ebox-runtime-index-get node-id parents))
(parent-style (and parent-id (resolve parent-id)))
(parent-subject
(and parent-id (gethash parent-id subjects-by-id)))
(old-parent-id
(and old-node
(ebox-runtime-index-get node-id
(plist-get old-state :parent-table))))
(old-parent
(and old-parent-id
(ebox-runtime-index-get old-parent-id old-nodes)))
(old-parent-style
(and old-parent
(plist-get old-parent :ebox-computed-style)))
(old-style
(and old-node
(plist-get old-node :ebox-computed-style)))
(declarations
(and node
(ebox-tree-node-source-declarations
new-source-index node)))
(old-declarations
(and old-node
(ebox-tree-node-source-declarations
old-source-index old-node)))
(subject
(and node
(or (gethash node-id subjects-by-id)
(let ((created
(ebox-tree-node-subject
new-source-index node)))
(setf (ecss-subject-parent created)
parent-subject)
(puthash node-id created subjects-by-id)
(puthash
(ebox-tree-node-source-handle node)
created subjects-by-handle)
created))))
(old-subject
(and old-node
(or
(when-let* ((object
(plist-get old-node
:surface-object))
(state
(gethash
object
(plist-get
old-state
:style-binding-states))))
(plist-get state :subject))
(ebox-tree-node-subject
old-source-index old-node))))
(source-stable-p
(and old-node
(equal parent-id old-parent-id)
(eq parent-style old-parent-style)
(ebox-style-declarations-equal-p
declarations old-declarations)
(ebox-surface--subject-local-equal-p
subject old-subject)))
(style
(or (and source-stable-p old-style)
(and node (not source-stable-p)
(or parent-style
declarations)
(ebox-surface--compute-node-style
subject declarations
parent-style)))))
(when (and node style (not (eq node old-node)))
(let ((snapshot
(ebox-style--computed-snapshot style t)))
(ebox-surface--project-font
node style
(and parent-id
(plist-get (ebox-runtime-index-get parent-id new-nodes)
:ebox-font-fact))
snapshot)
(cond
((and source-stable-p
(ebox-style--computed-projection-transferable-p
old-node node style))
(ebox-style--transfer-computed-projection
old-node node style))
((and (null (plist-get node :ebox-computed-style))
(ebox-surface--closed-canonical-node-p
new-source-index node))
(ebox-style-apply-closed-inheritance
node style snapshot))
(t
(ebox-style-apply-computed node style snapshot))))
(plist-put node :ebox-computed-style style)
(plist-put node :ebox-candidate-computed-style-p t))
(remhash node-id visiting)
(puthash node-id style resolved)
style))))))
(dolist (node-id node-ids)
(when (ebox-runtime-index-get node-id new-nodes)
(resolve node-id))))
subjects-by-handle))))
(defun ebox-surface--node-style-binding-required-p (source-index node)
"Return non-nil when NODE in SOURCE-INDEX needs its own style binding."
(let ((declarations
(ebox-tree-node-source-declarations source-index node)))
(or (ebox-surface--style-consuming-node-p node)
(cl-some (lambda (property)
(plist-member declarations property))
ebox-surface--inherited-style-properties)
(cl-loop for (property _value) on declarations by #'cddr
thereis (and (symbolp property)
(string-prefix-p "--" (symbol-name property)))))))
(defun ebox-surface--apply-node-style
(source-index object node subject-table bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p)
"Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE."
(when-let* ((subject
(ebox-source--subject-table-get
subject-table (ebox-tree-node-source-handle node))))
(let* ((parent-subject (ecss-subject-parent subject))
(parent-state (and parent-subject
(gethash parent-subject states-by-subject)))
(parent-node (and parent-state (plist-get parent-state :node)))
(parent-font-fact
(and parent-node (plist-get parent-node :ebox-font-fact)))
(precomputed-p
(plist-get node :ebox-candidate-computed-style-p))
(precomputed-style
(and precomputed-p (plist-get node :ebox-computed-style))))
(if (and (hash-table-p ebox-surface--inline-style-value-cache)
(not (ebox-surface--node-style-binding-required-p
source-index node)))
(when-let* ((parent (ecss-subject-parent subject))
(binding (gethash parent bindings-by-subject)))
(puthash subject binding bindings-by-subject)
(when-let* ((state (gethash parent states-by-subject)))
(puthash subject state states-by-subject))
(let ((style (tp-binding-read binding)))
(unless (and precomputed-p (equal style precomputed-style))
(let ((snapshot (ebox-style--computed-snapshot style t)))
(ebox-surface--project-font
node style parent-font-fact snapshot)
(unless (equal style (plist-get node :ebox-computed-style))
(ebox-style-apply-closed-inheritance
node style snapshot)))))
(when precomputed-p
(cl-remf node :ebox-candidate-computed-style-p)))
(let* ((style
(tp-binding-read
(ebox-surface--node-style-binding
source-index object node subject
bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p))))
(unless (and precomputed-p (equal style precomputed-style))
(let ((snapshot (ebox-style--computed-snapshot style t)))
(ebox-surface--project-font node style parent-font-fact snapshot)
(unless (equal style (plist-get node :ebox-computed-style))
(if (and (null (plist-get node :ebox-computed-style))
(ebox-surface--closed-canonical-node-p
source-index node))
(ebox-style-apply-closed-inheritance node style snapshot)
(ebox-style-apply-computed node style snapshot))))))))))
(defun ebox-surface--static-style-state-p (state &optional seen)
"Return non-nil when STATE's inherited binding closure is static.
The style compute may depend on its parent binding exactly once. Any other
dependency is a dynamic TP source and prevents a local cascade proof."
(let* ((binding (and state (plist-get state :binding)))
(parent-binding (and state (plist-get state :parent-binding)))
(parent-state (and state (plist-get state :parent-style-state)))
(inherited-count
(and state (plist-get state :inherited-dependency-count))))
(and (tp-binding-live-p binding)
(not (memq state seen))
(integerp inherited-count)
(= (tp-binding-dependency-count binding)
inherited-count)
(if parent-binding
(and parent-state
(eq parent-binding (plist-get parent-state :binding))
(ebox-surface--static-style-state-p
parent-state (cons state seen)))
(null parent-state)))))
(defun ebox-surface--cascade-local-owner-proof-p
(state candidate-state dirty-set)
"Return non-nil when DIRTY-SET has a static cascade closure in STATE.
CANDIDATE-STATE supplies the declarative nodes before cascade projection.
Missing binding state, changed declarations or selector metadata, dynamic TP
dependencies, or any malformed index conservatively preserves root planning."
(let ((objects (plist-get state :surface-node-object-table))
(style-states (plist-get state :style-binding-states))
(candidate-nodes (plist-get candidate-state :node-table))
(candidate-source-index (plist-get candidate-state :source-index))
(stylesheet-signature
(let* ((cache ebox-incremental--allocated-slot-proof-cache)
(missing (make-symbol "ebox-stylesheet-proof-missing"))
(cached (and cache
(gethash 'stylesheet-signature cache missing))))
(if (and cached (not (eq cached missing)))
cached
(let ((signature (ebox-surface--stylesheet-signature)))
(when cache
(puthash 'stylesheet-signature signature cache))
signature)))))
(and (hash-table-p objects)
(hash-table-p style-states)
(ebox-runtime-index-like-p candidate-nodes)
dirty-set
(cl-every
(lambda (entry)
(if (eq (plist-get entry :dirty-kind) 'paint)
t
(let* ((node-id (plist-get entry :node-id))
(object (and node-id (gethash node-id objects)))
(style-state (and object (gethash object style-states)))
(candidate-node (and node-id
(ebox-runtime-index-get
node-id candidate-nodes)))
(subject (and style-state
(plist-get style-state :subject)))
(candidate-declarations
(and candidate-node
(ebox-tree-node-source-declarations
candidate-source-index candidate-node)))
(locally-computed-p
(and candidate-node
(plist-get candidate-node
:ebox-candidate-computed-style-p)
(ecss-computed-style-p
(plist-get candidate-node :ebox-computed-style))
(ebox-style--closed-declarations-p
candidate-declarations)))
(selector-stable-p
(and candidate-node subject
(equal (ebox-tree-node-id
candidate-source-index candidate-node)
(ecss-subject-id subject))
(equal (ebox-tree-node-classes
candidate-source-index candidate-node)
(ecss-subject-classes subject))
(equal (ebox-tree-metadata-string
(ebox-tree-node-selector-type candidate-node))
(ecss-subject-type subject))
(equal
(mapcar
(lambda (attribute)
(cons (substring (symbol-name (car attribute)) 1)
(cdr attribute)))
(ebox-tree-node-attributes
candidate-source-index candidate-node))
(ecss-subject-attributes subject))
(equal (ebox-tree-node-state
candidate-source-index candidate-node)
(ecss-subject-states subject)))))
(and style-state candidate-node subject
(or selector-stable-p
(and locally-computed-p
(null (car stylesheet-signature))))
(or locally-computed-p
(and
(or (ebox-style-declarations-equal-p
candidate-declarations
(plist-get style-state :declarations))
(ebox-style--paint-declarations-equivalent-p
(plist-get style-state :declarations)
candidate-declarations))
selector-stable-p))
(equal stylesheet-signature
(plist-get style-state :stylesheet-signature))
(ebox-surface--static-style-state-p style-state)))))
dirty-set))))
(defun ebox-surface--ensure-node-tree
(context parent node source-index table subject-table bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token stylesheet-subject-local-p
&optional parent-kind positional-p)
"Ensure styled NODE descendants below PARENT in CONTEXT and fill TABLE."
(ebox--ensure-node-id node)
(let ((object
(tp-object-ensure context parent
(ebox-surface--node-key
source-index node positional-p)
(ebox-surface--node-kind node))))
(tp-object-retain context object)
(plist-put node :surface-object object)
(puthash node object table)
(when subject-table
(ebox-surface--apply-node-style
source-index object node subject-table
bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p))
(let ((child-kind (ebox-tree--child-layout-kind node parent-kind)))
(ebox-tree-for-each-direct-child
node
(lambda (child)
(ebox-surface--ensure-node-tree
context object child source-index table subject-table
bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token stylesheet-subject-local-p
child-kind (and (plist-get node :ebox-child-sequence) t)))))
(when subject-table
(ebox-tree--validate-node-parent-participation
node parent-kind 'computed))
object))
(defun ebox-surface--node-object-table (objects-by-node)
"Return a node-id keyed table from OBJECTS-BY-NODE."
(let ((table (make-hash-table :test 'equal)))
(maphash
(lambda (node object)
(let ((node-id (if (listp node)
(plist-get node :node-id)
node)))
(unless node-id
(error "Ebox rendered node has no runtime identity"))
(puthash node-id object table)))
objects-by-node)
table))
(defun ebox-surface--region-object-table (state node-objects)
"Return region-to-object table from candidate STATE and NODE-OBJECTS."
(let ((table (make-hash-table :test 'equal)))
(ebox-runtime-index-map
(lambda (region-id node-id)
(let ((object (gethash node-id node-objects)))
(unless object
(error "Ebox region %S has no candidate surface object" region-id))
(puthash region-id object table)))
(plist-get state :region-node-table))
table))
(defun ebox-surface--object-region-table (region-objects)
"Return an object-to-region table from REGION-OBJECTS."
(let ((table (make-hash-table :test 'eq)))
(maphash (lambda (region-id object)
(puthash object region-id table))
region-objects)
table))
(defun ebox-surface--node-editable-region-id (node)
"Return NODE's editable Ebox region id, or nil."
(pcase (and (listp node) (plist-get node :ebox-type))
('box (plist-get node :region-id))
((or 'flex 'grid)
(plist-get (plist-get node :box) :region-id))
(_ nil)))
(defun ebox-surface--logical-id-region-table (state region-objects)
"Return root-scoped logical-id entries for STATE and REGION-OBJECTS."
(let ((table (make-hash-table :test 'equal)))
(maphash
(lambda (logical-id entries)
(dolist (entry entries)
(when-let* ((region-id
(ebox-surface--node-editable-region-id (car entry)))
(object (gethash region-id region-objects)))
(push (cons object region-id) (gethash logical-id table)))))
(plist-get state :selector-id-table))
(maphash (lambda (logical-id matches)
(puthash logical-id (nreverse matches) table))
table)
table))
(defun ebox-surface--hash-keys (table)
"Return TABLE keys in unspecified order."
(let (keys)
(maphash (lambda (key _value) (push key keys)) table)
keys))
(defun ebox-surface--retained-scroll-lookahead (state)
"Return lookahead needed to retain STATE's prepared lazy prefixes."
(when-let* ((table (plist-get state :scroll-state-table)))
(let ((maximum 0))
(maphash
(lambda (_region-id scroll-state)
(let ((retained (length (plist-get scroll-state :content-lines)))
(offset (or (plist-get scroll-state :scroll-offset) 0))
(height (or (plist-get scroll-state :content-height) 0)))
(setq maximum
(max maximum (- retained offset height 1)))))
table)
(max 0 maximum))))
(defun ebox-surface--scroll-metadata-snapshot (table producer-region-ids)
"Return reusable lazy-scroll metadata copied from TABLE.
PRODUCER-REGION-IDS names scroll-only updates whose producer closures remain
valid because their declarative layout and viewport did not change."
(let ((snapshot (make-hash-table :test 'equal)))
(maphash
(lambda (region-id state)
(let ((preserve-producer-p
(member region-id producer-region-ids))
(producer-keys
'(:content-lines :rendered-content-lines
:content-lines-complete-p :render-content-prefix
:materialize-content-lines :region-line-bounds-index
:region-line-span-index :region-line-span-index-deferred
:rendered-region-line-span-index
:rendered-region-line-span-index-deferred
:region-line-span-hints :cache-miss-prefetch-target-lines
:native-reflow-target-prefix-p
:native-reflow-prefix-reset-p :native-reflow-visible-offset
:native-reflow-visible-lines))
metadata)
(dolist (key (append
'(:content-region-id-set :lazy-scroll-prefix-dirty
:lazy-scroll-window-refresh-required)
(and preserve-producer-p producer-keys)))
(when (if (memq key producer-keys)
(plist-member state key)
(plist-get state key))
(setq metadata
(plist-put metadata key (plist-get state key)))))
(when metadata
(puthash region-id metadata snapshot))))
table)
snapshot))
(defun ebox-surface--restore-scroll-metadata (table snapshot)
"Restore reusable lazy-scroll SNAPSHOT fields into TABLE."
(maphash
(lambda (region-id metadata)
(when-let* ((state (gethash region-id table)))
(while metadata
(setq state
(plist-put state (pop metadata) (pop metadata))))
(puthash region-id state table)))
snapshot))
(defun ebox-surface--refresh-rendered-layout-snapshots (state)
"Refresh stale base snapshots after rendering STATE's complete root.
Keep unchanged entries and their details. Old published geometry remains
available during planning; replacements here belong only to the candidate."
(let ((snapshots (plist-get state :layout-snapshots))
(nodes (plist-get state :node-table))
(ebox--node-region-ids-cache (make-hash-table :test 'eq))
updated)
(when (hash-table-p snapshots)
(maphash
(lambda (node-id snapshot)
(let* ((node (ebox-runtime-index-get node-id nodes))
(fresh (and node (ebox--node-layout-snapshot nil node nil))))
(unless (and fresh
(cl-every
(lambda (key)
(equal (plist-get snapshot key) (plist-get fresh key)))
'(:node-id :type :display :region-ids
:style-signature :child-ids)))
(unless updated (setq updated (copy-hash-table snapshots)))
(if fresh
(puthash node-id fresh updated)
(remhash node-id updated)))))
snapshots)
(when updated
(plist-put state :layout-snapshots updated))))
state)
(defun ebox-surface--render-candidate (state)
"Render candidate STATE's complete root in isolated side tables."
(let ((rendered
(ebox-surface--render-candidate-node state (plist-get state :root-node))))
;; A complete physical line owns its pixel remainder. Keep the raw render
;; and cached child strings untouched; retained output stores only whether
;; local geometry would require the missing fractional origin next time.
(plist-put state :fractional-pixel-output-p
(ebox--fractional-pixel-spaces-p rendered))
(when (plist-get state :fractional-pixel-output-p)
(let ((ebox--render-owned-text-values
(plist-get state :render-owned-text-values)))
(setq rendered (ebox--quantize-pixel-spaces rendered))
(ebox--record-render-output-provenance rendered)))
;; A retained node id can now describe a different display or subtree.
;; Refresh the complete lightweight snapshot, including ancestor region
;; membership; stripping only span details would preserve stale style facts.
(setq state (ebox-surface--finish-runtime-state state))
(ebox-surface--refresh-rendered-layout-snapshots state)
rendered))
(defun ebox-surface--render-candidate-node (state node)
"Render NODE from candidate STATE in isolated Ebox side tables."
(let ((scroll-table
(or (plist-get state :scroll-state-table)
(make-hash-table :test 'equal)))
(scroll-metadata
(ebox-surface--scroll-metadata-snapshot
(or (plist-get state :scroll-state-table)
(make-hash-table :test 'equal))
(plist-get state :preserve-scroll-producer-region-ids)))
(timer-table (make-hash-table :test 'equal))
(smooth-table (make-hash-table :test 'equal)))
(cl-remf state :preserve-scroll-producer-region-ids)
(cl-remf state :native-render-p)
(cl-remf state :native-render-output)
(cl-remf state :native-render-fragments)
(cl-remf state :native-render-frame)
(cl-remf state :native-render-fragment-template)
(cl-remf state :native-render-fallback)
(let ((ebox-viewport-width (plist-get state :viewport-width))
(ebox-viewport-height (plist-get state :viewport-height))
(ebox--render-display-signature
(plist-get state :display-signature))
(ebox--region-box-table (plist-get state :region-box-table))
(ebox--scroll-global-state scroll-table)
(ebox--scroll-idle-prefetch-timers timer-table)
(ebox--smooth-scroll-state-table smooth-table)
(ebox--render-runtime-revision
(plist-get state :runtime-revision))
(ebox--render-source-index (plist-get state :source-index))
(ebox-incremental--render-portals-p
(if (plist-member state :root-portals-p)
(plist-get state :root-portals-p)
'unknown))
(ebox-layer--active-p
(if (plist-member state :layered-p)
(plist-get state :layered-p)
'unknown))
(ebox--render-cache-table (plist-get state :render-cache))
(ebox--layout-fragments-table
(plist-get state :layout-fragments))
(ebox--layout-fragments-reuse-p
(plist-get state :layout-fragments-reuse-p))
(ebox--render-cache-signature-cache
(plist-get state :render-signature-cache))
(ebox--scroll-window-initial-lookahead-lines-override
(ebox-surface--retained-scroll-lookahead state))
(ebox--viewport-dependent-node-ids-cache
(make-hash-table :test 'eq))
(ebox--viewport-dependent-subtree-cache
(make-hash-table :test 'eq))
(ebox--viewport-height-dependent-subtree-cache
(plist-get state :viewport-height-dependent-subtree-cache))
(ebox--flex-content-min-width-table
(plist-get state :flex-content-min-widths))
(ebox--paint-origin-capture-p t)
(ebox--render-owned-text-values
(make-hash-table :test #'eq)))
(cl-letf (((symbol-function 'ebox--scroll-schedule-idle-prefetch)
(lambda (&rest _) nil)))
(when (and (require 'ebox-native-commit nil t)
(not (ebox-surface--runtime-index-ready-p state)))
(setq state (ebox-surface--finish-runtime-state state)))
(let ((rendered
(or (and (require 'ebox-native-commit nil t)
(ebox-native-commit-render state node))
(let ((ebox--surface-materialization-active t))
(ebox--render-layout node)))))
(ebox-surface--check-local-pixel-output rendered)
(unless (plist-get state :native-render-p)
(ebox--record-render-output-provenance rendered))
(unless (plist-get state :native-render-p)
(ebox-surface--restore-scroll-metadata
scroll-table scroll-metadata))
(plist-put state :scroll-state-table scroll-table)
(plist-put state :scroll-region-ids
(ebox-surface--hash-keys scroll-table))
(plist-put state :render-owned-text-values
ebox--render-owned-text-values)
rendered)))))
(defun ebox-surface--attach-retained-node-objects (state)
"Attach retained TP objects to candidate nodes in STATE."
(let ((nodes (plist-get state :node-table))
(objects (plist-get state :surface-node-object-table)))
(when (and (ebox-runtime-index-like-p nodes) (hash-table-p objects))
(maphash
(lambda (node-id object)
(when-let* ((node (ebox-runtime-index-get node-id nodes)))
(plist-put node :surface-object object)))
objects))
state))
(defun ebox-surface--apply-retained-owner-styles (state)
"Apply retained static computed styles to owner-scoped nodes in STATE."
(let* ((proofs (plist-get state :owner-scoped-proofs))
(owner-ids
(or (mapcar (lambda (proof) (plist-get proof :owner-id)) proofs)
(and (plist-get state :span-patch-owner-id)
(list (plist-get state :span-patch-owner-id)))))
(nodes (plist-get state :node-table))
(objects (plist-get state :surface-node-object-table))
(style-states (plist-get state :style-binding-states)))
(dolist (owner-id owner-ids)
(when-let* ((node (and nodes (ebox-runtime-index-get owner-id nodes)))
(object (and objects (gethash owner-id objects)))
(style-state (and style-states
(gethash object style-states)))
(binding (plist-get style-state :binding)))
(ebox-style-apply-computed node (tp-binding-read binding))))
(when owner-ids
(ebox-tree-validate-indexed-participation
nodes (plist-get state :parent-table) owner-ids 'computed))
state))
(defun ebox-surface--rendered-role-topology-signature
(rendered region-ids)
"Return rendered Ebox role topology for REGION-IDS in RENDERED."
(let ((wanted (make-hash-table :test 'equal))
(roles-table (make-hash-table :test 'eq))
(position 0)
(limit (length rendered)))
(dolist (region-id region-ids)
(puthash region-id t wanted))
(while (< position limit)
(dolist (entry (ebox-surface--role-ids-at rendered position))
(when (gethash (cdr entry) wanted)
(puthash (car entry) t roles-table)))
(setq position
(max (or (next-property-change position rendered limit) limit)
(1+ position))))
(let (roles)
(maphash (lambda (role _value) (push role roles)) roles-table)
(list :roles
(sort roles
(lambda (left right)
(string< (symbol-name left)
(symbol-name right))))))))
(defun ebox-surface--span-patch-lines
(buffer spans rendered &optional variable-content-p
variable-content-max-width owner-set)
"Return RENDERED shaped for BUFFER SPANS, or nil when unsafe.
When VARIABLE-CONTENT-P is non-nil, allow a stable partial slot to retain its
old allocated width while the owner changes its natural content length."
(with-current-buffer buffer
(if (ebox-buffer--partial-line-slots-p spans)
(if variable-content-p
(let ((lines (ebox-string-lines rendered)))
(when (and (= (length spans) (length lines))
(or (null variable-content-max-width)
(cl-every
(lambda (line)
(<= (ebox--string-pixel-width line)
variable-content-max-width))
lines)))
rendered))
(ebox-buffer--rendered-in-existing-slots
spans rendered owner-set t))
(and (= (length spans) (length (ebox-string-lines rendered)))
rendered))))
(defun ebox-surface--projected-span-positions (spans lines)
"Return BUFFER span positions after replacing SPANS with LINES."
(when (= (length spans) (length lines))
(let ((delta 0) result)
(cl-loop for span in spans
for line in lines
do (let* ((start (+ (car span) delta))
(end (+ start (length line))))
(push (cons start end) result)
(setq delta
(+ delta (- (length line)
(- (cdr span) (car span)))))))
(nreverse result))))
(defun ebox-surface--replace-buffer-spans
(source origin spans lines)
"Return SOURCE with buffer SPANS replaced by propertized LINES."
(catch 'invalid
(let ((cursor origin) pieces)
(cl-loop for span in spans
for line in lines
do (let ((start (car span)) (end (cdr span)))
(when (or (< start cursor) (< end start))
(throw 'invalid nil))
(push (substring source (- cursor origin) (- start origin))
pieces)
(push line pieces)
(setq cursor end)))
(push (substring source (- cursor origin)) pieces)
(apply #'concat (nreverse pieces)))))
(defun ebox-surface--span-patch-details
(_buffer snapshot node spans rendered
&optional variable-content-p variable-content-max-width)
"Return validated replacement details for SNAPSHOT and RENDERED."
(let* ((lines (ebox-string-lines rendered))
(new-spans (ebox-surface--projected-span-positions spans lines))
(old-footprint (plist-get snapshot :span-footprint-signature))
(new-footprint
(and new-spans (ebox--rendered-span-footprint-signature rendered)))
(new-external
(and new-footprint
(ebox--external-footprint-signature-from-span-footprint
new-footprint)))
(new-parent
(and new-footprint
(ebox--project-parent-slot-signature
(plist-get snapshot :parent-slot-signature)
new-footprint)))
(new-roles
(and new-spans
(ebox-surface--rendered-role-topology-signature
rendered (plist-get snapshot :region-ids))))
(new-overflow (ebox--overflow-signature node)))
(when (and old-footprint new-footprint
(if variable-content-p
(and (= (plist-get old-footprint :span-count)
(plist-get new-footprint :span-count))
(or (null variable-content-max-width)
(<= (or (plist-get new-external
:max-line-pixel-width)
0)
variable-content-max-width)))
(and (ebox--span-footprint-compatible-p
old-footprint new-footprint)
(ebox--external-footprint-compatible-p
(plist-get snapshot :external-footprint-signature)
new-external)
(ebox--parent-slot-compatible-p
(plist-get snapshot :parent-slot-signature)
new-parent)))
(equal (plist-get snapshot :role-topology-signature)
new-roles)
(equal (plist-get snapshot :overflow-signature)
new-overflow))
(list :lines lines :spans new-spans :footprint new-footprint
:external new-external :parent new-parent :roles new-roles
:overflow new-overflow
:variable-content-p variable-content-p))))
(defun ebox-surface--install-span-patch-snapshot
(state owner-id snapshot details &optional generation-override)
"Install DETAILS for OWNER-ID into candidate STATE snapshots."
(let* ((current-generation
(or (plist-get state :layout-snapshot-detail-generation) 0))
(old-footprint (plist-get snapshot :span-footprint-signature))
(new-footprint (plist-get details :footprint))
(coordinates-stable-p
(equal (plist-get old-footprint :char-lengths)
(plist-get new-footprint :char-lengths)))
(generation (or generation-override
(if coordinates-stable-p
current-generation
(1+ current-generation))))
(updated (copy-sequence snapshot))
(spans (plist-get details :spans))
(footprint new-footprint))
(dolist (entry `((:buffer-span . ,(car spans))
(:buffer-spans . ,spans)
(:line-signature . ,(plist-get footprint
:line-pixel-widths))
(:span-footprint-signature . ,footprint)
(:external-footprint-signature
. ,(plist-get details :external))
(:parent-slot-signature
. ,(if (plist-get details :variable-content-p)
(plist-get snapshot :parent-slot-signature)
(plist-get details :parent)))
(:role-topology-signature . ,(plist-get details :roles))
(:overflow-signature . ,(plist-get details :overflow))
(:detail-generation . ,generation)))
(setq updated (plist-put updated (car entry) (cdr entry))))
(puthash owner-id updated (plist-get state :layout-snapshots))
(plist-put state :layout-snapshot-detail-generation generation)
(plist-put state :layout-snapshots-complete-p nil)
(when-let* ((proof
(cl-find owner-id
(plist-get state :allocation-certificate-proofs)
:key (lambda (candidate)
(plist-get candidate :owner-id))
:test #'equal))
(signature (plist-get proof :ancestor-slot-signature)))
(let ((certificates
(or (plist-get state :retained-allocation-certificates)
(make-hash-table :test 'equal))))
(puthash
owner-id
(list :root-id
(plist-get (plist-get state :root-node) :node-id)
:viewport-width (plist-get state :viewport-width)
:viewport-height (plist-get state :viewport-height)
:display-signature
(copy-tree (plist-get state :display-signature))
:signature (copy-tree signature))
certificates)
(plist-put state :retained-allocation-certificates certificates)))
state))
(defun ebox-surface--allocation-owner-line-signature (lines region-ids)
"Return local content-owner run signatures for propertized LINES."
(let ((local (ebox--region-id-set region-ids)))
(mapcar
(lambda (line)
(let ((position 0) (limit (length line)) previous runs)
(while (< position limit)
(let* ((owners
(copy-sequence
(or (get-text-property position
'ebox-content-owners line)
nil)))
(owner (get-text-property position
'ebox-content-owner line))
(stack (if (and owner (not (member owner owners)))
(append owners (list owner))
owners))
(local-stack
(cl-remove-if-not (lambda (id) (gethash id local)) stack))
(next (or (next-property-change position line limit)
limit)))
(unless (equal local-stack previous)
(push local-stack runs)
(setq previous local-stack))
(setq position (max (1+ position) next))))
(nreverse runs)))
lines)))
(defun ebox-surface--retained-external-owner-suffix
(buffer spans region-ids)
"Return one common retained content-owner suffix outside REGION-IDS."
(let ((local (ebox--region-id-set region-ids)) common seen valid)
(setq valid t)
(with-current-buffer buffer
(dolist (span spans)
(let ((position (car span)) (limit (cdr span)))
(while (and valid (< position limit))
(let* ((owners
(copy-sequence
(or (get-text-property position 'ebox-content-owners)
nil)))
(owner (get-text-property position 'ebox-content-owner))
(stack (if (and owner (not (member owner owners)))
(append owners (list owner)) owners))
(external
(cl-remove-if (lambda (id) (gethash id local)) stack))
(next (or (next-property-change position nil limit)
limit)))
(when stack
(if seen
(unless (equal common external) (setq valid nil))
(setq common external seen t)))
(setq position (max (1+ position) next)))))))
(and valid seen common)))
(defun ebox-surface--owner-needs-ancestor-paint-p (state owner-id)
"Return non-nil if STATE's detached OWNER-ID omits enclosing effects.
Ordinary span publication does not recompose enclosing paint or surface
properties. Its local renderer cannot prove equivalence for such an owner."
(let ((parents (plist-get state :parent-table))
(nodes (plist-get state :node-table))
(node-id owner-id)
needed)
(while (and (not needed) (setq node-id (ebox-runtime-index-get node-id parents)))
(when-let* ((box (ebox-fragment-style-source-node (ebox-runtime-index-get node-id nodes))))
(setq needed
(or (ebox-get box :surface-properties)
(ebox-surface--region-face-contributions box '(bt bb) t)))))
(not (null needed))))
(defun ebox-surface--retained-property-value-equal-p (left right)
"Return non-nil when retaining LEFT instead of RIGHT preserves its value.
Opaque payloads, including callbacks, keymaps and records, must keep identity.
Render-created paint origins compare their captured baselines instead."
(let ((seen (make-hash-table :test #'eq)))
(cl-labels
((same
(old new)
(cond
((eq old new) t)
((and (ebox--paint-origin-p old) (ebox--paint-origin-p new))
(same (ebox--paint-origin-baseline old)
(ebox--paint-origin-baseline new)))
((or (functionp old) (functionp new)
(keymapp old) (keymapp new)) nil)
((memq new (gethash old seen)) t)
((and (consp old) (consp new))
(puthash old (cons new (gethash old seen)) seen)
(and (same (car old) (car new)) (same (cdr old) (cdr new))))
((and (stringp old) (stringp new)
(equal-including-properties old new))
(puthash old (cons new (gethash old seen)) seen)
(let ((position 0) (length (length old)) (equal-p t))
(while (and equal-p (< position length))
(setq equal-p
(same (text-properties-at position old)
(text-properties-at position new))
position
(min (next-property-change position old length)
(next-property-change position new length))))
equal-p))
((and (numberp old) (numberp new)) (equal old new)))))
(same left right))))
(defun ebox-surface--unchanged-enclosing-effects-p
(previous-state state owner-id)
"Return non-nil when OWNER-ID keeps its enclosing effects in both states.
Compare resolved paint and surface properties, preserving opaque identities."
(let ((old-id owner-id) (new-id owner-id) (same-p t))
(while (and same-p old-id new-id)
(setq old-id (ebox-runtime-index-get old-id (plist-get previous-state :parent-table))
new-id (ebox-runtime-index-get new-id (plist-get state :parent-table))
same-p (equal old-id new-id))
(when (and same-p old-id)
(let ((old (ebox-fragment-style-source-node
(ebox-runtime-index-get old-id (plist-get previous-state :node-table))))
(new (ebox-fragment-style-source-node
(ebox-runtime-index-get new-id (plist-get state :node-table)))))
(setq same-p
(and (eq (null old) (null new))
(or (null old)
(and
(eq (ebox-get old :visibility)
(ebox-get new :visibility))
(ebox-surface--retained-property-value-equal-p
(ebox-get old :surface-properties)
(ebox-get new :surface-properties))
(ebox-surface--retained-property-value-equal-p
(ebox-surface--region-face-contributions
old '(bt bb) t)
(ebox-surface--region-face-contributions
new '(bt bb) t)))))))))
same-p))
(defun ebox-surface--owner-slot-render-node
(buffer state owner-id snapshot allocated-width variable-content-p
role-owned-lines-p changed-keys)
"Return STATE's OWNER-ID rendered in its proven slot, or at natural size."
(let* ((node (ebox-runtime-index-get owner-id (plist-get state :node-table)))
(parent-id (ebox-runtime-index-get owner-id (plist-get state :parent-table)))
(parent (and parent-id (ebox-runtime-index-get parent-id (plist-get state :node-table)))))
(cond
((and role-owned-lines-p parent
(eq (ebox-tree-display-inner parent) 'flex))
(when (fboundp 'ebox--flex-item-slot-sized-node)
(let ((ebox-incremental--buffer-render-state-override (cons buffer state)))
(ebox--flex-item-slot-sized-node buffer owner-id snapshot changed-keys))))
((and node (or role-owned-lines-p
(and allocated-width (not variable-content-p))))
;; The ancestor certificate proves a stable allocation, but its
;; capacity can include chrome outside this owner's published spans.
;; Recreate this owner's margin-box extent with the normal box model.
;; Exact content patches also need that extent: an auto-width owner
;; detached from a padded parent must not expand to the root viewport.
(when-let* ((width (plist-get
(plist-get snapshot :external-footprint-signature)
:max-line-pixel-width))
((numberp width)))
(ebox--flex-copy-node-for-size node 'row width nil nil)))
((and node allocated-width variable-content-p)
(plist-put (copy-sequence node) :width allocated-width))
(t node))))
(defun ebox-surface--retained-slot-owner-text
(buffer previous-state spans old-lines new-lines local old-values new-values)
"Transport unchanged published properties across proven slot property runs.
Direct content runs may change length. Only renderer-owned blank fillers may
change their display width. Every other local property and the order of runs
must match, and a resized run cannot hide an external property boundary.
Return nil on a proof miss. The caller still validates the final footprint."
(catch 'slot-property-miss
(unless (= (length spans) (length old-lines) (length new-lines))
(throw 'slot-property-miss nil))
(let ((fragments (ebox-surface--materialized-fragment-ledger previous-state))
(origin (with-current-buffer buffer (point-min)))
result)
(cl-labels
((baseline-for
(start end published-properties)
(while (and fragments (<= (plist-get (car fragments) :end) start))
(setq fragments (cdr fragments)))
(let ((remaining fragments) (position start) seen baseline)
(while (< position end)
(let ((fragment (car remaining)))
(unless (and fragment
(<= (plist-get fragment :start) position)
(< position (plist-get fragment :end)))
(throw 'slot-property-miss nil))
(let ((value
(cond
((plist-get fragment :face-baseline-known-p)
(plist-get fragment :face-baseline))
((null (ebox-surface--face-contributions
previous-state (plist-get fragment :paint-role-ids)))
(plist-get published-properties 'face))
(t (throw 'slot-property-miss nil)))))
(when (and seen
(not (ebox-surface--retained-property-value-equal-p
baseline value)))
(throw 'slot-property-miss nil))
(setq baseline value seen t))
(setq position (min end (plist-get fragment :end))
remaining (cdr remaining))))
baseline))
(pixel-filler-p
(line start end properties values)
(let ((display (plist-get properties 'display)))
(and (= (- end start) 1) (= (aref line start) ?\s)
(null (plist-get properties 'ebox-content))
(cl-some (lambda (id) (gethash id local))
(plist-get properties 'ebox-content-owners))
(ebox--render-owned-text-value-p 'display display values)
(pcase display
(`(space :width (,width)) (and (numberp width) (>= width 0))))))))
(with-current-buffer buffer
(cl-loop
for span in spans for old in old-lines for new in new-lines
do
(let* ((published (buffer-substring (car span) (cdr span)))
(old-length (length old)) (new-length (length new))
(old-position 0) (new-position 0)
(line (substring-no-properties new)))
(unless (equal (substring-no-properties old)
(substring-no-properties published))
(throw 'slot-property-miss nil))
(while (and (< old-position old-length) (< new-position new-length))
(let* ((old-end (next-property-change old-position old old-length))
(new-end (next-property-change new-position new new-length))
(old-props (text-properties-at old-position old))
(new-props (text-properties-at new-position new))
(published-props (text-properties-at old-position published))
(old-display (plist-get old-props 'display))
(new-display (plist-get new-props 'display))
(display-changed-p
(not (ebox-surface--retained-property-value-equal-p
old-display new-display))))
(unless (= old-end (next-property-change old-position published old-end))
(throw 'slot-property-miss nil))
(when display-changed-p
(unless (and (pixel-filler-p old old-position old-end old-props old-values)
(pixel-filler-p new new-position new-end new-props new-values)
(ebox-surface--retained-property-value-equal-p
old-display (plist-get published-props 'display)))
(throw 'slot-property-miss nil))
(setq old-props (copy-sequence old-props)
new-props (copy-sequence new-props))
(cl-remf old-props 'display)
(cl-remf new-props 'display))
(unless (and
(ebox-surface--retained-property-value-equal-p old-props new-props)
(or (equal (substring-no-properties old old-position old-end)
(substring-no-properties new new-position new-end))
(and (null old-display) (null new-display)
(gethash (plist-get old-props 'ebox-content) local)
(not (string-match-p "[\n\r]"
(substring old old-position old-end)))
(not (string-match-p "[\n\r]"
(substring new new-position new-end))))))
(throw 'slot-property-miss nil))
(set-text-properties new-position new-end published-props line)
(when display-changed-p
(put-text-property new-position new-end 'display new-display line))
;; Changed extents rebuild their fragment ledger. Carry the
;; proven caller baseline to that parser instead of reusing
;; old fragment coordinates or peeling a composed face.
(put-text-property
new-position new-end ebox--paint-origin-property
(ebox--paint-origin-create
:baseline (copy-tree
(baseline-for (+ (- (car span) origin) old-position)
(+ (- (car span) origin) old-end)
published-props)))
line)
(setq old-position old-end new-position new-end)))
(unless (and (= old-position old-length) (= new-position new-length))
(throw 'slot-property-miss nil))
(push line result)))))
(mapconcat #'identity (nreverse result) "\n"))))
(defun ebox-surface--retained-owner-text
(buffer previous-state state owner-id spans replacement allocated-width
variable-content-p variable-content-max-width
&optional role-owned-lines-p changed-keys snapshot)
"Return REPLACEMENT text with proven unchanged published properties.
Only direct content characters may change. An isolated old owner render must
match the published text and the new render's complete property topology.
Existing strict geometry validation still applies to the returned string.
Proof mismatches return nil; unexpected rendering errors propagate."
(let* ((old-node (ebox-runtime-index-get owner-id
(plist-get previous-state :node-table)))
(new-node (ebox-runtime-index-get owner-id (plist-get state :node-table)))
(regions (ebox--node-all-region-ids old-node))
(render-node
(ebox-surface--owner-slot-render-node
buffer previous-state owner-id snapshot allocated-width
variable-content-p role-owned-lines-p changed-keys))
(root (and render-node (ebox-surface--candidate-root render-node t)))
(probe
(and root (ebox--render-state-install-index
(ebox--new-buffer-render-state root)
(ebox--runtime-index
root t
(ebox-tree-source-index
root t
(when-let* ((parent-id (ebox-runtime-index-get owner-id (plist-get previous-state
:parent-table)))
(parent (ebox-runtime-index-get parent-id (plist-get previous-state
:node-table))))
(ebox-tree-display-inner parent))
(plist-get previous-state :source-index) t))))))
(when (and probe replacement
(equal regions (ebox--node-all-region-ids new-node))
(cl-every
(lambda (region)
(let* ((old-id (ebox-runtime-index-get region (plist-get previous-state
:region-node-table)))
(new-id (ebox-runtime-index-get region (plist-get state :region-node-table)))
(old (ebox-runtime-index-get old-id (plist-get previous-state :node-table)))
(new (ebox-runtime-index-get new-id (plist-get state :node-table))))
(and (equal old-id new-id)
(if role-owned-lines-p
;; The canonical candidate may replace an
;; anonymous source handle while retaining its
;; runtime slot. This mode rebuilds fragment
;; metadata; verify that slot's full identity
;; topology instead of retaining the old handle.
(and (eq (plist-get old :ebox-type)
(plist-get new :ebox-type))
(equal (ebox-runtime-index-get old-id (plist-get previous-state :parent-table))
(ebox-runtime-index-get new-id (plist-get state :parent-table)))
(equal (ebox-tree-node-author-key
(plist-get previous-state :source-index) old)
(ebox-tree-node-author-key
(plist-get state :source-index) new)))
(ebox-surface--retained-property-value-equal-p
(ebox-tree-node-source-identity old)
(ebox-tree-node-source-identity new))))))
regions)
(cl-every
(lambda (key)
(equal (plist-get previous-state key)
(plist-get state key)))
'(:viewport-width :viewport-height :display-signature)))
(dolist (key '(:viewport-width :viewport-height :display-signature
:runtime-revision))
(setq probe (plist-put probe key (plist-get previous-state key))))
(let* ((ebox--box-content-render-cache (make-hash-table :test #'eq))
(old-rendered (ebox-surface--render-candidate-node probe root))
(old-rendered
(if role-owned-lines-p
(ebox-buffer--rendered-owned-lines old-rendered regions (length spans))
old-rendered))
(old-shaped
(and old-rendered
(ebox-surface--span-patch-lines
buffer spans old-rendered variable-content-p
variable-content-max-width
(and role-owned-lines-p (ebox--region-id-set regions)))))
(old-lines (and old-shaped (ebox-string-lines old-shaped)))
(new-lines (ebox-string-lines replacement))
(local (ebox--region-id-set regions))
(valid (and old-lines
(= (length spans) (length old-lines))
(= (length spans) (length new-lines))))
result)
(if (or role-owned-lines-p
;; Equal geometry need not have equal character counts.
;; The existing run transport proves changed content/filler
;; runs and preserves every external property boundary.
(cl-some (lambda (pair)
(/= (length (car pair)) (length (cdr pair))))
(cl-mapcar #'cons old-lines new-lines)))
(and valid
(ebox-surface--retained-slot-owner-text
buffer previous-state spans old-lines new-lines local
(plist-get probe :render-owned-text-values)
(plist-get state :render-owned-text-values)))
(with-current-buffer buffer
(cl-loop for span in spans
for old in old-lines for new in new-lines
while valid
do
(let* ((published (buffer-substring (car span) (cdr span)))
(length (length old)) (position 0))
(setq valid
(and (= length (length new) (length published))
(equal (substring-no-properties old)
(substring-no-properties published))))
(while (and valid (< position length))
(let ((end (min (next-property-change position old length)
(next-property-change position new length))))
(setq valid
(ebox-surface--retained-property-value-equal-p
(text-properties-at position old)
(text-properties-at position new)))
(while (and valid (< position end))
(unless (= (aref old position) (aref new position))
(setq valid
(and (not (memq (aref old position) '(?\n ?\r)))
(not (memq (aref new position) '(?\n ?\r)))
(not (get-text-property position 'display old))
(gethash (get-text-property position
'ebox-content old)
local))))
(setq position (1+ position)))))
(when valid
(let ((line (substring-no-properties new))
(position 0))
(while (< position length)
(let ((end (next-property-change
position published length)))
(set-text-properties
position end (text-properties-at position published)
line)
(setq position end)))
(push line result))))))
(and valid (mapconcat #'identity (nreverse result) "\n")))))))
(defun ebox-surface--owner-patch-candidate
(buffer state owner-id allocated-width
&optional variable-content-p variable-content-max-width
role-owned-lines-p changed-keys allocation-closure-p
retain-external-owner-suffix-p previous-state)
"Return validated patch details for OWNER-ID, or nil."
(let* (
(old-snapshot
(and owner-id (ebox--ensure-layout-snapshot-details buffer owner-id)))
(spans (and old-snapshot (plist-get old-snapshot :buffer-spans)))
(node (and owner-id (ebox-runtime-index-get owner-id (plist-get state :node-table))))
(render-node
(and owner-id
(ebox-surface--owner-slot-render-node
buffer state owner-id old-snapshot allocated-width
variable-content-p role-owned-lines-p changed-keys)))
(retain-properties-p
(and (memq (plist-get state :projection-kind)
'(span-patch owner-scoped mixed-owner-reflow))
(or (ebox-surface--owner-needs-ancestor-paint-p state owner-id)
;; Ancestors also contribute content ownership when
;; they have no paint. Detached Text/Box output must
;; retain that proven published stack as well.
(and previous-state
(not (or allocation-closure-p
retain-external-owner-suffix-p))
(ebox-runtime-index-get
owner-id (plist-get state :parent-table)))))))
(when (and old-snapshot spans node render-node
;; Detached geometry omits enclosing effects. Mixed paint
;; only recomposes dirty paint owners, so unchanged ancestors
;; must also survive its geometry replacement.
(or (not retain-properties-p)
(and previous-state
(not allocation-closure-p)
(ebox-surface--unchanged-enclosing-effects-p
previous-state state owner-id))))
(let* ((rendered
(prog1
(ebox-surface--render-candidate-node state render-node)
(when (and allocation-closure-p (not (eq render-node node)))
(ebox--flex-recache-source-boxes node))))
(region-ids (plist-get old-snapshot :region-ids))
(old-allocation-signature
(and allocation-closure-p
(with-current-buffer buffer
(ebox-surface--allocation-owner-line-signature
(mapcar (lambda (span)
(buffer-substring (car span) (cdr span)))
spans)
region-ids))))
(new-allocation-signature
(and allocation-closure-p
(ebox-surface--allocation-owner-line-signature
(ebox-string-lines rendered) region-ids)))
(owned-rendered
(if role-owned-lines-p
(ebox-buffer--rendered-owned-lines
rendered region-ids
(length spans))
rendered))
(owned-rendered
(if allocation-closure-p
(and (equal old-allocation-signature
new-allocation-signature)
owned-rendered)
owned-rendered))
(owned-rendered
(if (or allocation-closure-p
retain-external-owner-suffix-p)
(and owned-rendered
(when-let* ((owners
(ebox-surface--retained-external-owner-suffix
buffer spans region-ids)))
;; The retained-property proof compares detached
;; renders, then restores the complete published
;; owner stack together with every other property.
(if retain-properties-p
owned-rendered
(ebox--add-content-owners owned-rendered owners))))
owned-rendered))
(replacement
(and owned-rendered
(ebox-surface--span-patch-lines
buffer spans owned-rendered variable-content-p
variable-content-max-width
(and role-owned-lines-p
(ebox--region-id-set
(plist-get old-snapshot :region-ids))))))
(replacement
(if retain-properties-p
(ebox-surface--retained-owner-text
buffer previous-state state owner-id spans replacement
allocated-width variable-content-p variable-content-max-width
role-owned-lines-p changed-keys old-snapshot)
replacement))
(details
(and replacement
(ebox-surface--span-patch-details
buffer old-snapshot node spans replacement
(and (not retain-properties-p) variable-content-p)
(and (not retain-properties-p) variable-content-max-width)))))
(and details
(list :owner-id owner-id :snapshot old-snapshot
:old-spans spans :details details
:retained-properties-p
(and retain-properties-p (not role-owned-lines-p)
;; Rebuild only changed runs when character extents
;; move. Old metadata offsets are not reusable even
;; though the published properties were transported.
(equal
(plist-get (plist-get old-snapshot
:span-footprint-signature)
:char-lengths)
(plist-get (plist-get details :footprint)
:char-lengths)))))))))
(defun ebox-surface--range-patch-candidate (buffer state proof)
"Return PROOF's exact equal-line Range replacement candidate, or nil."
(let* ((owner-id (plist-get proof :owner-id))
(old-snapshot (plist-get proof :snapshot))
(spans (plist-get old-snapshot :buffer-spans))
(node (ebox-runtime-index-get owner-id (plist-get state :node-table)))
(render-node
(if (and node (numberp (plist-get proof :allocated-width)))
(plist-put (copy-sequence node)
:width (plist-get proof :allocated-width))
node))
(rendered
(and render-node
(ebox-surface--render-candidate-node state render-node)))
(external-owners
(and rendered
(ebox-surface--retained-external-owner-suffix
buffer spans (plist-get old-snapshot :region-ids))))
(rendered
(and external-owners
(ebox--add-content-owners rendered external-owners)))
(replacement
(and rendered
(ebox-buffer--rendered-in-existing-slots
spans rendered nil t)))
(lines (and replacement (ebox-string-lines replacement)))
(new-spans
(and lines (ebox-surface--projected-span-positions spans lines)))
(new-footprint
(and new-spans
(ebox--rendered-span-footprint-signature replacement)))
(new-external
(and new-footprint
(ebox--external-footprint-signature-from-span-footprint
new-footprint)))
(new-parent
(and new-footprint
(ebox--project-parent-slot-signature
(plist-get old-snapshot :parent-slot-signature)
new-footprint)))
(new-region-ids (and node (ebox--node-all-region-ids node)))
(new-roles
(and replacement
(ebox-surface--rendered-role-topology-signature
replacement new-region-ids)))
(new-overflow (and node (ebox--overflow-signature node))))
(when (and owner-id old-snapshot spans node replacement new-spans
new-footprint new-region-ids new-roles
(ebox--span-footprint-compatible-p
(plist-get old-snapshot :span-footprint-signature)
new-footprint)
(ebox--external-footprint-compatible-p
(plist-get old-snapshot :external-footprint-signature)
new-external)
(ebox--parent-slot-compatible-p
(plist-get old-snapshot :parent-slot-signature)
new-parent)
(equal (plist-get old-snapshot :overflow-signature)
new-overflow))
(let ((snapshot (copy-sequence old-snapshot)))
(plist-put snapshot :region-ids new-region-ids)
(plist-put snapshot :role-topology-signature new-roles)
(list :owner-id owner-id :snapshot snapshot :old-spans spans
:range-splice-p t
:details
(list :lines lines :spans new-spans :footprint new-footprint
:external new-external :parent new-parent :roles new-roles
:overflow new-overflow :variable-content-p nil))))))
(defun ebox-surface--layer-patch-candidate (buffer previous-state state proof)
"Return PROOF's composed host replacement with only newly visible roles.
Render candidate STATE against BUFFER and its PREVIOUS-STATE.
Role topology can change inside the host. The Range footprint validator
already allows that change while requiring identical external allocation.
Enclosing effects must be unchanged; retained owner roles restore their paint
contributions without copying the previous children's hidden properties."
(let ((owner-id (plist-get proof :owner-id)))
(when (and (ebox-surface--unchanged-enclosing-effects-p
previous-state state owner-id)
;; Arbitrary ancestor surface properties need a separate
;; provenance proof; retain the existing full-render fallback.
(let ((parent (ebox-runtime-index-get
owner-id (plist-get state :parent-table)))
(valid t))
(while (and valid parent)
(when (ebox-get (ebox-runtime-index-get
parent (plist-get state :node-table))
:surface-properties)
(setq valid nil))
(setq parent (ebox-runtime-index-get
parent (plist-get state :parent-table))))
valid))
;; Paint-only preparation normally reuses visible descendant styles.
;; Occluded descendants have no visible fragments to refresh, so prepare
;; the isolated host's complete style closure before rendering it.
(when-let* ((node (ebox-runtime-index-get
owner-id (plist-get state :node-table))))
(ebox-surface-prepare-inline-candidate-styles
previous-state state (ebox--runtime-node-ids node))
(dolist (node-id (ebox--runtime-node-ids node))
(when-let* ((child (ebox-runtime-index-get
node-id (plist-get state :node-table))))
(remhash child (plist-get state :render-signature-cache)))))
(ebox-surface--range-patch-candidate buffer state proof))))
(defun ebox-surface--scroll-replace-index-lines (index changes)
"Copy INDEX and replace only entries on CHANGES' cached content lines.
Each change is (LINE-NUMBER OLD-LINE NEW-LINE). Line counts are unchanged,
so spans on other lines remain valid even when these strings change length."
(when index
(let ((next (copy-hash-table index)))
(dolist (change changes next)
(let* ((number (nth 0 change))
(old (nth 1 change))
(new (nth 2 change))
(replacement (ebox--scroll-build-region-line-span-index (list new)))
(ids (delete-dups
(append (ebox--scroll-line-region-ids old)
(ebox-surface--hash-keys replacement)))))
(dolist (id ids)
(let* ((retained (cl-remove number (copy-sequence (gethash id next))
:key #'car))
(local (gethash id replacement))
(entries (if local
(cons (cons number (cdar local)) retained)
retained)))
(if entries
(puthash id (sort entries (lambda (a b) (< (car a) (car b)))) next)
(remhash id next)))))))))
(defun ebox-surface--scroll-content-patch-output (buffer previous-state state)
"Validate and stage STATE's scroll content patch and visible projection.
Cached content has no root wrapper chrome and uses its own coordinates. Its
owner replacement therefore receives the normal span validator independently
of the mounted-buffer replacement. Only a fully hidden owner can retain the
visible bytes without that second proof. Every cache mutation is candidate
local; a declined visible proof leaves the committed scroll prefix untouched."
(let* ((proof (plist-get state :scroll-content-proof))
(region (plist-get proof :region-id))
(old-scroll (gethash region (plist-get previous-state :scroll-state-table)))
(next-scroll (gethash region (plist-get state :scroll-state-table)))
(lines (plist-get proof :lines))
(owner-proof (car (plist-get state :owner-scoped-proofs)))
(owner-id (plist-get owner-proof :owner-id))
cached-candidate cached-lines changes output)
(when (and old-scroll next-scroll
(eq lines (plist-get old-scroll :content-lines))
(= (length (plist-get state :owner-scoped-proofs)) 1))
(with-temp-buffer
(insert (ebox-lines-join lines))
(let* ((base (copy-sequence previous-state))
(candidate (copy-sequence state))
(ebox--region-line-index (plist-get proof :line-index))
(ebox--region-line-index-buffer (current-buffer)))
(plist-put base :surface nil)
(plist-put base :layout-snapshots
(copy-hash-table (plist-get proof :snapshots)))
(plist-put candidate :layout-snapshots
(make-hash-table :test 'equal))
(let* ((snapshot (copy-sequence
(gethash owner-id (plist-get base :layout-snapshots))))
(spans (plist-get snapshot :buffer-spans))
(owned (mapcar (lambda (span)
(buffer-substring (car span) (cdr span))) spans))
fragments)
;; This projection is a cache, so it has no TP mounts. Derive
;; its role and paint evidence from the same owned output runs
;; used by ordinary surface publication, in cache coordinates.
(plist-put snapshot :role-topology-signature
(ebox-surface--rendered-role-topology-signature
(ebox-lines-join owned) (plist-get snapshot :region-ids)))
(puthash owner-id snapshot (plist-get base :layout-snapshots))
(cl-mapc
(lambda (span line)
(dolist (fragment (ebox-surface--rendered-fragments line))
(plist-put fragment :start (+ (1- (car span)) (plist-get fragment :start)))
(plist-put fragment :end (+ (1- (car span)) (plist-get fragment :end)))
(push fragment fragments)))
spans owned)
(plist-put base :surface-fragments (nreverse fragments)))
(let ((ebox-incremental--buffer-render-state-override
(cons (current-buffer) base))
(ebox-incremental--candidate-base-state
(cons (current-buffer) base)))
(setq cached-candidate
(ebox-surface--owner-patch-candidate
(current-buffer) candidate owner-id
(plist-get owner-proof :allocated-width)
(plist-get owner-proof :variable-content-p)
(plist-get owner-proof :variable-content-max-width)
(plist-get owner-proof :role-owned-lines-p)
(plist-get owner-proof :changed-keys)
(plist-get owner-proof :allocation-closure-p)
(plist-get owner-proof :retain-external-owner-suffix-p)
base))
(when cached-candidate
(setq cached-lines (copy-sequence lines))
(cl-mapc
(lambda (span replacement)
(goto-char (car span))
(let* ((number (1- (line-number-at-pos)))
(start (- (car span) (line-beginning-position)))
(end (- (cdr span) (line-beginning-position)))
(old (nth number lines))
(new (concat (substring old 0 start) replacement
(substring old end))))
(setcar (nthcdr number cached-lines) new)
(push (list number old new) changes)))
(plist-get cached-candidate :old-spans)
(plist-get (plist-get cached-candidate :details) :lines))))))
(when (and cached-lines (= (length cached-lines) (length lines)))
(let* ((node (ebox-runtime-index-get owner-id
(plist-get previous-state :node-table)))
(visible (ebox--region-ids-visible-in-buffer-p
buffer (ebox--node-all-region-ids node))))
(setq output
(if visible
(ebox-surface--buffer-span-patch-output buffer previous-state state)
(with-current-buffer buffer
(buffer-substring (point-min) (point-max)))))
(when output
(unless visible
(plist-put state :content-base-extent (length output))
;; A zero-width identity patch carries the unchanged visible
;; coordinate proof through the ordinary retained TP batch.
(plist-put state :content-coordinate-patches
(list (list :old-start 0 :old-end 0 :new-start 0 :new-end 0)))
(plist-put state :span-patch-fragment-data
(ebox-surface--materialized-fragment-ledger previous-state))
(plist-put state :span-patch-content-p t)
(plist-put state :span-patch-retained-owned-ranges
(plist-get previous-state :surface-owned-ranges)))
(let* ((private (copy-sequence next-scroll))
(rendered (copy-sequence (plist-get next-scroll :rendered-content-lines)))
rendered-changes)
;; Lazy prefix extension mutates the bounds index in place.
;; Keep that future write isolated from the previous generation.
(when-let* ((bounds (plist-get private :region-line-bounds-index)))
(let ((copy (copy-hash-table bounds)))
(maphash (lambda (id range) (puthash id (cons (car range) (cdr range)) copy))
bounds)
(plist-put private :region-line-bounds-index copy)))
(when rendered
(dolist (change changes)
(let* ((number (car change))
(old (nth number rendered))
(new (car (ebox--scroll-rendered-content-lines
(plist-get private :box) (list (nth 2 change))
region number))))
(setcar (nthcdr number rendered) new)
(push (list number old new) rendered-changes))))
(plist-put private :content-lines cached-lines)
(plist-put private :region-line-span-index
(ebox-surface--scroll-replace-index-lines
(or (plist-get private :region-line-span-index)
(ebox--scroll-build-region-line-span-index lines))
changes))
(plist-put private :region-line-span-index-deferred nil)
(plist-put private :rendered-content-lines rendered)
(plist-put private :rendered-region-line-span-index
(ebox-surface--scroll-replace-index-lines
(plist-get private :rendered-region-line-span-index)
rendered-changes))
;; The validated owner preserves line and property topology;
;; line bounds/membership stay valid, character hints do not.
(cl-remf private :region-line-span-hints)
(puthash region private (plist-get state :scroll-state-table)))
(cl-remf state :scroll-content-proof))))
output)))
(defun ebox-surface--span-patch-output (buffer previous-state state)
"Return a proven local patch in BUFFER or its retained scroll content."
(if (plist-get state :scroll-content-proof)
(ebox-surface--scroll-content-patch-output buffer previous-state state)
(ebox-surface--buffer-span-patch-output buffer previous-state state)))
(defun ebox-surface--buffer-span-patch-output (buffer previous-state state)
"Return a proven single- or multi-owner local patch output, or nil."
(let* ((proofs (plist-get state :owner-scoped-proofs))
(candidates
(if proofs
(mapcar
(lambda (proof)
(cond
((plist-get proof :layer-recompose-p)
(ebox-surface--layer-patch-candidate
buffer previous-state state proof))
((plist-get proof :range-splice-p)
(unless (ebox-surface--owner-needs-ancestor-paint-p
state (plist-get proof :owner-id))
(ebox-surface--range-patch-candidate buffer state proof)))
(t (ebox-surface--owner-patch-candidate
buffer state (plist-get proof :owner-id)
(plist-get proof :allocated-width)
(plist-get proof :variable-content-p)
(plist-get proof :variable-content-max-width)
(plist-get proof :role-owned-lines-p)
(plist-get proof :changed-keys)
(plist-get proof :allocation-closure-p)
(plist-get proof :retain-external-owner-suffix-p)
(and (= (length proofs) 1) previous-state)))))
proofs)
(list
(ebox-surface--owner-patch-candidate
buffer state (plist-get state :span-patch-owner-id)
(plist-get state :owner-scoped-allocated-width)
nil nil nil nil nil nil previous-state))))
(retained-properties-p
(and candidates
(cl-every (lambda (candidate)
(plist-get candidate :retained-properties-p))
candidates)))
(retained-fragments
(and retained-properties-p
(ebox-surface--materialized-fragment-ledger previous-state))))
(when (and candidates (cl-every #'identity candidates)
(or (not retained-properties-p) retained-fragments))
(with-current-buffer buffer
(save-restriction
(widen)
(let* ((source (buffer-substring (point-min) (point-max)))
(origin (point-min))
(coordinate-shift-p
(cl-some
(lambda (candidate)
(let* ((details (plist-get candidate :details))
(old-footprint
(plist-get (plist-get candidate :snapshot)
:span-footprint-signature))
(new-footprint (plist-get details :footprint)))
(not (equal (plist-get old-footprint :char-lengths)
(plist-get new-footprint :char-lengths)))))
candidates))
(shared-generation
;; Glyph-width-only changes keep every buffer coordinate.
;; Any character-count delta, regardless of which proof
;; admitted the owner, shifts later snapshots and therefore
;; advances the global lazy-detail generation. Restricting
;; this to variable-content proofs left fixed-slot and theme
;; label updates with stale downstream coordinates.
(and coordinate-shift-p
(1+ (or (plist-get state
:layout-snapshot-detail-generation)
0))))
(ordered
(sort (copy-sequence candidates)
(lambda (left right)
(< (car (car (plist-get left :old-spans)))
(car (car (plist-get right :old-spans)))))))
(delta 0)
(rebased nil)
pairs)
;; Candidate details are first computed against the committed
;; coordinates. Once one owner changes length, every later
;; owner's new snapshot must be rebased by the accumulated delta;
;; installing each proof independently would leave stale spans.
(dolist (candidate ordered)
(let* ((details (plist-get candidate :details))
(old-spans (plist-get candidate :old-spans))
(new-spans
(mapcar (lambda (span)
(cons (+ (car span) delta)
(+ (cdr span) delta)))
(plist-get details :spans)))
(updated (copy-sequence details))
(line-delta
(cl-loop for old-span in old-spans
for line in (plist-get details :lines)
sum (- (length line)
(- (cdr old-span) (car old-span))))))
(plist-put updated :spans new-spans)
(push (cons candidate updated) rebased)
(setq delta (+ delta line-delta))))
(dolist (candidate candidates)
(cl-mapc
(lambda (span line) (push (cons span line) pairs))
(plist-get candidate :old-spans)
(plist-get (plist-get candidate :details) :lines)))
(setq pairs
(sort pairs
(lambda (left right)
(< (car (car left)) (car (car right))))))
(when-let* ((output
(ebox-surface--replace-buffer-spans
source origin (mapcar #'car pairs)
(mapcar #'cdr pairs))))
(plist-put state :content-base-extent (length source))
(plist-put
state :content-coordinate-patches
(let ((coordinate-delta 0)
patches)
;; PAIRS are the actual source replacements consumed by
;; `ebox-surface--replace-buffer-spans'. Snapshot spans
;; describe semantic ownership inside those replacement
;; strings and may begin after wrapper padding; using them as
;; edit coordinates creates artificial gaps and an invalid
;; old-to-new mapping when several owners are composed.
(dolist (pair pairs (nreverse patches))
(let* ((old-span (car pair))
(replacement (cdr pair))
(old-start (- (car old-span) origin))
(old-end (- (cdr old-span) origin))
(new-start (+ old-start coordinate-delta))
(new-end (+ new-start (length replacement))))
(push (list :old-start old-start :old-end old-end
:new-start new-start :new-end new-end)
patches)
(setq coordinate-delta
(+ coordinate-delta
(- (length replacement)
(- old-end old-start))))))))
(dolist (candidate candidates)
(ebox-surface--install-span-patch-snapshot
state (plist-get candidate :owner-id)
(plist-get candidate :snapshot)
(cdr (assq candidate rebased))
shared-generation))
(when-let* ((old-fragments
(or retained-fragments
(ebox-surface--materialized-fragment-ledger
previous-state)))
(fragments
(if retained-properties-p
(if (and (not coordinate-shift-p)
(eq old-fragments
(plist-get previous-state
:surface-fragments)))
;; The published ledger already contains
;; immutable offsets. Equal-coordinate
;; property transport preserves every run,
;; so retain it without copying the page.
old-fragments
(ebox-surface--fragment-metadata old-fragments))
(ebox-surface--incremental-patched-fragments
output old-fragments
(plist-get state :content-coordinate-patches)
state))))
(plist-put state :span-patch-fragment-data fragments)
(plist-put state :span-patch-content-p t)
(when (and retained-properties-p (not coordinate-shift-p))
(plist-put state :span-patch-retained-owned-ranges
(plist-get previous-state :surface-owned-ranges))))
output)))))))
(defun ebox-surface--formatting-context-reflow-lines
(start rendered)
"Return absolute whole-line spans for RENDERED beginning at START."
(let ((offset start)
spans)
(dolist (line (ebox-string-lines rendered)
(nreverse spans))
(let ((end (+ offset (length line))))
(push (cons offset end) spans)
(setq offset (1+ end))))))
(defun ebox-surface--formatting-context-reflow-output (buffer state)
"Return full BUFFER text with one variable-line context replaced, or nil.
The proof owns a complete block of whole lines. Only that block is rendered
again; the surrounding buffer and retained node/object identities remain
untouched."
(let* ((proof (or (plist-get state :formatting-context-reflow-proof)
(plist-get (plist-get state :mixed-owner-proof)
:geometry-proof)))
(owner-id (and proof (plist-get proof :owner-id)))
(snapshot (and proof (plist-get proof :snapshot)))
(old-spans (and proof (plist-get proof :old-spans)))
(node (and owner-id
(ebox-runtime-index-get owner-id (plist-get state :node-table))))
(allocated-width (and proof
(plist-get proof :allocated-width))))
(when (and proof snapshot old-spans node
(ebox--spans-contiguous-lines-p old-spans)
(with-current-buffer buffer
(ebox--line-spans-cover-whole-lines-p old-spans)))
(let* ((rendered (ebox-surface--render-candidate-node state node))
(parent-table (plist-get state :parent-table))
(ancestor-owner-ids
(let ((walk (and parent-table
(ebox-runtime-index-get owner-id parent-table)))
owners)
(while walk
(when-let* ((ancestor
(ebox-runtime-index-get walk (plist-get state :node-table)))
(region-id
(ebox-surface--node-editable-region-id
ancestor)))
(setq owners (append owners (list region-id))))
(setq walk (ebox-runtime-index-get walk parent-table)))
owners))
(rendered
(ebox--maplines
(lambda (line)
(ebox--add-content-owners line ancestor-owner-ids))
rendered))
(new-footprint
(ebox--rendered-span-footprint-signature rendered))
(new-max (plist-get (ebox--external-footprint-signature-from-span-footprint
new-footprint)
:max-line-pixel-width))
(new-roles
(ebox-surface--rendered-role-topology-signature
rendered (plist-get snapshot :region-ids)))
(old-roles (plist-get snapshot :role-topology-signature))
(new-overflow (ebox--overflow-signature node))
(old-block-span (plist-get proof :old-block-span))
(block-start
(and old-block-span
(max 0
(1- (car old-block-span)))))
;; Mount positions are buffer positions (one-based, exclusive
;; end); the output string is zero-based, so both boundaries
;; need the same conversion before splicing.
(block-end
(and old-block-span
(1- (cdr old-block-span))))
(old-block-text
(and (integerp block-start)
(integerp block-end)
(with-current-buffer buffer
(buffer-substring (1+ block-start)
(1+ block-end)))))
;; The material context sits between two column line breaks.
;; They belong to the context's retained scope even though the
;; local node renderer quite correctly emits only its content.
(leading-newline-p
(and old-block-text
(> (length old-block-text) 0)
(= (aref old-block-text 0) ?\n)))
(trailing-newline-p
(and old-block-text
(> (length old-block-text) 0)
(= (aref old-block-text (1- (length old-block-text)))
?\n)))
(context-rendered
(concat (if leading-newline-p
"\n"
"")
rendered
(if trailing-newline-p
"\n"
"")))
(content-start (+ block-start (if leading-newline-p 1 0)))
(new-spans
(ebox-surface--formatting-context-reflow-lines
content-start rendered)))
(when (and (integerp block-start)
(integerp block-end)
(> block-end block-start)
(> (length context-rendered) 0)
new-spans
(or (null allocated-width)
(null new-max)
(<= new-max allocated-width))
(equal old-roles new-roles)
(equal (plist-get snapshot :overflow-signature)
new-overflow))
(with-current-buffer buffer
(save-restriction
(widen)
(let* ((source (buffer-substring (point-min) (point-max)))
(output
(concat (substring source 0 block-start)
context-rendered
(substring source block-end)))
(generation
(1+ (or (plist-get state
:layout-snapshot-detail-generation)
0)))
(updated (copy-sequence snapshot))
(new-external
(ebox--external-footprint-signature-from-span-footprint
new-footprint)))
(dolist (entry `((:buffer-span . ,(car new-spans))
(:buffer-spans . ,new-spans)
(:line-signature
. ,(plist-get new-footprint
:line-pixel-widths))
(:span-footprint-signature . ,new-footprint)
(:external-footprint-signature
. ,new-external)
(:role-topology-signature . ,new-roles)
(:overflow-signature . ,new-overflow)
(:detail-generation . ,generation)))
(setq updated
(plist-put updated (car entry) (cdr entry))))
(puthash owner-id updated (plist-get state :layout-snapshots))
(plist-put state :layout-snapshot-detail-generation generation)
(plist-put state :layout-snapshots-complete-p nil)
(plist-put state :formatting-context-reflow-new-spans new-spans)
(plist-put state :formatting-context-reflow-new-length
(length context-rendered))
(plist-put
state :content-coordinate-patches
(list (list :old-start block-start :old-end block-end
:new-start block-start
:new-end (+ block-start
(length context-rendered)))))
output))))))))
(defvar ebox-surface--paint-node-depth-cache nil
"Dynamically bound node-id depth cache for one mixed paint projection.")
(defvar ebox-surface--paint-node-chain-cache nil
"Dynamically bound role-chain cache for one mixed paint projection.")
(defconst ebox-surface--paint-node-depth-missing
(make-symbol "ebox-paint-node-depth-missing")
"Sentinel distinguishing an uncached paint node depth.")
(defconst ebox-surface--paint-node-chain-missing
(make-symbol "ebox-paint-node-chain-missing")
"Sentinel distinguishing an uncached paint node chain.")
(defun ebox-surface--repaint-output-fragment!
(output fragment old-state new-state old-face-cache new-face-cache
old-node-face-cache new-node-face-cache)
"Recompose FRAGMENT's face directly in mutable OUTPUT and return metadata.
FRAGMENT retains absolute offsets into OUTPUT. Avoiding one substring, one
fragment-local copy, and a final full concat per run keeps mixed projection
work proportional to semantic face composition instead of allocation churn."
(let* ((start (plist-get fragment :start))
(end (plist-get fragment :end))
(old-roles (plist-get fragment :old-paint-role-ids))
(new-roles (plist-get fragment :paint-role-ids))
(old-faces
(ebox-surface--cached-face-contributions
old-face-cache old-state old-roles old-node-face-cache))
(new-faces
(ebox-surface--cached-face-contributions
new-face-cache new-state new-roles new-node-face-cache))
(baseline
(and (< start end)
(if (plist-get fragment :face-baseline-known-p)
(copy-tree (plist-get fragment :face-baseline))
(ebox-surface--face-baseline
(get-text-property start 'face output) old-faces))))
(unchanged (and (equal old-roles new-roles)
(equal old-faces new-faces)))
(face (and (not unchanged)
(ebox-surface--compose-face baseline new-faces))))
(when (and (not unchanged) (< start end))
(if face
(put-text-property start end 'face face output)
(remove-text-properties start end '(face nil) output)))
(ebox-interaction--refresh-hover! output start end nil new-state)
(cl-remf fragment :text)
(plist-put fragment :text-source-p t)
(cl-remf fragment :old-paint-role-ids)
fragment))
(defun ebox-surface--mixed-owner-output (buffer previous-state state)
"Return one geometry-plus-paint candidate output, or nil on proof miss.
The geometry context is rendered by the existing whole-line proof. Paint
owners are then recomposed from the committed semantic fragment ledger, never
by peeling an already-composed face suffix. Any missing address/baseline
causes the caller to use the ordinary full projection."
(let* ((proof (plist-get state :mixed-owner-proof))
;; Range splices may change the TP object set, so the retained
;; content result cannot carry their paint layers. Preserve the
;; ordinary renderer before producing a cleaned paint baseline.
(geometry-proof (and proof
(not (ebox-surface--mixed-range-splice-p state))
(plist-get proof :geometry-proof)))
(geometry-kind (and proof (plist-get proof :geometry-kind)))
(paint-owner-ids (and proof (plist-get proof :paint-owner-ids)))
(output
(when geometry-proof
(if (eq geometry-kind 'span-patch)
(ebox-surface--span-patch-output
buffer previous-state state)
(plist-put state :render-cache (make-hash-table :test 'equal))
(plist-put state :render-signature-cache
(make-hash-table :test 'eq))
(let ((ebox--box-content-render-cache
(make-hash-table :test 'eq)))
(ebox-surface--formatting-context-reflow-output
buffer state)))))
(old-fragments
(ebox-surface--materialized-fragment-ledger previous-state))
(old-by-address (make-hash-table :test #'equal))
(old-by-local-address (make-hash-table :test #'equal))
(ebox-surface--paint-node-depth-cache
(make-hash-table :test #'eql))
(ebox-surface--paint-node-chain-cache
(make-hash-table :test #'equal)))
(when (and output old-fragments paint-owner-ids)
(dolist (fragment old-fragments)
(when-let* ((address (plist-get fragment :paint-address)))
(puthash address fragment old-by-address)
(let* ((roles (plist-get fragment :paint-role-ids))
(owner (cdr (assq 'content roles)))
(key (and owner
(list owner
(plist-get address :content-index)
(plist-get address :ordinal)))))
(when key
(puthash key
(cons fragment (gethash key old-by-local-address))
old-by-local-address)))))
(let ((new-fragments
(or (and (eq geometry-kind 'span-patch)
(plist-get state :span-patch-fragment-data))
(ebox-surface--rendered-fragments output))))
(catch 'mixed-owner-proof-miss
(let (pieces)
(dolist (fragment new-fragments)
(let* (;; Fragment metadata is immutable below its plist spine;
;; repaint replaces every mutable field it owns.
(copy (copy-sequence fragment))
(address (plist-get fragment :paint-address))
(roles (plist-get fragment :paint-role-ids))
(owner (cdr (assq 'content roles)))
(local-key
(and owner
(list owner
(plist-get address :content-index)
(plist-get address :ordinal))))
(matches (and local-key
(gethash local-key old-by-local-address)))
(old-fragment
(or (and address (gethash address old-by-address))
(and (= (length matches) 1) (car matches))))
(old-roles (and old-fragment
(plist-get old-fragment
:paint-role-ids)))
(paint-chain
(if (and old-fragment (equal old-roles roles)
(plist-get old-fragment :paint-node-chain))
(copy-sequence
(plist-get old-fragment :paint-node-chain))
(ebox-surface--paint-node-chain state roles)))
(direct-affected-p
(cl-some (lambda (entry)
(memq (cdr entry) paint-owner-ids))
roles))
(affected-p
(cl-some (lambda (node-id)
(memq node-id paint-owner-ids))
paint-chain))
(paint-change-p
(and affected-p
(not
(equal
(and old-fragment
(ebox-surface--face-contributions
previous-state old-roles))
(ebox-surface--face-contributions
state roles))))))
(plist-put copy :paint-node-chain paint-chain)
(if (not affected-p)
(progn
(cl-remf copy :text)
(setq copy (plist-put copy :text-source-p t))
(push copy pieces))
(when (plist-get old-fragment :face-baseline-known-p)
(plist-put copy :face-baseline
(copy-tree
(plist-get old-fragment :face-baseline)))
(plist-put copy :face-baseline-known-p t))
;; When Range identity changes prevent an old-address match,
;; OUTPUT still contains the freshly rendered candidate
;; face. Remove the candidate's own new contributions to
;; recover the semantic baseline exactly; subsequent paint
;; composition can then proceed without guessing from an
;; unrelated old fragment.
(when (and (< (plist-get copy :start)
(plist-get copy :end))
(not (plist-get copy
:face-baseline-known-p)))
(plist-put
copy :face-baseline
(ebox-surface--face-baseline
(get-text-property (plist-get copy :start)
'face output)
(ebox-surface--face-contributions state roles)))
(plist-put copy :face-baseline-known-p t))
(when (and direct-affected-p paint-change-p
(< (plist-get copy :start)
(plist-get copy :end))
(not (plist-get copy
:face-baseline-known-p)))
(throw 'mixed-owner-proof-miss nil))
(plist-put copy :old-paint-role-ids
(copy-tree (or old-roles roles)))
(push copy pieces))))
(let ((fragments (nreverse pieces)))
(setq fragments
(ebox-surface--layer-paint-contributions
output fragments state))
(plist-put state :mixed-owner-fragment-data fragments)
(plist-put state :mixed-owner-content-p t)
(apply #'concat
(mapcar (lambda (fragment) (plist-get fragment :text))
fragments)))))))))
(defun ebox-surface--scroll-patch-output (_buffer state &optional complete-lines-only-p)
"Return a staged visible scroll window without rerunning layout when safe.
Chrome-free top-aligned root scroll boxes already store fully propertized
rendered lines. Join only the visible slice and add the scroll marker; any
box with wrapper chrome falls back to the retained wrapper renderer.
When COMPLETE-LINES-ONLY-P is non-nil, return only proven complete cached
physical lines, with private pixel-normalized copies where needed. Decline
wrapper rendering so a caller may keep its ordinary fractional-origin guard."
(let* ((region-id (plist-get state :scroll-patch-region-id))
(scroll-table (plist-get state :scroll-state-table))
(scroll-state (and region-id scroll-table
(gethash region-id scroll-table)))
(root (plist-get state :root-node))
(root-id (and root (plist-get root :node-id)))
(owner-id (plist-get state :span-patch-owner-id))
(cached-box (and scroll-state (plist-get scroll-state :box))))
(when (and scroll-state root owner-id root-id
(= owner-id root-id)
cached-box
(equal (plist-get cached-box :node-id) root-id))
(let* ((chrome-free-p
(and (= (or (ebox-get cached-box :padding-left-pixel) 0) 0)
(= (or (ebox-get cached-box :padding-right-pixel) 0) 0)
(= (or (ebox-get cached-box :padding-top-height) 0) 0)
(= (or (ebox-get cached-box :padding-bottom-height) 0) 0)
(= (or (ebox-get cached-box :margin-left-pixel) 0) 0)
(= (or (ebox-get cached-box :margin-right-pixel) 0) 0)
(= (or (ebox-get cached-box :margin-top-height) 0) 0)
(= (or (ebox-get cached-box :margin-bottom-height) 0) 0)
(= (or (ebox-get cached-box :border-left-pixel) 0) 0)
(= (or (ebox-get cached-box :border-right-pixel) 0) 0)
(= (or (ebox-get cached-box :border-top-pixel) 0) 0)
(= (or (ebox-get cached-box :border-bottom-pixel) 0) 0)
(eq (ebox-get cached-box :vertical-align) 'top)
(null (ebox-get cached-box :surface-properties))))
(visible
(and chrome-free-p
(ebox--scroll-state-retained-window-ready-p
scroll-state))))
(if (and visible (cadr visible))
(let* ((lines (cadr visible))
(output (ebox-lines-join lines)))
(unless complete-lines-only-p
(ebox-surface--check-local-pixel-output output))
(when (ebox--fractional-pixel-spaces-p output)
;; The root and chrome proof above establishes the physical
;; line origin. Normalize only these visible line handles;
;; their raw cache and integral template keys stay unchanged.
(let ((ebox--render-owned-text-values
(or (plist-get state :render-owned-text-values)
(make-hash-table :test #'eq))))
(setq lines (mapcar #'ebox--quantize-pixel-spaces lines)
output (ebox-lines-join lines))
(plist-put state :render-owned-text-values
ebox--render-owned-text-values)
(ebox--record-render-output-provenance output))
;; A later integer-only window cannot disprove fractions in
;; other retained rows, so scrolling only adds this raw fact.
(plist-put state :fractional-pixel-output-p t))
(when (and (ebox-surface--scroll-lines-owned-p lines)
(plist-get state :retained-scroll-content-p))
;; Retain immutable line handles and stream their cached role
;; runs directly into ownership planning. Materializing one
;; fragment plist per visible property run on every wheel
;; event made scroll allocation O(all visible fragments).
(plist-put state :scroll-patch-lines lines))
(when (> (length output) 0)
(add-text-properties
0 (length output)
(list 'ebox-scroll-window region-id)
output))
output)
(unless complete-lines-only-p
(let ((ebox--scroll-window-cached-state scroll-state)
(ebox--scroll-window-skip-state-rebuild-p
(plist-get scroll-state :content-lines-complete-p)))
(ebox-surface--render-candidate-node state root))))))))
(defun ebox-surface--native-scroll-full-output (state)
"Return the complete propertized root scroll output for native scrolling."
(let* ((region-id (plist-get state :scroll-patch-region-id))
(table (plist-get state :scroll-state-table))
(scroll-state (and region-id table (gethash region-id table)))
(lines (and scroll-state
(plist-get scroll-state :rendered-content-lines))))
(when (and lines
(plist-get scroll-state :content-lines-complete-p))
(let ((output (ebox-lines-join lines)))
(when (> (length output) 0)
(add-text-properties
0 (length output) (list 'ebox-scroll-window region-id) output))
output))))
(defun ebox-surface--runtime-index-ready-p (state)
"Return non-nil when STATE carries a complete prepared runtime index."
(let* ((root (plist-get state :root-node))
(root-id (and root (plist-get root :node-id)))
(nodes (plist-get state :node-table)))
(and (plist-get state :runtime-index-prepared-p)
root-id
(ebox-runtime-index-like-p nodes)
(eq root (ebox-runtime-index-get root-id nodes))
(ebox-runtime-index-like-p (plist-get state :parent-table))
(hash-table-p (plist-get state :region-id-set))
(ebox-runtime-index-like-p (plist-get state :region-node-table))
(hash-table-p (plist-get state :region-box-count-table))
(hash-table-p (plist-get state :region-box-table))
(hash-table-p
(and (plist-get state :source-index)
(ebox-source--index-host-ref-table-view
(plist-get state :source-index))))
(hash-table-p (plist-get state :range-ref-table))
(vectorp (plist-get state :native-node-postorder)))))
(defun ebox-surface--finish-runtime-state (state)
"Install or retain the prepared runtime indexes in candidate STATE."
(unless (ebox-surface--runtime-index-ready-p state)
(setq state
(ebox--render-state-install-index
state
(ebox--runtime-index
(plist-get state :root-node) t (plist-get state :source-index))))
(setq state (plist-put state :runtime-index-prepared-p t)))
(setq state
(plist-put state :selector-index-stale-p
(and (plist-get state :source-index)
(ebox-source--index-derived-stale-p
(plist-get state :source-index)))))
state)
(defun ebox-surface--role-ids-from-properties (properties)
"Return namespaced Ebox role/id pairs from PROPERTIES."
(let (roles)
(when-let* ((region-id
(plist-get properties 'ebox-overflow-foreground-source)))
(push (cons 'overflow-foreground region-id) roles))
(dolist (region-id (plist-get properties 'ebox-content-owners))
(cl-pushnew (cons 'content-owner region-id) roles :test #'equal))
(dolist (entry ebox-region-types)
(when-let* ((region-id (plist-get properties (cdr entry))))
(cl-pushnew (cons (car entry) region-id) roles :test #'equal)))
(nreverse roles)))
(defun ebox-surface--role-ids-at (rendered position &optional cache)
"Return namespaced Ebox role/id pairs at POSITION in RENDERED.
CACHE, when non-nil, reuses role extraction for equal property plists during
one output projection."
(let* ((properties (text-properties-at position rendered))
(missing (make-symbol "ebox-role-cache-missing"))
(cached (and cache (gethash properties cache missing))))
(if (and cache (not (eq cached missing)))
cached
(let ((roles (ebox-surface--role-ids-from-properties properties)))
(when cache
(puthash properties roles cache))
roles))))
(defun ebox-surface--paint-address-at
(rendered position role-cache ordinal-table)
"Return the semantic paint address at POSITION in RENDERED.
ROLE-CACHE is the per-render role extraction cache and ORDINAL-TABLE tracks
the first-to-last occurrence of an otherwise equal owner/content address.
The result deliberately contains semantic owner/role facts only; it never
uses a string, buffer, marker, or TP object identity as an address."
(let* ((properties (text-properties-at position rendered))
(roles (ebox-surface--role-ids-at rendered position role-cache))
(content-owner (plist-get properties 'ebox-content-owner))
(content-index (plist-get properties 'ebox-content-idx))
(prefix (and (or roles content-owner (integerp content-index))
(list :roles (copy-tree roles)
:content-owner content-owner
:content-index content-index)))
(ordinal (and prefix (gethash prefix ordinal-table 0))))
(when prefix
(puthash prefix (1+ ordinal) ordinal-table)
(list :roles (copy-tree roles)
:content-owner content-owner
:content-index content-index
:ordinal ordinal))))
(defun ebox-surface--candidate-plan-text (rendered owned-values)
"Return a private snapshot of RENDERED for an owned TP plan.
OWNED-VALUES is the candidate-local provenance registry created by Ebox's
render helpers. TP transfers only mutable values present in this registry;
all other values remain defensively copied."
(tp-text-snapshot
rendered
(and (hash-table-p owned-values)
(lambda (property value)
(and (ebox--render-owned-text-value-p
property value owned-values)
(not (memq property '(face font-lock-face mouse-face))))))))
(defun ebox-surface--region-role-tags (region-id role-ids)
"Return projection tags for REGION-ID from ROLE-IDS."
(list :ebox/region-id region-id
:ebox/roles
(cl-loop for (role . owner) in role-ids
when (equal owner region-id) collect role)))
(defun ebox-surface--fragment-owners
(role-ids state node-objects region-objects)
"Return ordered Ebox owner and tag pairs for ROLE-IDS.
Each owner appears at most once for one rendered fragment."
(let ((attached (make-hash-table :test #'eq))
(region-node-table (plist-get state :region-node-table))
(parent-table (plist-get state :parent-table))
owners)
(dolist (region-id (delete-dups (mapcar #'cdr role-ids)))
(let ((object (gethash region-id region-objects))
(node-id (ebox-runtime-index-get region-id region-node-table)))
(unless (and object node-id)
(error "Ebox output references unknown region %S" region-id))
(unless (gethash object attached)
(push (list object
(ebox-surface--region-role-tags region-id role-ids))
owners)
(puthash object t attached))
(setq node-id (ebox-runtime-index-get node-id parent-table))
(while node-id
(let ((ancestor (gethash node-id node-objects)))
(unless ancestor
(error "Ebox output ancestor has no TP object: %S" node-id))
(unless (gethash ancestor attached)
(push (list ancestor (list :ebox/descendant-output t)) owners)
(puthash ancestor t attached)))
(setq node-id (ebox-runtime-index-get node-id parent-table)))))
(nreverse owners)))
(defun ebox-surface--line-layout-dependencies (fragments rendered)
"Record allocation dependencies for one line's FRAGMENTS from RENDERED.
A boundary display-space with only content-owner roles fills its containing
line. Its width depends on descendant content and chrome in that container.
Interior gaps remain outside this permission. Keep publication dependencies
separate from semantic and paint ownership."
(let ((contributors (make-hash-table :test #'equal)))
(dolist (fragment fragments)
(let* ((roles (plist-get fragment :role-ids))
(direct (delete-dups
(cl-loop for (role . id) in roles
unless (eq role 'content-owner)
collect id))))
(when direct
(dolist (owner (delete-dups (mapcar #'cdr roles)))
(dolist (id direct)
;; A container's own padding/border is outside the allocation
;; it fills. Descendant chrome participates in that allocation.
(unless (equal id owner)
(let ((entry
(or (gethash owner contributors)
(puthash
owner
(list :ids nil :seen (make-hash-table :test #'equal)
:start (plist-get fragment :start)
:end (plist-get fragment :end))
contributors))))
(unless (gethash id (plist-get entry :seen))
(plist-put entry :ids (cons id (plist-get entry :ids)))
(puthash id t (plist-get entry :seen)))
(plist-put entry :start
(min (plist-get entry :start)
(plist-get fragment :start)))
(plist-put entry :end
(max (plist-get entry :end)
(plist-get fragment :end))))))))))
(dolist (fragment fragments)
(let* ((roles (plist-get fragment :role-ids))
(start (plist-get fragment :start))
(end (plist-get fragment :end)))
(when (and roles
(cl-every (lambda (role) (eq (car role) 'content-owner))
roles)
(= (- end start) 1)
(= (aref rendered start) ?\s)
(eq (car-safe (get-text-property start 'display rendered))
'space))
(when-let* ((entry (gethash (cdar roles) contributors)))
(when (or (<= end (plist-get entry :start))
(>= start (plist-get entry :end)))
(plist-put fragment :layout-region-ids
(plist-get entry :ids)))))))))
(defun ebox-surface--rendered-fragments (rendered)
"Return an offset index of Ebox-owned property runs in RENDERED.
The complete propertized string remains the sole text storage. Runs keep
START and END offsets into that string instead of allocating one substring
per property interval; paint projection materializes its private copies only
when it needs to mutate them."
(let ((position 0)
(limit (length rendered))
(line 0)
(role-cache (make-hash-table :test #'equal))
(ordinal-table (make-hash-table :test #'equal))
fragments line-fragments previous-role-ids next-role-ids)
(while (< position limit)
(let* ((next (or (next-property-change position rendered limit)
limit))
(origin (get-text-property position
ebox--paint-origin-property
rendered))
(roles (ebox-surface--role-ids-at rendered position role-cache))
(address
(ebox-surface--paint-address-at
rendered position role-cache ordinal-table))
(baseline
(and origin
(copy-tree
(ebox--paint-origin-baseline origin)))))
(push (list :text rendered :text-source-p t
:start position :end next
:line line :paint-role-ids roles
:role-ids roles
:paint-address address
:paint-token
(and address
(list :baseline (copy-tree baseline)
:roles (copy-tree roles)
:content-owner
(plist-get address :content-owner)
:content-index
(plist-get address :content-index)))
:face-baseline baseline
:face-baseline-known-p (and origin t))
fragments)
(push (car fragments) line-fragments)
(when origin
(remove-text-properties
position next (list ebox--paint-origin-property nil) rendered))
(let ((line-count (cl-count ?\n rendered :start position :end next)))
(when (> line-count 0)
(ebox-surface--line-layout-dependencies line-fragments rendered)
(setq line-fragments nil))
(cl-incf line line-count))
(setq position (max next (1+ position)))))
(when line-fragments
(ebox-surface--line-layout-dependencies line-fragments rendered))
(setq fragments (nreverse fragments))
(dolist (fragment fragments)
(if-let* ((roles (plist-get fragment :role-ids)))
(setq previous-role-ids roles)
(plist-put fragment :previous-role-ids previous-role-ids)))
(dolist (fragment (reverse (copy-sequence fragments)))
(if-let* ((roles (plist-get fragment :role-ids)))
(setq next-role-ids roles)
(plist-put fragment :role-ids
(delete-dups
(append (copy-sequence
(plist-get fragment :previous-role-ids))
(copy-sequence next-role-ids))))))
(cl-loop for fragment in fragments for index from 0
do (plist-put fragment :key (cons 'ebox/fragment index))
do (cl-remf fragment :previous-role-ids)
collect fragment)))
(defun ebox-surface--incremental-patched-fragments
(output old-fragments patches &optional state)
"Rebase OLD-FRAGMENTS through exact text PATCHES into OUTPUT.
Return nil unless every patch is aligned to retained fragment boundaries and
preserves the ordered role topology inside its replaced range. On success,
only replacement slices are scanned; unchanged fragment metadata is copied
and shifted without inspecting its text properties. STATE, when supplied,
receives the proven fragment-boundary coordinate mapping so retained owner
boundaries inside a replaced line can be rebased without guessing."
(when (and (stringp output) old-fragments patches)
(catch 'miss
(let ((remaining old-fragments)
(old-cursor 0)
(new-cursor 0)
(line-shift 0)
result new-origin-ranges coordinate-patches)
(dolist (patch patches)
(let ((old-start (plist-get patch :old-start))
(old-end (plist-get patch :old-end))
(new-start (plist-get patch :new-start))
(new-end (plist-get patch :new-end)))
(unless (and (integerp old-start) (integerp old-end)
(integerp new-start) (integerp new-end)
(<= old-cursor old-start old-end)
(<= new-cursor new-start new-end)
(= (- new-start new-cursor)
(- old-start old-cursor))
(<= new-end (length output)))
(throw 'miss nil))
(while (and remaining
(<= (plist-get (car remaining) :end) old-start))
(let ((copy (copy-sequence (pop remaining))))
(unless (= (plist-get copy :start) old-cursor)
(throw 'miss nil))
(let ((length (- (plist-get copy :end)
(plist-get copy :start))))
(plist-put copy :start new-cursor)
(plist-put copy :end (+ new-cursor length))
(plist-put copy :line
(+ line-shift (plist-get copy :line)))
(plist-put copy :text output)
(plist-put copy :text-source-p t)
(push copy result)
(setq old-cursor (+ old-cursor length)
new-cursor (+ new-cursor length)))))
(unless (= old-cursor old-start) (throw 'miss nil))
(let (old-window)
(while (and remaining
(< (plist-get (car remaining) :start) old-end))
(let ((fragment (pop remaining)))
(unless (and (= (plist-get fragment :start) old-cursor)
(<= (plist-get fragment :end) old-end))
(throw 'miss nil))
(push fragment old-window)
(setq old-cursor (plist-get fragment :end))))
(unless (= old-cursor old-end) (throw 'miss nil))
(setq old-window (nreverse old-window))
(let* ((slice (substring output new-start new-end))
(new-window (ebox-surface--rendered-fragments slice)))
(unless (and (= (length old-window) (length new-window))
(cl-every
(lambda (pair)
(and (equal
(plist-get (car pair) :paint-role-ids)
(plist-get (cdr pair) :paint-role-ids))
(equal
(plist-get (car pair) :role-ids)
(plist-get (cdr pair) :role-ids))))
(cl-mapcar #'cons old-window new-window)))
(throw 'miss nil))
(let ((old-first-line
(or (plist-get (car old-window) :line) 0))
(new-first-line
(or (plist-get (car new-window) :line) 0))
(old-last-line
(or (plist-get (car (last old-window)) :line) 0))
(new-last-line
(or (plist-get (car (last new-window)) :line) 0)))
;; Span-patch proofs retain the same line topology. A
;; variable-line context uses the full fragment scanner.
(unless (= (- old-last-line old-first-line)
(- new-last-line new-first-line))
(throw 'miss nil))
(cl-mapc
(lambda (old new)
(let ((copy (copy-sequence new)))
(plist-put copy :start
(+ new-start (plist-get new :start)))
(plist-put copy :end
(+ new-start (plist-get new :end)))
(plist-put copy :line
(+ line-shift old-first-line
(- (plist-get new :line)
new-first-line)))
(plist-put copy :key (plist-get old :key))
(plist-put copy :paint-address
(copy-tree
(plist-get old :paint-address)))
(when-let* ((chain (plist-get old :paint-node-chain)))
(plist-put copy :paint-node-chain
(copy-sequence chain)))
(plist-put copy :text output)
(plist-put copy :text-source-p t)
(push (list :old-start (plist-get old :start)
:old-end (plist-get old :end)
:new-start (plist-get copy :start)
:new-end (plist-get copy :end))
coordinate-patches)
(push copy result)))
old-window new-window)
(push (cons new-start new-end) new-origin-ranges)))
(setq old-cursor old-end
new-cursor new-end))))
(while remaining
(let ((copy (copy-sequence (pop remaining))))
(unless (= (plist-get copy :start) old-cursor)
(throw 'miss nil))
(let ((length (- (plist-get copy :end)
(plist-get copy :start))))
(plist-put copy :start new-cursor)
(plist-put copy :end (+ new-cursor length))
(plist-put copy :line (+ line-shift (plist-get copy :line)))
(plist-put copy :text output)
(plist-put copy :text-source-p t)
(push copy result)
(setq old-cursor (+ old-cursor length)
new-cursor (+ new-cursor length)))))
(unless (= new-cursor (length output)) (throw 'miss nil))
(dolist (range new-origin-ranges)
(remove-text-properties
(car range) (cdr range)
(list ebox--paint-origin-property nil) output))
(when state
(plist-put state :content-coordinate-patches
(nreverse coordinate-patches)))
(nreverse result)))))
(defun ebox-surface--rebase-coordinate (position patches)
"Return POSITION rebased through PATCHES, or nil inside a replacement."
(let ((delta 0))
(catch 'done
(dolist (patch patches)
(let ((old-start (plist-get patch :old-start))
(old-end (plist-get patch :old-end))
(new-start (plist-get patch :new-start))
(new-end (plist-get patch :new-end)))
(unless (= new-start (+ old-start delta))
(throw 'done nil))
(cond
((< position old-start) (throw 'done (list (+ position delta))))
((= position old-start) (throw 'done (list new-start)))
((< position old-end) (throw 'done nil))
((= position old-end) (throw 'done (list new-end))))
(setq delta (+ delta (- new-end new-start)
(- old-start old-end)))))
(list (+ position delta)))))
(defun ebox-surface--rebase-owned-ranges (ranges patches output-length)
"Return fresh candidate RANGES rebased through PATCHES.
Any range boundary inside replaced text rejects reuse so ownership never
widens heuristically. The returned cons distinguishes an exact empty result
from a failed proof."
(catch 'miss
(let (result)
(dolist (range ranges)
(let ((start (ebox-surface--rebase-coordinate
(plist-get range :start) patches))
(end (ebox-surface--rebase-coordinate
(plist-get range :end) patches)))
(unless (and start end (< (car start) (car end))
(<= (car end) output-length))
(throw 'miss nil))
(push (list :object (plist-get range :object)
:start (car start) :end (car end)
:tags (copy-tree (plist-get range :tags)))
result)))
(cons t (nreverse result)))))
(defun ebox-surface--snapshot-owned-ranges (ranges)
"Return an immutable client-state snapshot of candidate RANGES."
(mapcar (lambda (range)
(list :object (plist-get range :object)
:start (plist-get range :start)
:end (plist-get range :end)
:tags (copy-tree (plist-get range :tags))))
ranges))
(defun ebox-surface--fragment-metadata (fragments &optional state)
"Return FRAGMENTS as offsets into the TP-owned rendered text.
The mutable propertized text is intentionally not retained in Ebox client
state; paint projection reads a defensive snapshot from the published
buffer only when it needs the old text. STATE additionally retains each
fragment's complete paint-owner ancestor chain."
(let ((offset 0)
(ebox-surface--paint-node-depth-cache
(and state (make-hash-table :test #'eql)))
(ebox-surface--paint-node-chain-cache
(and state (make-hash-table :test #'equal)))
metadata)
(dolist (fragment fragments (nreverse metadata))
(let* ((source-p (plist-get fragment :text-source-p))
(text (plist-get fragment :text))
(length (if source-p
(- (plist-get fragment :end)
(plist-get fragment :start))
(length text)))
(copy
(cl-loop for (key value) on fragment by #'cddr
unless (eq key :text)
append (list key value))))
(unless source-p
(plist-put copy :start offset)
(plist-put copy :end (+ offset length)))
(when (and state (plist-get copy :paint-role-ids)
(not (plist-get copy :paint-node-chain)))
(plist-put copy :paint-node-chain
(copy-sequence
(ebox-surface--paint-node-chain
state (plist-get copy :paint-role-ids)))))
(plist-put copy :text-source-p t)
(push copy metadata)
(setq offset (+ offset length))))))
(defun ebox-surface--owned-ranges-from-runs
(context leaf state node-objects region-objects attach-p visit-runs)
"Attach merged ownership produced by VISIT-RUNS to candidate LEAF.
VISIT-RUNS receives one callback accepting ROLE-IDS, START, END, and optional
layout dependency region ids.
Adjacent ranges merge only when both their owner and opaque tags match."
(let ((active (make-hash-table :test #'eq))
(owner-cache (make-hash-table :test #'equal))
ranges)
(funcall
visit-runs
(lambda (role-ids start end &optional layout-region-ids)
(let* ((cache-key (if layout-region-ids
(cons layout-region-ids role-ids)
role-ids))
(owners (gethash cache-key owner-cache 'ebox/no-owners)))
(when (eq owners 'ebox/no-owners)
(setq owners
(ebox-surface--fragment-owners
role-ids state node-objects region-objects))
(when layout-region-ids
(let ((attached (make-hash-table :test #'eq)))
(dolist (owner owners) (puthash (car owner) t attached))
(dolist (region-id layout-region-ids)
(let ((node-id (ebox-runtime-index-get region-id
(plist-get state :region-node-table))))
(while node-id
(let ((object (gethash node-id node-objects)))
(unless object
(error "Ebox layout dependency has no TP object: %S"
node-id))
(unless (gethash object attached)
(push (list object '(:ebox/layout-output t)) owners)
(puthash object t attached)))
(setq node-id
(ebox-runtime-index-get node-id (plist-get state :parent-table))))))))
(puthash cache-key owners owner-cache))
(dolist (owner owners)
(let* ((object (nth 0 owner))
(tags (nth 1 owner))
(tag-ranges
(or (gethash object active)
(let ((table (make-hash-table :test #'equal)))
(puthash object table active)
table)))
(current (gethash tags tag-ranges)))
(if (and current (= (plist-get current :end) start))
(plist-put current :end end)
(let ((range (list :object object :start start :end end
:tags tags)))
(push range ranges)
(puthash tags range tag-ranges))))))))
(setq ranges (nreverse ranges))
(when attach-p
(tp-object-attach-content-ranges-owned context leaf ranges))
ranges))
(defun ebox-surface--owned-ranges
(context leaf fragments state node-objects region-objects
&optional attach-p)
"Attach merged owner ranges for FRAGMENTS to candidate LEAF."
(ebox-surface--owned-ranges-from-runs
context leaf state node-objects region-objects attach-p
(lambda (visit)
(let ((offset 0))
(dolist (fragment fragments)
(let* ((source-p (plist-get fragment :text-source-p))
(start (if source-p
(plist-get fragment :start)
offset))
(end (if source-p
(plist-get fragment :end)
(+ offset (length (plist-get fragment :text))))))
(funcall visit (plist-get fragment :role-ids) start end
(plist-get fragment :layout-region-ids))
(setq offset
(if source-p
end
(+ offset (length (plist-get fragment :text)))))))))))
(defun ebox-surface--scroll-owned-ranges
(context leaf lines state node-objects region-objects attach-p)
"Attach merged owner ranges for retained scroll LINES to candidate LEAF."
(ebox-surface--owned-ranges-from-runs
context leaf state node-objects region-objects attach-p
(lambda (visit)
(let ((offset 0))
(dolist (line lines)
(let ((template
(or (ebox-surface--scroll-line-fragment-template line)
(error "Ebox retained scroll line lost fragment ownership"))))
(dolist (fragment template)
(funcall visit
(plist-get fragment :role-ids)
(+ offset (plist-get fragment :start))
(+ offset (plist-get fragment :end))
(plist-get fragment :layout-region-ids)))
(setq offset (+ offset (length line) 1))))))))
(defun ebox-surface--native-owned-ranges
(context leaf template state node-objects region-objects attach-p)
"Attach owner ranges from compact native fragment TEMPLATE."
(let ((active (make-hash-table :test #'eq))
(owner-cache
(or (plist-get state :native-fragment-owner-cache)
(let ((cache (make-hash-table :test #'equal)))
(plist-put state :native-fragment-owner-cache cache)
cache)))
ranges)
(dotimes (index (length template))
(let* ((record (aref template index))
(roles (aref record 3))
(owners (gethash roles owner-cache 'ebox/no-owners))
(start (aref record 0))
(end (aref record 1)))
(when (eq owners 'ebox/no-owners)
(setq owners
(ebox-surface--fragment-owners
roles state node-objects region-objects))
(puthash roles owners owner-cache))
(dolist (owner owners)
(let* ((object (nth 0 owner))
(tags (nth 1 owner))
(tag-ranges
(or (gethash object active)
(let ((table (make-hash-table :test #'equal)))
(puthash object table active)
table)))
(current (gethash tags tag-ranges)))
(if (and current (= (plist-get current :end) start))
(plist-put current :end end)
(let ((range (list :object object :start start :end end
:tags tags)))
(push range ranges)
(puthash tags range tag-ranges)))))))
(setq ranges (nreverse ranges))
(when attach-p
(tp-object-attach-content-ranges-owned context leaf ranges))
ranges))
(defun ebox-surface--materialized-fragment-ledger (state)
"Return STATE's paint ledger, expanding a native frame only on demand."
(let* ((ledger (plist-get state :surface-fragments))
(frame (and (listp ledger) (plist-get ledger :native-frame)))
(lines (and (listp ledger) (plist-get ledger :scroll-lines))))
(cond
(frame (ebox-native-reflow-frame-fragments frame))
(lines
(ebox-surface--fragment-metadata
(or (ebox-surface--scroll-fragment-data lines "")
(error "Ebox retained scroll lines lost fragment ownership"))
state))
(t ledger))))
(defun ebox-surface--formatting-context-reflow-owned-ranges
(context leaf ranges state node-objects)
"Replace inferred owner ranges for the reflow context with one block range.
Ancestor-output role propagation can otherwise make a variable-line context
claim the first property run of the following sibling. The proof already
owns the complete old block, so its candidate scope is the exact new block;
all descendant ranges remain unchanged."
(let* ((proof (plist-get state :formatting-context-reflow-proof))
(owner-id (plist-get proof :owner-id))
(owner (and owner-id (gethash owner-id node-objects)))
(node (and owner-id (ebox-runtime-index-get owner-id (plist-get state :node-table))))
(region-id (and node (plist-get node :region-id)))
(block-start
(max 0
(1- (car (plist-get proof :old-block-span)))))
(block-end (+ block-start
(or (plist-get state
:formatting-context-reflow-new-length)
0)))
(filtered
(cl-remove-if (lambda (range)
(eq (plist-get range :object) owner))
ranges)))
(when (and owner region-id (integerp block-start) (> block-end block-start))
(push (list :object owner :start block-start :end block-end
:tags (list :ebox/region-id region-id
:ebox/roles '(content-owner content)))
filtered))
(setq filtered (nreverse filtered))
(tp-object-attach-content-ranges-owned context leaf filtered)
filtered))
(defun ebox-surface--surface-plan
(context surface-root output state node-objects region-objects
&optional transfer-text-p)
"Return one shared-text TP plan for OUTPUT and STATE.
NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(let* ((scroll-lines
(and transfer-text-p
(plist-get state :retained-scroll-content-p)
(plist-get state :scroll-patch-lines)))
(fragment-root
(tp-object-ensure context surface-root
ebox-surface--fragments-key 'ebox/fragments))
(fragment-data
(unless scroll-lines
(or (and (eq output (plist-get state :native-render-output))
(plist-get state :native-render-fragment-template))
(and (eq (plist-get state :projection-kind)
'mixed-owner-reflow)
(plist-get state :mixed-owner-fragment-data))
(and (memq (plist-get state :projection-kind)
'(span-patch owner-scoped))
(plist-get state :span-patch-fragment-data))
(if (stringp output)
(ebox-surface--rendered-fragments output)
output))))
(rendered
(if (stringp output)
output
(if (and fragment-data
(plist-get (car fragment-data) :text-source-p))
(plist-get (car fragment-data) :text)
(apply #'concat
(mapcar (lambda (fragment)
(plist-get fragment :text))
fragment-data)))))
(text-leaf
(tp-object-ensure context fragment-root
ebox-surface--text-key 'ebox/text)))
(let* ((attach-p
(not (and transfer-text-p
(plist-get state :retained-scroll-content-p))))
(formatting-reflow-p
(or (eq (plist-get state :projection-kind)
'formatting-context-reflow)
(and (eq (plist-get state :projection-kind)
'mixed-owner-reflow)
(eq (plist-get (plist-get state :mixed-owner-proof)
:geometry-kind)
'formatting-context-reflow))))
(native-template-p
(and (vectorp fragment-data)
(eq output (plist-get state :native-render-output))))
(owned-ranges
(cond
(scroll-lines
(ebox-surface--scroll-owned-ranges
context text-leaf scroll-lines state node-objects
region-objects attach-p))
((and native-template-p
(plist-get state :native-reuse-ownership-p))
(let ((ranges
(plist-get state :native-committed-owned-ranges)))
(unless ranges
(error "Native retained frame has no ownership base"))
(when attach-p
(tp-object-attach-content-ranges-owned
context text-leaf ranges))
ranges))
(native-template-p
;; Rust already supplied the exact target role template. Map
;; it once to TP objects instead of guessing target ownership
;; by rebasing every old range through every text edit.
(ebox-surface--native-owned-ranges
context text-leaf fragment-data state node-objects
region-objects (and attach-p (not formatting-reflow-p))))
(t
(let ((rebased
(and (memq (plist-get state :projection-kind)
'(span-patch owner-scoped
mixed-owner-reflow))
(not formatting-reflow-p)
(plist-get state :previous-surface-owned-ranges)
(plist-get state :content-coordinate-patches)
(ebox-surface--rebase-owned-ranges
(plist-get state :previous-surface-owned-ranges)
(plist-get state :content-coordinate-patches)
(length rendered)))))
(if rebased
(let ((ranges (cdr rebased)))
(when attach-p
(tp-object-attach-content-ranges-owned
context text-leaf ranges))
ranges)
(ebox-surface--owned-ranges
context text-leaf fragment-data state node-objects
region-objects
(and attach-p (not formatting-reflow-p)))))))))
(when formatting-reflow-p
(setq owned-ranges
(ebox-surface--formatting-context-reflow-owned-ranges
context text-leaf owned-ranges state node-objects)))
(plist-put state :surface-owned-ranges
(if native-template-p
owned-ranges
(ebox-surface--snapshot-owned-ranges owned-ranges)))
(when (plist-get state :native-render-p)
(plist-put state :native-committed-rendered rendered)
(plist-put state :native-committed-owned-ranges owned-ranges)
(when native-template-p
(plist-put state :native-committed-fragment-template fragment-data)))
(cl-remf state :native-reuse-ownership-p)
(cl-remf state :native-coordinate-patches)
(cl-remf state :native-render-output)
(cl-remf state :native-render-fragments)
(cl-remf state :native-render-fragment-template)
(cl-remf state :previous-surface-owned-ranges)
(let* ((plan-text
(if (or transfer-text-p
(plist-get state :native-render-p)
(plist-get state :mixed-owner-content-p)
(plist-get state :span-patch-content-p))
;; Scroll output is a fresh renderer-owned string. The TP
;; owned-result path copies the string spine once while
;; rendering the plan; recursively snapshotting every
;; property value here duplicated the hot scroll work.
rendered
(ebox-surface--candidate-plan-text
rendered (plist-get state :render-owned-text-values))))
(plan
(tp-surface-plan-create-owned
:key ebox-surface--root-key :kind 'ebox/surface
:children
(list (tp-surface-plan-create-owned
:key ebox-surface--fragments-key :kind 'ebox/fragments
:children
(list (tp-surface-plan-create-owned
:key ebox-surface--text-key :kind 'ebox/text
:text plan-text
:capability 'content))
:capability 'content))
:capability 'content)))
(plist-put state :surface-fragments
(cond
((plist-get state :native-render-frame)
(list :native-frame (plist-get state :native-render-frame)))
(scroll-lines
(list :scroll-lines (copy-sequence scroll-lines)))
((or (plist-get state :mixed-owner-content-p)
(plist-get state :span-patch-content-p))
;; Mixed projection already produced fresh offset-only
;; fragment plists with retained paint chains.
fragment-data)
(t (ebox-surface--fragment-metadata fragment-data state))))
(cl-remf state :native-render-frame)
(cl-remf state :mixed-owner-fragment-data)
(cl-remf state :mixed-owner-content-p)
(cl-remf state :span-patch-fragment-data)
(cl-remf state :span-patch-content-p)
(cl-remf state :scroll-patch-lines)
(let ((rendered-length (length rendered)))
(list plan rendered owned-ranges
(list (list :object text-leaf :start 0 :end rendered-length
:props nil :tags nil :leaf t)
(list :object fragment-root :start 0 :end rendered-length
:props nil :tags nil :leaf nil)
(list :object surface-root :start 0 :end rendered-length
:props nil :tags nil :leaf nil))))))))
(defconst ebox-surface--paint-base-roles
'(content content-owner pt pb pl pr bl br)
"Rendered roles that identify a box's painted border-box surface.")
(defun ebox-surface--node-depth (state node-id)
"Return NODE-ID depth in Ebox runtime STATE."
(let ((cached
(and ebox-surface--paint-node-depth-cache
(gethash node-id ebox-surface--paint-node-depth-cache
ebox-surface--paint-node-depth-missing))))
(if (and cached
(not (eq cached ebox-surface--paint-node-depth-missing)))
cached
(let ((key node-id)
(parents (plist-get state :parent-table))
(depth 0))
(while (setq node-id (and node-id (ebox-runtime-index-get node-id parents)))
(cl-incf depth))
(when ebox-surface--paint-node-depth-cache
(puthash key depth ebox-surface--paint-node-depth-cache))
depth))))
(defun ebox-surface--paint-node-chain (state role-ids)
"Return the deepest rendered node and its ancestors for ROLE-IDS."
(let ((cached
(and ebox-surface--paint-node-chain-cache
(gethash role-ids ebox-surface--paint-node-chain-cache
ebox-surface--paint-node-chain-missing))))
(if (and cached (not (eq cached ebox-surface--paint-node-chain-missing)))
cached
(let ((region-nodes (plist-get state :region-node-table))
(parents (plist-get state :parent-table)) deepest deepest-depth)
(dolist (entry role-ids)
(when-let* ((node-id
(ebox-runtime-index-get
(cdr entry) region-nodes)))
(let ((depth (ebox-surface--node-depth state node-id)))
(when (or (null deepest-depth) (> depth deepest-depth))
(setq deepest node-id deepest-depth depth)))))
(let (chain)
(while deepest
(push deepest chain)
(setq deepest (ebox-runtime-index-get deepest parents)))
(setq chain (nreverse chain))
(when ebox-surface--paint-node-chain-cache
(puthash role-ids chain ebox-surface--paint-node-chain-cache))
chain)))))
(defun ebox-surface--box-face-contributions (box)
"Return BOX typography and color contributions in render order."
(let (faces)
(when (ebox-style--text-paint-owner-p box)
(when-let* ((font (ebox-buffer--font-face box)))
(push font faces))
(when-let* ((decoration
(ebox-buffer--text-decoration-face box)))
(push decoration faces))
(when-let* ((color (plist-get box :color)))
(push (ebox-buffer--color-face color 'foreground) faces)))
(when-let* ((background (plist-get box :bgcolor)))
(push (ebox-buffer--color-face background 'background) faces))
(nreverse faces)))
(defun ebox-surface--region-face-contributions (box roles ancestor-p)
"Return BOX face contributions for ROLES.
ANCESTOR-P means BOX wraps a more specific rendered surface."
(let (faces)
(cond
((memq 'overflow-foreground roles)
(when-let* ((color (plist-get box :color)))
(push (ebox-buffer--color-face color 'foreground) faces)))
((memq 'bl roles)
(push (ebox-buffer-side-border-face
(plist-get box :border-left-color)) faces))
((memq 'br roles)
(push (ebox-buffer-side-border-face
(plist-get box :border-right-color)) faces))
((or ancestor-p
(cl-intersection roles '(content content-owner pt pb pl pr)))
(setq faces (ebox-surface--box-face-contributions box))))
(when (and (memq 'bt roles)
(> (or (ebox-get box :border-top-pixel) 0) 0))
(setq faces
(append faces
(list (ebox-buffer--color-face
(plist-get box :border-top-color) 'overline)))))
(when (and (memq 'bb roles)
(> (or (ebox-get box :border-bottom-pixel) 0) 0))
(setq faces
(append
faces
(list (ebox-buffer--color-face
(plist-get box :border-bottom-color) 'underline)))))
faces))
(defconst ebox-surface--node-face-cache-missing
(make-symbol "ebox-node-face-cache-missing")
"Sentinel distinguishing a cached nil node face contribution from a miss.")
(defun ebox-surface--face-contributions (state role-ids &optional node-cache)
"Return semantic Ebox face contributions for ROLE-IDS in STATE."
(let ((nodes (plist-get state :node-table)) result first)
(setq first t)
(dolist (node-id (ebox-surface--paint-node-chain state role-ids))
(when-let* ((node (ebox-runtime-index-get node-id nodes))
(box (ebox-fragment-style-source-node node)))
(let* ((region-id (plist-get box :region-id))
(roles
(cl-loop for (role . owner) in role-ids
when (equal owner region-id) collect role))
(ancestor-p (not first))
(key (and node-cache (list node-id ancestor-p roles)))
(cached
(and node-cache
(gethash key node-cache
ebox-surface--node-face-cache-missing)))
(faces
(if (and node-cache
(not (eq cached
ebox-surface--node-face-cache-missing)))
cached
(let ((computed
(ebox-surface--region-face-contributions
box roles ancestor-p)))
(when node-cache
(puthash key computed node-cache))
computed))))
(dolist (face faces)
(push face result))
(setq first nil))))
(nreverse result)))
(defconst ebox-surface--face-cache-missing
(make-symbol "ebox-face-cache-missing")
"Sentinel distinguishing a cached nil face contribution from a miss.")
(defun ebox-surface--cached-face-contributions
(cache state role-ids &optional node-cache)
"Return CACHE's semantic face contribution for STATE and ROLE-IDS."
(let ((value (gethash role-ids cache ebox-surface--face-cache-missing)))
(if (eq value ebox-surface--face-cache-missing)
(let ((computed
(ebox-surface--face-contributions state role-ids node-cache)))
(puthash role-ids computed cache)
computed)
value)))
(defun ebox-surface--face-list (face)
"Return FACE as an ordered list of face entries."
(cond ((null face) nil)
((and (listp face) (keywordp (car-safe face))) (list face))
((listp face) (copy-sequence face))
(t (list face))))
(defun ebox-surface--face-value (entries)
"Return canonical face value represented by ENTRIES."
(pcase entries
('() nil)
(`(,entry) entry)
(_ entries)))
(defun ebox-surface--face-baseline (face contributions)
"Remove trailing Ebox CONTRIBUTIONS from FACE and return its baseline."
(let* ((entries (ebox-surface--face-list face))
(count (length contributions))
(baseline entries))
;; A prior paint projection may have appended the same semantic Ebox
;; contribution more than once. Peel every matching suffix layer before
;; composing the new state; caller-provided face entries remain untouched.
(while (and (> count 0)
(>= (length baseline) count)
(equal (last baseline count) contributions))
(setq baseline
(seq-take baseline (- (length baseline) count))))
(ebox-surface--face-value baseline)))
(defun ebox-surface--compose-face (baseline contributions)
"Append Ebox CONTRIBUTIONS to BASELINE using Emacs face semantics."
(let ((sample (make-string 1 ?x)))
(when baseline
(put-text-property 0 1 'face baseline sample))
(dolist (face contributions)
(add-face-text-property 0 1 face t sample))
(get-text-property 0 'face sample)))
(defun ebox-surface--layer-paint-contributions (output fragments state)
"Return baseline FRAGMENTS and retain ordered paint layers in STATE.
OUTPUT supplies source-backed fragment text. TP receives the resulting
relative face contributions and performs the final merge during prepare."
(let ((face-cache (make-hash-table :test #'equal))
(node-cache (make-hash-table :test #'equal))
(offset 0)
contributions result)
(dolist (fragment fragments)
(let* ((copy (copy-sequence fragment))
(source-p (plist-get fragment :text-source-p))
(text
(if source-p
(substring output
(plist-get fragment :start)
(plist-get fragment :end))
(copy-sequence (plist-get fragment :text))))
(length (length text))
(roles (plist-get fragment :paint-role-ids))
(affected-p (plist-member fragment :old-paint-role-ids))
(faces
(and affected-p
(ebox-surface--cached-face-contributions
face-cache state roles node-cache)))
(baseline
(and affected-p
(if (plist-get fragment :face-baseline-known-p)
(copy-tree (plist-get fragment :face-baseline))
(and (> length 0)
(ebox-surface--face-baseline
(get-text-property 0 'face text) faces))))))
(when (and affected-p (> length 0))
(if baseline
(put-text-property 0 length 'face baseline text)
(remove-text-properties 0 length '(face nil) text))
(when-let* ((face (ebox-surface--face-value faces)))
(let ((props (list 'face (copy-tree face))))
(if (and contributions
(= (plist-get (car contributions) :end) offset)
(equal-including-properties
(plist-get (car contributions) :props) props))
(plist-put (car contributions) :end (+ offset length))
(push (list :start offset :end (+ offset length)
:props props)
contributions)))))
(ebox-interaction--refresh-hover!
text 0 length
(and affected-p (ebox-surface--compose-face baseline faces)) state)
(plist-put copy :text text)
(plist-put copy :text-source-p nil)
(plist-put copy :start offset)
(plist-put copy :end (+ offset length))
(when affected-p
(plist-put copy :face-baseline (copy-tree baseline))
(plist-put copy :face-baseline-known-p t))
(cl-remf copy :old-paint-role-ids)
(push copy result)
(setq offset (+ offset length))))
(plist-put state :paint-property-contributions
(nreverse contributions))
(nreverse result)))
(defun ebox-surface--fragment-has-region-role-p
(fragment region-id roles)
"Return non-nil when FRAGMENT carries REGION-ID under any of ROLES."
(cl-some (lambda (entry)
(and (equal (cdr entry) region-id)
(memq (car entry) roles)))
(plist-get fragment :paint-role-ids)))
(defun ebox-surface--horizontal-border-line (fragments region-id bottom-p)
"Return REGION-ID top or BOTTOM-P anchor line from FRAGMENTS."
(let (lines)
(dolist (fragment fragments)
(when (ebox-surface--fragment-has-region-role-p
fragment region-id ebox-surface--paint-base-roles)
(push (plist-get fragment :line) lines)))
(when lines (apply (if bottom-p #'max #'min) lines))))
(defun ebox-surface--set-horizontal-border-role
(fragments region-id role enabled)
"Set REGION-ID horizontal border ROLE to ENABLED in FRAGMENTS."
(let ((line (ebox-surface--horizontal-border-line
fragments region-id (eq role 'bb)))
(property (alist-get role ebox-region-types)))
(dolist (fragment fragments)
(let* ((anchor-p
(and enabled (equal (plist-get fragment :line) line)
(ebox-surface--fragment-has-region-role-p
fragment region-id ebox-surface--paint-base-roles)))
(pair (cons role region-id)))
(dolist (key '(:paint-role-ids :role-ids))
(let ((roles (cl-remove pair (plist-get fragment key) :test #'equal)))
(plist-put fragment key (if anchor-p (append roles (list pair)) roles))))
(when (> (length (plist-get fragment :text)) 0)
(if-let* ((owner
(cdr (cl-find role
(plist-get fragment :paint-role-ids)
:key #'car :test #'eq :from-end t))))
(put-text-property 0 (length (plist-get fragment :text))
property owner (plist-get fragment :text))
(remove-text-properties
0 (length (plist-get fragment :text))
(list property nil) (plist-get fragment :text)))))))
fragments)
(defun ebox-surface--paint-border-topology (fragments state dirty-set)
"Return FRAGMENTS with horizontal border roles updated from STATE."
(let ((nodes (plist-get state :node-table)))
(dolist (dirty dirty-set fragments)
(when-let* ((node (ebox-runtime-index-get (plist-get dirty :node-id) nodes))
(box (ebox-fragment-style-source-node node))
(region-id (plist-get box :region-id)))
(dolist (entry '(((:border-top-width :border-top-style)
bt :border-top-pixel)
((:border-bottom-width :border-bottom-style)
bb :border-bottom-pixel)))
(when (cl-intersection (car entry)
(plist-get dirty :changed-keys))
(ebox-surface--set-horizontal-border-role
fragments region-id (cadr entry)
(> (or (plist-get box (caddr entry)) 0) 0))))))))
(defun ebox-surface--repaint-fragment
(fragment old-state new-state &optional old-face-cache new-face-cache)
"Return FRAGMENT with Ebox paint recomputed from OLD-STATE to NEW-STATE."
(let* ((text (copy-sequence (plist-get fragment :text)))
(old-roles (plist-get fragment :old-paint-role-ids))
(new-roles (plist-get fragment :paint-role-ids))
(old-faces
(if old-face-cache
(ebox-surface--cached-face-contributions
old-face-cache old-state old-roles)
(ebox-surface--face-contributions old-state old-roles)))
(new-faces
(if new-face-cache
(ebox-surface--cached-face-contributions
new-face-cache new-state new-roles)
(ebox-surface--face-contributions new-state new-roles)))
(baseline (and (> (length text) 0)
(if (plist-get fragment :face-baseline-known-p)
(copy-tree (plist-get fragment :face-baseline))
(ebox-surface--face-baseline
(get-text-property 0 'face text) old-faces))))
(unchanged (and (equal old-roles new-roles)
(equal old-faces new-faces)))
(face (and (not unchanged)
(ebox-surface--compose-face baseline new-faces))))
(when (and (not unchanged) (> (length text) 0))
(if face
(put-text-property 0 (length text) 'face face text)
(remove-text-properties 0 (length text) '(face nil) text)))
(ebox-interaction--refresh-hover! text 0 (length text) nil new-state)
(plist-put fragment :text text)
(cl-remf fragment :old-paint-role-ids)
fragment))
(defun ebox-surface--paint-fragments
(old-state new-state dirty-set old-text)
"Return OLD-STATE fragments repainted for NEW-STATE and DIRTY-SET.
OLD-TEXT is a defensive snapshot of the published TP content."
(unless (stringp old-text)
(error "Ebox paint projection has no published TP text"))
(let ((fragments
(mapcar
(lambda (fragment)
(let* ((copy (copy-tree fragment))
(text (substring old-text
(plist-get fragment :start)
(plist-get fragment :end))))
(plist-put copy :text text)
(plist-put copy :start 0)
(plist-put copy :end (length text))
(cl-remf copy :text-source-p)
(plist-put copy :old-paint-role-ids
(copy-tree (plist-get fragment :paint-role-ids)))
copy))
(ebox-surface--materialized-fragment-ledger old-state))))
(unless fragments
(error "Ebox paint projection has no published fragment topology"))
(ebox-surface--paint-border-topology fragments new-state dirty-set)
(mapcar (lambda (fragment)
(ebox-surface--repaint-fragment fragment old-state new-state))
fragments)))
(defun ebox-surface--refresh-paint-snapshots (state dirty-set)
"Refresh paint-significant layout snapshots in STATE for DIRTY-SET."
(let ((nodes (plist-get state :node-table))
(snapshots (plist-get state :layout-snapshots)))
(when (hash-table-p snapshots)
(dolist (dirty dirty-set)
(when-let* ((node-id (plist-get dirty :node-id))
(node (ebox-runtime-index-get node-id nodes))
(snapshot (gethash node-id snapshots)))
(plist-put snapshot :style-signature
(ebox-fragment-node-style-signature node)))))
state))
(defun ebox-surface--apply-state-overrides (state overrides)
"Apply plist OVERRIDES to candidate runtime STATE and return STATE."
(while overrides
(setq state (plist-put state (pop overrides) (pop overrides))))
state)
(defun ebox-surface--apply-scroll-offsets (root offsets)
"Apply surface-scoped scroll OFFSETS to matching boxes below ROOT."
(cl-labels
((visit (node)
(when (and (listp node) (not (stringp node)))
(when (eq (plist-get node :ebox-type) 'box)
(when-let* ((region-id (plist-get node :region-id))
(entry (assq region-id offsets)))
(ebox-put node :scroll-offset (cdr entry))))
(dolist (child (ebox-tree--children-raw node))
(visit child)))))
(visit root))
root)
(defun ebox-surface--context-axes (root)
"Return ROOT's exact viewport dependency axes without shared caches."
(let ((ebox--viewport-dependent-node-ids-cache
(make-hash-table :test 'eq))
(ebox--viewport-dependent-subtree-cache
(make-hash-table :test 'eq))
(ebox--viewport-height-dependent-subtree-cache
(make-hash-table :test 'eq)))
(ebox--viewport-dependent-node-id-axes root)))
(defun ebox-surface--projection-preserves-context-axes-p
(previous-state state-overrides projection-kind)
"Return non-nil when a proven projection preserves viewport dependency axes.
PREVIOUS-STATE must own a completed axis index. STATE-OVERRIDES must carry a
strict owner proof whose changes are limited to content, TP surface
properties, or paint. Those values can change measurement or publication,
but cannot introduce or remove a viewport expression or node identity."
(let ((dirty-set
(pcase projection-kind
('mixed-owner-reflow
(plist-get (plist-get state-overrides :mixed-owner-proof)
:dirty-set))
((or 'span-patch 'owner-scoped)
(and (plist-get state-overrides :owner-scoped-proofs)
(plist-get state-overrides :span-patch-dirty-set))))))
(and dirty-set
(plist-get previous-state :viewport-dependent-node-ids-ready)
(plist-member previous-state :viewport-dependent-node-id-axes)
(cl-every
(lambda (entry)
(cl-every
(lambda (key)
(or (memq key '(:content :surface-properties))
(memq key ebox--paint-style-signature-keys)))
(plist-get entry :changed-keys)))
dirty-set))))
(defun ebox-surface--projection-state
(root previous-state state-overrides projection-kind
stylesheet-active-p cascade-required-p axes viewport-width
viewport-height display-signature scroll-offsets)
"Build candidate STATE with the mounted context values installed."
(let ((state
(ebox-surface--apply-state-overrides
(if (eq projection-kind 'paint)
(copy-sequence previous-state)
(ebox--new-buffer-render-state root))
(copy-sequence state-overrides))))
(cl-remf state :paint-property-contributions)
(cl-remf state :span-patch-retained-owned-ranges)
(plist-put state :fractional-pixel-output-p
(plist-get previous-state :fractional-pixel-output-p))
(plist-put state :root-node root)
(plist-put state :layered-p
(if projection-kind
(or (plist-get previous-state :layered-p)
(cl-some (lambda (proof)
(plist-get proof :layer-recompose-p))
(plist-get state :owner-scoped-proofs)))
(and (fboundp 'ebox-layer-subtree-p)
(ebox-layer-subtree-p root))))
(plist-put state :root-portals-p
(if projection-kind
(or (plist-get previous-state :root-portals-p)
(and (plist-get state :layer-recompose-p)
(ebox-layer-portals-p root)))
(and (fboundp 'ebox-layer-portals-p)
(ebox-layer-portals-p root))))
(when (plist-get state :native-sync-confirmed-p)
(ebox-native-commit-attach-confirmed-base previous-state state))
(plist-put state :projection-kind projection-kind)
(plist-put state :cascade-active-p stylesheet-active-p)
(plist-put state :cascade-required-p cascade-required-p)
(when (and (memq projection-kind
'(span-patch owner-scoped mixed-owner-reflow))
(plist-get previous-state :surface-owned-ranges))
(plist-put state :previous-surface-owned-ranges
(plist-get previous-state :surface-owned-ranges)))
(when axes
(plist-put state :viewport-width viewport-width)
(plist-put state :viewport-height viewport-height)
(plist-put state :display-signature display-signature)
(plist-put state :viewport-dependent-node-id-axes axes)
(plist-put state :viewport-dependent-node-ids
(delete-dups (copy-sequence
(append (car axes) (cdr axes)))))
(plist-put state :viewport-dependent-node-ids-ready t)
(ebox-surface--apply-scroll-offsets root scroll-offsets))
state))
(defun ebox-surface--project
(context source previous-state preserve-identities-p state-overrides
signals projection-kind source-isolated-p source-path-copied-p)
"Project SOURCE in CONTEXT using PREVIOUS-STATE and identity policy.
PRESERVE-IDENTITIES-P retains existing Ebox node and region identities.
SIGNALS, when non-nil, supplies the mounted surface's host context.
PROJECTION-KIND may select a proven non-spatial projection.
SOURCE-ISOLATED-P means SOURCE is a private candidate owned by the current
publication attempt; it is safe to clear its transient attachments in place.
SOURCE-PATH-COPIED-P means SOURCE shares untouched Ebox nodes with the
published runtime and must be consumed without clearing those shared nodes."
(if (stringp source)
(let ((object
(tp-object-ensure context nil ebox-surface--root-key
'ebox/string)))
(ignore object)
(tp-surface-result-create
(tp-surface-plan-create
:key ebox-surface--root-key :kind 'ebox/string
:text source :capability 'content)))
(let* ((scroll-patch-p (eq projection-kind 'scroll-patch))
(initial-native-p
(and (null previous-state)
(null projection-kind)
(require 'ebox-native-reflow nil t)
(ebox-native-reflow-layout-ready-p)))
(scroll-fast-p
(and scroll-patch-p
(let ((table (plist-get state-overrides
:scroll-state-table))
(fast t))
(if (hash-table-p table)
(maphash
(lambda (_region-id scroll-state)
(unless
(ebox--scroll-state-retained-window-ready-p
scroll-state)
(setq fast nil)))
table)
(setq fast nil))
fast)))
(stylesheet-active-p
(if scroll-fast-p
(plist-get previous-state :cascade-active-p)
(ebox-style-cascade-active-p)))
(retained-runtime-source-p
(and previous-state
preserve-identities-p
(eq source (plist-get previous-state :root-node))
(or (memq projection-kind
'(viewport-reflow
viewport-reflow-mixed-scroll))
(and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p)))
(plist-get state-overrides :runtime-index-prepared-p)
(plist-get state-overrides
:viewport-dependent-node-ids-ready)
(plist-member state-overrides
:viewport-dependent-node-id-axes)))
(retained-native-source-p
(and retained-runtime-source-p
(eq projection-kind 'native-frame)))
(root (cond
(source-path-copied-p source)
(source-isolated-p
(if (and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p))
source
(ebox-surface--clear-runtime-attachments source)))
(retained-native-source-p source)
(t
(ebox-surface--candidate-root
source preserve-identities-p
retained-runtime-source-p))))
(state-overrides
(if (and (memq projection-kind
'(viewport-reflow viewport-reflow-mixed-scroll))
(not source-isolated-p)
(not source-path-copied-p))
(ebox-surface--isolated-viewport-overrides state-overrides)
state-overrides))
(source-base-index
(plist-get state-overrides :source-base-index))
(source-index
(or (plist-get state-overrides :source-index)
(and source-base-index
(ebox-tree-source-index
root t ebox--render-root-parent-kind
source-base-index))
(and (eq root (plist-get previous-state :root-node))
(plist-get previous-state :source-index))
(ebox-tree-source-index
root t ebox--render-root-parent-kind)))
(_source-index
(progn
(setq state-overrides (copy-sequence state-overrides))
;; A copied runtime root starts a new EQ memo generation on
;; every producer evaluation, including ordinary fallbacks.
;; Already isolated or path-copied sources keep their prepared
;; seed/prune contract and same-candidate native handoff.
(unless (eq root source)
(dolist (key '(:render-signature-cache
:viewport-height-dependent-subtree-cache
:flex-content-min-widths))
(setq state-overrides
(plist-put state-overrides key
(make-hash-table :test 'eq)))))
(cl-remf state-overrides :source-base-index)
(setq state-overrides
(plist-put state-overrides :source-index source-index))))
(retained-inline-styles-p
(and source-path-copied-p
(memq projection-kind '(span-patch owner-scoped))
(plist-get state-overrides
:computed-participation-validated-p)
(let ((dirty-set
(plist-get state-overrides :span-patch-dirty-set)))
(and dirty-set
(cl-every
(lambda (entry)
(equal (plist-get entry :changed-keys) '(:content)))
dirty-set)))))
(inline-inheritance-required-p
(unless (or scroll-fast-p retained-runtime-source-p
retained-inline-styles-p)
(ebox-surface--inline-inheritance-required-p
root source-index)))
(author-style-pending-p
(> (ebox-tree-author-style-count root) 0))
(cascade-required-p
(if (or scroll-fast-p retained-runtime-source-p
retained-inline-styles-p)
(plist-get previous-state :cascade-required-p)
(or stylesheet-active-p
inline-inheritance-required-p)))
(style-required-p
(if scroll-fast-p
cascade-required-p
(or cascade-required-p
author-style-pending-p
(plist-get previous-state :cascade-active-p)
(plist-get previous-state :cascade-required-p))))
(surface-display-signature
(and signals
(tp-signal-read
(ebox-surface--signals-display signals))))
;; Font resolution, text measurement, and final paint must see
;; one immutable host capability for the whole transaction.
(ebox--render-display-signature
(or surface-display-signature
ebox--render-display-signature
(ebox--display-signature)))
(ebox-surface--font-window
(or ebox-surface--font-window
(ebox-surface--buffer-display-window
(current-buffer))))
(_font-capability-projection
(when (and previous-state surface-display-signature
(not (equal
surface-display-signature
(plist-get previous-state
:display-signature))))
(ebox-surface--refresh-font-projections root)))
(projection
(ebox-surface--projection-start
context root style-required-p projection-kind previous-state
state-overrides)))
(setq source-index (plist-get projection :source-index)
state-overrides
(plist-put state-overrides :source-index source-index))
(unless (or source-isolated-p source-path-copied-p
retained-runtime-source-p)
(ebox-surface--reconcile-candidate
root source-index previous-state))
(let* ((context-axis-facts
(and
signals
(cond
((and scroll-fast-p
(plist-get previous-state
:viewport-dependent-node-ids-ready)
(plist-member
previous-state
:viewport-dependent-node-id-axes))
previous-state)
((and (memq projection-kind
'(viewport-reflow
viewport-reflow-mixed-scroll))
(plist-get
state-overrides
:viewport-dependent-node-ids-ready)
(plist-member
state-overrides
:viewport-dependent-node-id-axes))
;; The viewport planner owns this topology proof and
;; copies its exact axis partition into the candidate
;; contract. Rewalking the same immutable tree here
;; would only derive the identical fact a second time.
state-overrides)
((and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p)
(plist-get state-overrides
:viewport-dependent-node-ids-ready)
(plist-member
state-overrides
:viewport-dependent-node-id-axes))
state-overrides)
((ebox-surface--projection-preserves-context-axes-p
previous-state state-overrides projection-kind)
previous-state))))
(reuse-context-axes-p (not (null context-axis-facts)))
(axes
(and signals
(if reuse-context-axes-p
(plist-get context-axis-facts
:viewport-dependent-node-id-axes)
(ebox-surface--context-axes root))))
(viewport-width
(and signals
(funcall
(if (car axes) #'tp-signal-read #'tp-signal-peek)
(ebox-surface--signals-viewport-width signals))))
(viewport-height
(and signals
(funcall
(if (cdr axes) #'tp-signal-read #'tp-signal-peek)
(ebox-surface--signals-viewport-height signals))))
(scroll-offsets
(and signals
(tp-signal-peek
(ebox-surface--signals-scroll signals))))
(state
(ebox-surface--projection-state
root previous-state state-overrides projection-kind
stylesheet-active-p cascade-required-p axes viewport-width
viewport-height surface-display-signature scroll-offsets)))
(plist-put state :source-index source-index)
(when reuse-context-axes-p
(plist-put state :viewport-dependent-node-ids
(plist-get context-axis-facts
:viewport-dependent-node-ids))
(plist-put state :viewport-dependent-node-ids-ready t))
(plist-put state :style-binding-states
(plist-get projection :style-binding-states))
(plist-put state :selector-tree-snapshot
(plist-get projection :selector-tree-snapshot))
(plist-put state :selector-tree-token
(plist-get projection :selector-tree-token))
(plist-put state :stylesheet-signature
(plist-get projection :stylesheet-signature))
(plist-put state :scroll-fast-window-p scroll-fast-p)
(when (memq projection-kind
'(span-patch owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow))
(ebox-surface--attach-retained-node-objects state)
(when (eq projection-kind 'owner-scoped)
(ebox-surface--apply-retained-owner-styles state)))
(if (eq projection-kind 'paint)
(let* ((dirty-set (plist-get state-overrides :paint-dirty-set))
(buffer (and signals
(ebox-surface--signals-buffer signals)))
(old-text
(and (buffer-live-p buffer)
(with-current-buffer buffer
(save-restriction
(widen)
(buffer-substring (point-min) (point-max)))))))
;; Retaining scroll pixels still requires the producer's
;; reactive scroll subscription in this paint-only evaluation.
(when (and signals
(hash-table-p (plist-get state :scroll-state-table))
(> (hash-table-count
(plist-get state :scroll-state-table)) 0))
(tp-signal-read (ebox-surface--signals-scroll signals)))
(setq state (ebox-surface--finish-runtime-state state))
(ebox-surface--refresh-paint-snapshots state dirty-set)
(cl-remf state :paint-dirty-set)
(ebox-surface--projection-result
context projection state
(ebox-surface--paint-fragments
previous-state state dirty-set old-text)))
(cond
((memq projection-kind '(span-patch owner-scoped))
;; A local owner render visits only its own regions. Keep the
;; complete candidate registry, including disjoint retained scroll
;; boxes, in a private table until the transaction is accepted.
(plist-put state :region-box-table
(copy-hash-table (plist-get state :region-box-table))))
((not (memq projection-kind
'(scroll-patch formatting-context-reflow
mixed-owner-reflow)))
(plist-put state :region-box-table (make-hash-table :test 'equal))))
(let* ((_initial-native
(when initial-native-p
;; Initial mount has no incremental planner. Surface owns
;; the full candidate after style projection and runtime
;; indexing, so it may explicitly request one native full
;; frame; unsupported programs still fall back through
;; `ebox-native-commit-render' without publishing state.
(plist-put state :projection-kind 'native-frame)))
(rendered
(cond
((memq projection-kind
'(span-patch owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow))
(if-let* ((local-output
(or
;; Proven root scroll rows own their complete
;; physical origin, including any remainder.
(and (eq projection-kind 'scroll-patch)
(not (plist-get state :native-scroll-materialize-p))
(ebox-surface--scroll-patch-output
(ebox-surface--signals-buffer signals) state t))
;; A detached fractional owner cannot recover
;; the remainder spent by preceding siblings.
(unless (plist-get previous-state
:fractional-pixel-output-p)
(let ((ebox-surface--integral-local-output-required-p t))
(catch 'ebox/fractional-local-output
(pcase projection-kind
('scroll-patch
(or (and (plist-get state :native-scroll-materialize-p)
(ebox-surface--native-scroll-full-output state))
(ebox-surface--scroll-patch-output
(ebox-surface--signals-buffer signals) state)
;; A nested scroll already owns a
;; complete candidate projection.
;; Preserve its ordinary renderer
;; fallback without recascading the
;; retained source. The raw-output
;; guard still rejects fractions.
(unless (plist-get state :native-scroll-materialize-p)
(ebox-surface--render-candidate state))))
('formatting-context-reflow
(ebox-surface--formatting-context-reflow-output
(ebox-surface--signals-buffer signals) state))
('mixed-owner-reflow
(ebox-surface--mixed-owner-output
(ebox-surface--signals-buffer signals)
previous-state state))
(_
(ebox-surface--span-patch-output
(ebox-surface--signals-buffer signals)
previous-state state)))))))))
local-output
;; A declined output may already have staged coordinates,
;; fragments or paint layers. Rebuild from the original
;; candidate inputs before producing ordinary full output.
;; Range deltas already projected their complete object
;; map, including newly registered keys in this context.
(unless (and (eq projection-kind 'mixed-owner-reflow)
(ebox-surface--mixed-range-splice-p state))
(setq projection
(ebox-surface--complete-projection
context root source-index
style-required-p projection)))
(setq projection-kind nil
scroll-fast-p nil)
(setq source-index (plist-get projection :source-index))
(setq state
(ebox-surface--projection-state
root previous-state state-overrides nil
stylesheet-active-p cascade-required-p axes
viewport-width viewport-height
surface-display-signature
scroll-offsets))
(plist-put state :source-index source-index)
(plist-put state :style-binding-states
(plist-get projection :style-binding-states))
(plist-put state :selector-tree-snapshot
(plist-get projection
:selector-tree-snapshot))
(plist-put state :selector-tree-token
(plist-get projection
:selector-tree-token))
(plist-put state :stylesheet-signature
(plist-get projection
:stylesheet-signature))
(plist-put state :region-box-table
(make-hash-table :test 'equal))
(ebox-surface--render-candidate state)))
(t
(ebox-surface--render-candidate state)))))
(when (and (eq projection-kind 'native-frame)
(not (eq (plist-get state :projection-kind)
'native-frame)))
;; Native delta projection already owns a complete object map.
;; The existing Elisp renderer produced RENDERED exactly once;
;; only its final publication semantics need to become ordinary.
(setq projection-kind nil))
(when (and initial-native-p
(not (plist-get state :native-render-p)))
(plist-put state :projection-kind nil))
(when (and signals
(hash-table-p (plist-get state :scroll-state-table))
(> (hash-table-count
(plist-get state :scroll-state-table))
0))
(tp-signal-read (ebox-surface--signals-scroll signals)))
(setq state (ebox-surface--finish-runtime-state state))
(when (memq projection-kind
'(viewport-reflow viewport-reflow-mixed-scroll))
;; The reflow source is copied at this boundary. Attach the
;; retained objects only after its candidate indexes exist;
;; attaching before that point would mutate the published
;; node table through the old state's indexes.
(ebox-surface--attach-retained-node-objects state))
(let ((result
(ebox-surface--projection-result
context projection state rendered projection-kind)))
;; These flags authenticate one producer result only. Leaving
;; them in the committed client state would make a later
;; content/geometry update look like a scroll transaction and
;; bypass its scope validation.
(plist-put state :retained-scroll-content-p nil)
(plist-put state :native-scroll-materialize-p nil)
(cl-remf state :native-touched-node-ids)
(cl-remf state :native-removed-node-ids)
(cl-remf state :computed-participation-validated-p)
(cl-remf state :candidate-subject-table)
result)))))))
(defun ebox-surface-producer
(source &optional previous-state preserve-identities-p state-overrides
signals projection-kind source-isolated-p source-path-copied-p)
"Return a TP producer for Ebox SOURCE and optional PREVIOUS-STATE.
PRESERVE-IDENTITIES-P retains existing Ebox node and region identities.
STATE-OVERRIDES augments the candidate Ebox runtime state. SIGNALS carries
the mounted surface context; one-shot string materialization omits it.
PROJECTION-KIND may select a proven non-spatial projection.
SOURCE-ISOLATED-P means SOURCE is already an internally isolated runtime
candidate and must not be copied or reconciled again. SOURCE-PATH-COPIED-P
means SOURCE shares untouched Ebox nodes with the published runtime and must
also bypass candidate copying and reconciliation without clearing those nodes."
(lambda (context)
(let ((buffer (and signals (ebox-surface--signals-buffer signals))))
(if (buffer-live-p buffer)
(with-current-buffer buffer
(ebox-surface--project
context source previous-state preserve-identities-p state-overrides
signals projection-kind source-isolated-p source-path-copied-p))
(ebox-surface--project
context source previous-state preserve-identities-p state-overrides
signals projection-kind source-isolated-p source-path-copied-p)))))
(defun ebox-surface-materialize-ephemeral-string (source source-index)
"Materialize SOURCE with optional SOURCE-INDEX through one ephemeral TP plan."
(let ((ebox--surface-materialization-active t)
(ebox--region-id-counter ebox--region-id-counter)
(ebox--runtime-node-id-counter ebox--runtime-node-id-counter))
(tp-surface-materialize-string
(ebox-surface-producer
source nil t
(and source-index (list :source-base-index source-index))))))
;; Install the only upward-facing read port after every callback is defined.
;; Incremental planning owns no Surface symbol or publication capability.
(ebox-incremental-install-context-port
(ebox-incremental-context-port-create
:buffer-state #'ebox-surface--buffer-client-state
:region-mounts #'ebox-surface-region-mounts
:cascade-owner-proof-p #'ebox-surface--cascade-local-owner-proof-p
:prepare-inline-styles #'ebox-surface-prepare-inline-candidate-styles))
(provide 'ebox-surface)
;;; ebox-surface.el ends here