geekinney/ebox
1
0
Fork 0
Code Issues Pull Requests Actions 21 Packages Projects Releases Wiki Activity
fcfbeb0368
ebox/ebox-surface.el
Kinneyzhang fcfbeb0368 fix: restore immediate retained viewport updates
2026-08-26 00:09:53 +08:00

4163 lines
198 KiB
EmacsLisp
Raw Blame History

;;; 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-style)
(require 'ebox-tree)
(require 'ebox-layout)
(require 'ebox-incremental)
(require 'tp-reactive)
(require 'tp-surface)
(defvar ebox-region-types)
(defvar ebox--region-box-table)
(defvar ebox--scroll-global-state)
(defvar ebox--paint-origin-property)
(declare-function ebox--paint-origin-baseline
"ebox-render-context" (origin))
(defvar ebox--scroll-idle-prefetch-timers)
(defvar ebox--smooth-scroll-state-table)
(defvar ebox--buffer-render-state-table)
(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-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)
(defvar ebox-surface--inline-style-value-cache nil
"Per-projection cache for selector-free computed inline styles.")
(declare-function ebox--render-layout "ebox-layout" (node))
(declare-function ebox-native-commit-render
"ebox-native-commit" (state node))
(declare-function ebox-native-reflow-frame-fragments
"ebox-native-reflow" (frame))
(declare-function ebox-native-commit-projection-eligible-p
"ebox-native-commit"
(previous-state state-overrides stylesheet-active-p))
(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))
(defvar-local ebox-surface--buffer-surface nil
"Live TP content surface mounted for the current Ebox buffer.")
(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)
(defvar-local ebox-surface--context-signals nil
"Buffer-scoped TP signals consumed by the mounted Ebox producer.")
(defvar ebox-surface--scroll-line-fragment-cache
(make-hash-table :test #'eq :weakness 'key)
"Cached property-run templates for immutable rendered scroll lines.")
(defun ebox-surface--scroll-line-fragment-template (line)
"Return a reusable fragment template for rendered LINE, or nil.
The cache is keyed by the immutable line string object retained by scroll
state. Lines whose ownership is only implied through a neighboring line are
left on the conservative full fragment scanner path."
(or (gethash line ebox-surface--scroll-line-fragment-cache)
(let ((fragments (ebox-surface--rendered-fragments line)))
(when (and fragments
(cl-every (lambda (fragment)
(plist-get fragment :role-ids))
fragments))
(puthash line fragments ebox-surface--scroll-line-fragment-cache)
fragments))))
(defun ebox-surface--scroll-fragment-data (lines rendered)
"Return offset fragments for visible LINES in RENDERED, or nil.
Each cached line template is copied only at the plist spine and points at the
single joined RENDERED string. The text and role values remain candidate
owned; no per-fragment substring is allocated."
(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--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/color ebox/font ebox/font-family ebox/font-height
ebox/font-weight ebox/font-slant)
"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."
(and (eq (plist-get node :ebox-type) 'box)
(null (plist-get node :ebox-content-node))
(> (length (or (plist-get node :content) "")) 0)))
(defun ebox-surface--inline-inheritance-required-p (root)
"Return non-nil when inline styles in ROOT require 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 node)))
(when (cl-some (lambda (property)
(and (ebox-surface--style-consuming-node-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)))
(dolist (child (ebox-tree-node-children node))
(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--current-display-signature)))
: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-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-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))
(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))
(: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))))
(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)))
(plist-put state :last-update-report
(ebox-surface--participant-report
participant report 'completed)))
(setf (ebox-surface--framework-participant-state participant) 'completed)))
(defun ebox-surface--publish-runtime-state
(buffer surface old-state report-base after-publication
&optional framework-participant)
"Register BUFFER runtime publication for SURFACE after OLD-STATE.
REPORT-BASE requests an Ebox commit report. AFTER-PUBLICATION, when non-nil,
runs after TP and Ebox point at the same candidate generation.
FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil."
(let (new-state region-snapshot scroll-snapshot
old-surface old-mirror region-keys scroll-keys)
(tp-transaction-participate
(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 new-state
(plist-put new-state :surface surface)
(plist-put new-state :runtime-revision
(1- (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
(ebox-surface--participant-run-rollback framework-participant)
(if (buffer-live-p buffer)
(progn
(when region-snapshot
(ebox-incremental--restore-hash-snapshot
ebox--region-box-table region-snapshot))
(when scroll-snapshot
(ebox-incremental--restore-hash-snapshot
ebox--scroll-global-state scroll-snapshot))
(with-current-buffer buffer
(setq-local ebox-surface--buffer-surface old-surface))
(if old-mirror
(puthash buffer old-mirror ebox--buffer-render-state-table)
(remhash buffer ebox--buffer-render-state-table)))
(remhash buffer ebox--buffer-render-state-table)
(dolist (region-id region-keys)
(remhash region-id ebox--region-box-table))
(dolist (region-id scroll-keys)
(ebox--scroll-clear-state region-id)
(ebox--smooth-scroll-stop region-id))))))))
(defun ebox-surface-mount-buffer
(buffer source &optional report-base after-publication
preserve-identities-p state-overrides 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* ((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)
(unwind-protect
(progn
(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
'(:capability content :inhibit-read-only t
:coordinate-mounts t))))
(ebox-surface--publish-runtime-state
buffer surface old-state report-base after-publication
framework-participant))
(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))))))))
(ebox-surface--participant-complete
framework-participant
(ebox-incremental--finalize-declarative-scroll-publication
scroll-keys)))
surface)
(when (and signals-created-p (not success))
(ebox-surface--dispose-signals signals)))))
(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)
(tp-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))
(display-signature
(with-current-buffer buffer
(ebox--current-display-signature)))
(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)))
(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)))
(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))
(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 (eq projection-kind 'native-frame)
(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 (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow))
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 (when (and style-required-p
(not (and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p)))
(not (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow
mixed-owner-reflow))))
(ebox-tree-subject-index root)))
(selector-tree-snapshot
(if (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow
native-frame))
(plist-get previous-state :selector-tree-snapshot)
(and subjects
(ebox-surface--subject-signature
(plist-get subjects :root-subject)))))
(selector-tree-token
(if (memq projection-kind
'(owner-scoped scroll-patch native-frame))
(plist-get previous-state :selector-tree-token)
(and selector-tree-snapshot
(if (and (equal selector-tree-snapshot
(plist-get previous-state
:selector-tree-snapshot))
(plist-get previous-state :selector-tree-token))
(plist-get previous-state :selector-tree-token)
(cons 'ebox/selector-tree nil))))))
(if (eq projection-kind 'native-frame)
(ebox-surface--project-native-node-delta
context root 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)
(if (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)
(progn
(tp-object-retain context node-root)
(ebox-surface--ensure-node-tree
context node-root root objects-by-node
(and subjects (plist-get subjects :node-subject-table))
bindings-by-subject states-by-subject style-state-table
stylesheet-signature
selector-tree-token stylesheet-subject-local-p))))
(list :surface-root surface-root
:node-root node-root
: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-native-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)
(maphash
(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-native-node-delta
(context root 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 (hash-table-p nodes) (hash-table-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-native-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))
(maphash
(lambda (node-id node)
(when subject-table
(when-let* ((subject (gethash node subject-table))
(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 (gethash node-id nodes))
(parent-id (and node (gethash node-id parents)))
(old-object (and node (gethash node-id old-objects)))
(parent-node (and parent-id (gethash 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 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
object node subject-table bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token stylesheet-subject-local-p)
(ebox-style-sync-flex-item node)))
(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")))
objects-by-node))
(defun ebox-surface--complete-projection
(context root style-required-p projection)
"Complete a retained PROJECTION for ROOT after a local proof miss.
The initial span 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."
(let* ((node-root (plist-get projection :node-root))
(objects-by-node (plist-get projection :objects-by-node))
(style-state-table
(plist-get projection :style-binding-states))
(stylesheet-signature
(or (plist-get projection :stylesheet-signature)
(and style-required-p
(ebox-surface--stylesheet-signature))))
(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))))
(tp-object-retain context node-root)
(ebox-surface--ensure-node-tree
context node-root root objects-by-node
(and subjects (plist-get subjects :node-subject-table))
bindings-by-subject states-by-subject style-state-table
stylesheet-signature
selector-tree-token stylesheet-subject-local-p)
projection))
(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)))
(full-surface-p
(and scroll-fast-p
(plist-get state :retained-scroll-content-p)
root-id owner-id (= root-id owner-id)))
(native-retained-p
(and (eq projection-kind 'native-frame)
(plist-get state :native-topology-stable-p)))
(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))))
(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))
(let* ((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))
(property-contributions
(plist-get state :paint-property-contributions)))
(if (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--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 (gethash 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."
(let* ((surface (ebox-surface--live-buffer-surface buffer))
(old-state (and surface (tp-surface-client-state surface))))
(unless surface
(error "Ebox scoped update requires a mounted TP surface"))
(let ((objects
(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)
(when (and (null on-mismatch)
(or (plist-get state-overrides :owner-scoped-proofs)
(plist-get state-overrides :scroll-state-transaction)
(> (length scope-node-ids) 1)))
(setq on-mismatch 'root))
(unwind-protect
(progn
(tp-with-transaction
(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))
(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))))))))
(ebox-surface--participant-complete
framework-participant
(ebox-incremental--finalize-declarative-scroll-publication
scroll-keys scroll-prefetch-delay)))
surface)
(when (and signals-created-p (not success))
(ebox-surface--dispose-signals signals))))))))
(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))
(dolist (child (ebox-tree--children-raw node))
(visit child)))))
(visit root))
root)
(defun ebox-surface--candidate-root (source preserve-identities-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."
(unless (and (listp source) (not (stringp source)))
(error "Ebox surface source must be an Ebox node"))
(ebox-tree-validate-declarative-root source)
(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)
"Copy mutable viewport caches in OVERRIDES for a private reflow candidate.
The retained viewport projection may reuse the TP object topology, but its
layout pass still writes Ebox-side caches. Keep those writes out of the
published generation so a failed transaction has no cache state to restore."
(let ((copy (copy-sequence overrides)))
(dolist (key '(:render-cache :layout-fragments :render-signature-cache
:flex-content-min-widths
:viewport-height-dependent-subtree-cache))
(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 previous-state)
"Reconcile styled ROOT with PREVIOUS-STATE runtime identities."
(when-let* ((previous-root (plist-get previous-state :root-node)))
(ebox-tree-reconcile-runtime previous-root root))
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 (node)
"Return NODE's namespaced sibling key, or nil for positional identity."
(when-let* ((key (plist-get node :key)))
(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
(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-style-node-declarations 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
(null theme-delta-style)
selector-context-stable-p
(equal declarations (plist-get old-state :declarations))
(eq parent-binding (plist-get old-state :parent-binding))
(eq parent-style-state
(plist-get old-state :parent-style-state))
(= (if parent-binding 1 0)
(or (plist-get old-state
:inherited-dependency-count)
-1))
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))))
(state
(if reused-p
old-state
(let ((new-state
(list :selector-tree-token selector-tree-token
:declarations (copy-tree declarations)
:parent-binding parent-binding
:parent-style-state parent-style-state
:inherited-dependency-count
(if theme-parent-delta-p
1
(if theme-explicit-delta-style
0
(if parent-binding 1 0)))
:stylesheet-signature stylesheet-signature
:subject subject)))
(plist-put
new-state :compute
(let ((captured new-state)
(delta-style theme-delta-style)
(parent-delta-p theme-parent-delta-p)
(last-style (and old-binding
(tp-binding-last-value old-binding)))
(last-parent-style old-parent-style))
(if parent-delta-p
(lambda ()
(let ((parent-style
(and (plist-get captured :parent-binding)
(tp-binding-read
(plist-get captured :parent-binding)))))
(setq last-style
(or
(ebox-style--theme-parent-delta-computed
last-style
(plist-get captured :declarations)
last-parent-style parent-style)
(ebox-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)
(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)
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 declarations 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--node-style-binding-required-p (node)
"Return non-nil when selector-free NODE needs its own style binding."
(let ((declarations (ebox-style-node-declarations 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
(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 (gethash node subject-table)))
(if (and (hash-table-p ebox-surface--inline-style-value-cache)
(not (ebox-surface--node-style-binding-required-p 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)))
(ebox-style-apply-computed
node
(tp-binding-read
(ebox-surface--node-style-binding
object node subject bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p))))))
(defun ebox-surface--static-style-state-p (state &optional seen)
"Return non-nil when STATE's inherited binding closure is static.
The style compute may depend on its parent binding exactly once. Any other
dependency is a dynamic TP source and prevents a local cascade proof."
(let* ((binding (and state (plist-get state :binding)))
(parent-binding (and state (plist-get state :parent-binding)))
(parent-state (and state (plist-get state :parent-style-state)))
(inherited-count
(and state (plist-get state :inherited-dependency-count))))
(and (tp-binding-live-p binding)
(not (memq state seen))
(integerp inherited-count)
(= (tp-binding-dependency-count binding)
inherited-count)
(if parent-binding
(and parent-state
(eq parent-binding (plist-get parent-state :binding))
(ebox-surface--static-style-state-p
parent-state (cons state seen)))
(null parent-state)))))
(defun ebox-surface--cascade-local-owner-proof-p
(state candidate-state dirty-set)
"Return non-nil when DIRTY-SET has a static cascade closure in STATE.
CANDIDATE-STATE supplies the declarative nodes before cascade projection.
Missing binding state, changed declarations or selector metadata, dynamic TP
dependencies, or any malformed index conservatively preserves root planning."
(let ((objects (plist-get state :surface-node-object-table))
(style-states (plist-get state :style-binding-states))
(candidate-nodes (plist-get candidate-state :node-table))
(stylesheet-signature
(let* ((cache ebox-incremental--allocated-slot-proof-cache)
(missing (make-symbol "ebox-stylesheet-proof-missing"))
(cached (and cache
(gethash 'stylesheet-signature cache missing))))
(if (and cached (not (eq cached missing)))
cached
(let ((signature (ebox-surface--stylesheet-signature)))
(when cache
(puthash 'stylesheet-signature signature cache))
signature)))))
(and (hash-table-p objects)
(hash-table-p style-states)
(hash-table-p candidate-nodes)
dirty-set
(cl-every
(lambda (entry)
(if (eq (plist-get entry :dirty-kind) 'paint)
t
(let* ((node-id (plist-get entry :node-id))
(object (and node-id (gethash node-id objects)))
(style-state (and object (gethash object style-states)))
(candidate-node (and node-id
(gethash node-id candidate-nodes)))
(subject (and style-state
(plist-get style-state :subject))))
(and style-state candidate-node subject
(or (equal (ebox-style-node-declarations candidate-node)
(plist-get style-state :declarations))
(ebox-style--paint-declarations-equivalent-p
(plist-get style-state :declarations)
(ebox-style-node-declarations candidate-node)))
(equal (ebox-tree-node-id candidate-node)
(ecss-subject-id subject))
(equal (ebox-tree-node-classes candidate-node)
(ecss-subject-classes subject))
(equal (ebox-tree-metadata-string
(ebox-tree-node-selector-type candidate-node))
(ecss-subject-type subject))
(equal (mapcar
(lambda (attribute)
(cons (substring (symbol-name (car attribute)) 1)
(cdr attribute)))
(ebox-tree-node-attributes candidate-node))
(ecss-subject-attributes subject))
(equal (ebox-tree-node-state candidate-node)
(ecss-subject-states subject))
(equal stylesheet-signature
(plist-get style-state :stylesheet-signature))
(ebox-surface--static-style-state-p style-state)))))
dirty-set))))
(defun ebox-surface--ensure-node-tree
(context parent node table subject-table bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token stylesheet-subject-local-p)
"Ensure styled NODE descendants below PARENT in CONTEXT and fill TABLE."
(let ((object
(tp-object-ensure context parent
(ebox-surface--node-key node)
(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
object node subject-table bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token
stylesheet-subject-local-p))
(dolist (child (ebox-tree--children-raw node))
(ebox-surface--ensure-node-tree
context object child table subject-table bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token stylesheet-subject-local-p))
(when subject-table
(ebox-style-sync-flex-item node))
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)))
(maphash
(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))
('flex-item
(ebox-surface--node-editable-region-id (plist-get node :node)))
(_ 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--render-candidate (state)
"Render candidate STATE or optional NODE in isolated side tables."
(ebox-surface--render-candidate-node state (plist-get state :root-node)))
(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-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)))))
(unless (plist-get state :native-render-p)
(ebox--record-render-output-provenance rendered))
(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 (hash-table-p nodes) (hash-table-p objects))
(maphash
(lambda (node-id object)
(when-let* ((node (gethash 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 (gethash owner-id nodes)))
(object (and objects (gethash owner-id objects)))
(style-state (and style-states
(gethash object style-states)))
(binding (plist-get style-state :binding)))
(ebox-style-apply-computed node (tp-binding-read binding))
(ebox-style-sync-flex-item node)))
state))
(defun ebox-surface--rendered-role-topology-signature
(rendered region-ids)
"Return rendered Ebox role topology for REGION-IDS in RENDERED."
(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-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)
"Return validated patch details for OWNER-ID, or nil."
(let* (
(old-snapshot
(and owner-id (ebox--ensure-layout-snapshot-details buffer owner-id)))
(spans (and old-snapshot (plist-get old-snapshot :buffer-spans)))
(node (and owner-id (gethash owner-id (plist-get state :node-table))))
(render-node
(if role-owned-lines-p
;; The planner proved this fixed-basis owner in its published
;; Flex slot. Recreate that exact candidate-state witness for
;; publication; a natural render can have fewer owned lines and
;; would spuriously widen the TP scope to the root.
(and (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 old-snapshot changed-keys)))
(if allocated-width
(plist-put (copy-sequence node) :width allocated-width)
node))))
(when (and old-snapshot spans node render-node)
(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)))
(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))))))
(details
(and replacement
(ebox-surface--span-patch-details
buffer old-snapshot node spans replacement
variable-content-p variable-content-max-width))))
(and details
(list :owner-id owner-id :snapshot old-snapshot
:old-spans spans :details details))))))
(defun ebox-surface--span-patch-output (buffer state)
"Return a proven single- or multi-owner local patch output, or nil."
(let* ((proofs (plist-get state :owner-scoped-proofs))
(candidates
(if proofs
(mapcar
(lambda (proof)
(ebox-surface--owner-patch-candidate
buffer state (plist-get proof :owner-id)
(plist-get proof :allocated-width)
(plist-get proof :variable-content-p)
(plist-get proof :variable-content-max-width)
(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)))
proofs)
(list
(ebox-surface--owner-patch-candidate
buffer state (plist-get state :span-patch-owner-id)
(plist-get state :owner-scoped-allocated-width)
nil)))))
(when (and candidates (cl-every #'identity candidates))
(with-current-buffer buffer
(save-restriction
(widen)
(let* ((source (buffer-substring (point-min) (point-max)))
(origin (point-min))
(variable-p
(cl-some
(lambda (candidate)
(plist-get (plist-get candidate :details)
:variable-content-p))
candidates))
(coordinate-shift-p
(cl-some
(lambda (candidate)
(let* ((details (plist-get candidate :details))
(old-footprint
(plist-get (plist-get candidate :snapshot)
:span-footprint-signature))
(new-footprint (plist-get details :footprint)))
(not (equal (plist-get old-footprint :char-lengths)
(plist-get new-footprint :char-lengths)))))
candidates))
(shared-generation
;; A variable one-line slot may change glyph widths without
;; changing buffer coordinates. Only a character-count
;; delta shifts later spans and requires global lazy detail
;; invalidation; otherwise retain the existing generation
;; and let the owner snapshot update locally.
(and variable-p coordinate-shift-p
(1+ (or (plist-get state
:layout-snapshot-detail-generation)
0))))
(ordered
(sort (copy-sequence candidates)
(lambda (left right)
(< (car (car (plist-get left :old-spans)))
(car (car (plist-get right :old-spans)))))))
(delta 0)
(rebased nil)
pairs)
;; Candidate details are first computed against the committed
;; coordinates. Once one owner changes length, every later
;; owner's new snapshot must be rebased by the accumulated delta;
;; installing each proof independently would leave stale spans.
(dolist (candidate ordered)
(let* ((details (plist-get candidate :details))
(old-spans (plist-get candidate :old-spans))
(new-spans
(mapcar (lambda (span)
(cons (+ (car span) delta)
(+ (cdr span) delta)))
(plist-get details :spans)))
(updated (copy-sequence details))
(line-delta
(cl-loop for old-span in old-spans
for line in (plist-get details :lines)
sum (- (length line)
(- (cdr old-span) (car old-span))))))
(plist-put updated :spans new-spans)
(push (cons candidate updated) rebased)
(setq delta (+ delta line-delta))))
(dolist (candidate candidates)
(cl-mapc
(lambda (span line) (push (cons span line) pairs))
(plist-get candidate :old-spans)
(plist-get (plist-get candidate :details) :lines)))
(setq pairs
(sort pairs
(lambda (left right)
(< (car (car left)) (car (car right))))))
(when-let* ((output
(ebox-surface--replace-buffer-spans
source origin (mapcar #'car pairs)
(mapcar #'cdr pairs))))
(plist-put
state :content-coordinate-patches
(sort
(cl-loop
for (candidate . details) in rebased append
(cl-mapcar
(lambda (old-span new-span)
(list :old-start (- (car old-span) origin)
:old-end (- (cdr old-span) origin)
:new-start (- (car new-span) origin)
:new-end (- (cdr new-span) origin)))
(plist-get candidate :old-spans)
(plist-get details :spans)))
(lambda (left right)
(< (plist-get left :old-start)
(plist-get right :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))
output)))))))
(defun ebox-surface--formatting-context-reflow-lines
(start rendered)
"Return absolute whole-line spans for RENDERED beginning at START."
(let ((offset start)
spans)
(dolist (line (ebox-string-lines rendered)
(nreverse spans))
(let ((end (+ offset (length line))))
(push (cons offset end) spans)
(setq offset (1+ end))))))
(defun ebox-surface--formatting-context-reflow-output (buffer state)
"Return full BUFFER text with one variable-line context replaced, or nil.
The proof owns a complete block of whole lines. Only that block is rendered
again; the surrounding buffer and retained node/object identities remain
untouched."
(let* ((proof (or (plist-get state :formatting-context-reflow-proof)
(plist-get (plist-get state :mixed-owner-proof)
:geometry-proof)))
(owner-id (and proof (plist-get proof :owner-id)))
(snapshot (and proof (plist-get proof :snapshot)))
(old-spans (and proof (plist-get proof :old-spans)))
(node (and owner-id
(gethash owner-id (plist-get state :node-table))))
(allocated-width (and proof
(plist-get proof :allocated-width))))
(when (and proof snapshot old-spans node
(ebox--spans-contiguous-lines-p old-spans)
(with-current-buffer buffer
(ebox--line-spans-cover-whole-lines-p old-spans)))
(let* ((rendered (ebox-surface--render-candidate-node state node))
(new-footprint
(ebox--rendered-span-footprint-signature rendered))
(new-max (plist-get (ebox--external-footprint-signature-from-span-footprint
new-footprint)
:max-line-pixel-width))
(new-roles
(ebox-surface--rendered-role-topology-signature
rendered (plist-get snapshot :region-ids)))
(old-roles (plist-get snapshot :role-topology-signature))
(new-overflow (ebox--overflow-signature node))
(old-block-span (plist-get proof :old-block-span))
(block-start
(and old-block-span
(max 0
(1- (car old-block-span)))))
;; Mount positions are buffer positions (one-based, exclusive
;; end); the output string is zero-based, so both boundaries
;; need the same conversion before splicing.
(block-end
(and old-block-span
(1- (cdr old-block-span))))
(old-block-text
(and (integerp block-start)
(integerp block-end)
(with-current-buffer buffer
(buffer-substring (1+ block-start)
(1+ block-end)))))
;; The material context sits between two column line breaks.
;; They belong to the context's retained scope even though the
;; local node renderer quite correctly emits only its content.
(leading-newline-p
(and old-block-text
(> (length old-block-text) 0)
(= (aref old-block-text 0) ?\n)))
(trailing-newline-p
(and old-block-text
(> (length old-block-text) 0)
(= (aref old-block-text (1- (length old-block-text)))
?\n)))
(context-rendered
(concat (if leading-newline-p "\n" "")
rendered
(if trailing-newline-p "\n" "")))
(content-start (+ block-start (if leading-newline-p 1 0)))
(new-spans
(ebox-surface--formatting-context-reflow-lines
content-start rendered)))
(when (and (integerp block-start)
(integerp block-end)
(> block-end block-start)
(> (length context-rendered) 0)
new-spans
(or (null allocated-width)
(null new-max)
(<= new-max allocated-width))
(equal old-roles new-roles)
(equal (plist-get snapshot :overflow-signature)
new-overflow))
(with-current-buffer buffer
(save-restriction
(widen)
(let* ((source (buffer-substring (point-min) (point-max)))
(output
(concat (substring source 0 block-start)
context-rendered
(substring source block-end)))
(generation
(1+ (or (plist-get state
:layout-snapshot-detail-generation)
0)))
(updated (copy-sequence snapshot))
(new-external
(ebox--external-footprint-signature-from-span-footprint
new-footprint)))
(dolist (entry `((:buffer-span . ,(car new-spans))
(:buffer-spans . ,new-spans)
(:line-signature
. ,(plist-get new-footprint
:line-pixel-widths))
(:span-footprint-signature . ,new-footprint)
(:external-footprint-signature
. ,new-external)
(:role-topology-signature . ,new-roles)
(:overflow-signature . ,new-overflow)
(:detail-generation . ,generation)))
(setq updated
(plist-put updated (car entry) (cdr entry))))
(puthash owner-id updated (plist-get state :layout-snapshots))
(plist-put state :layout-snapshot-detail-generation generation)
(plist-put state :layout-snapshots-complete-p nil)
(plist-put state :formatting-context-reflow-new-spans new-spans)
(plist-put state :formatting-context-reflow-new-length
(length context-rendered))
(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)))
(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))
(geometry-proof (and proof (plist-get proof :geometry-proof)))
(geometry-kind (and proof (plist-get proof :geometry-kind)))
(paint-owner-ids (and proof (plist-get proof :paint-owner-ids)))
(output
(when geometry-proof
(if (eq geometry-kind 'span-patch)
(ebox-surface--span-patch-output buffer state)
(plist-put state :render-cache (make-hash-table :test 'equal))
(plist-put state :render-signature-cache
(make-hash-table :test 'eq))
(let ((ebox--box-content-render-cache
(make-hash-table :test 'eq)))
(ebox-surface--formatting-context-reflow-output
buffer state)))))
(old-fragments
(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)
(ebox-surface--incremental-patched-fragments
output old-fragments
(plist-get state :content-coordinate-patches)))
(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)))
(plist-put copy :paint-node-chain paint-chain)
(if (not affected-p)
(progn
(cl-remf copy :text)
(plist-put copy :text-source-p t)
(push copy pieces))
(when direct-affected-p
(unless (and address old-fragment
(or (plist-get old-fragment
:face-baseline-known-p)
(plist-get copy
:face-baseline-known-p)))
(throw 'mixed-owner-proof-miss nil)))
(when (plist-get old-fragment :face-baseline-known-p)
(plist-put copy :face-baseline
(copy-tree
(plist-get old-fragment :face-baseline)))
(plist-put copy :face-baseline-known-p t))
(plist-put copy :old-paint-role-ids
(copy-tree (or 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)
output)))))))
(defun ebox-surface--scroll-patch-output (_buffer state)
"Return a staged visible scroll window without rerunning layout when safe.
Chrome-free top-aligned root scroll boxes already store fully propertized
rendered lines. Join only the visible slice and add the scroll marker; any
box with wrapper chrome falls back to the retained wrapper renderer."
(let* ((region-id (plist-get state :scroll-patch-region-id))
(scroll-table (plist-get state :scroll-state-table))
(scroll-state (and region-id scroll-table
(gethash region-id scroll-table)))
(root (plist-get state :root-node))
(root-id (and root (plist-get root :node-id)))
(owner-id (plist-get state :span-patch-owner-id))
(cached-box (and scroll-state (plist-get scroll-state :box))))
(when (and scroll-state root owner-id root-id
(= owner-id root-id)
cached-box
(equal (plist-get cached-box :node-id) root-id))
(let* ((chrome-free-p
(and (= (or (ebox-get cached-box :padding-left-pixel) 0) 0)
(= (or (ebox-get cached-box :padding-right-pixel) 0) 0)
(= (or (ebox-get cached-box :padding-top-height) 0) 0)
(= (or (ebox-get cached-box :padding-bottom-height) 0) 0)
(= (or (ebox-get cached-box :margin-left-pixel) 0) 0)
(= (or (ebox-get cached-box :margin-right-pixel) 0) 0)
(= (or (ebox-get cached-box :margin-top-height) 0) 0)
(= (or (ebox-get cached-box :margin-bottom-height) 0) 0)
(= (or (ebox-get cached-box :border-left-pixel) 0) 0)
(= (or (ebox-get cached-box :border-right-pixel) 0) 0)
(not (ebox-get cached-box :border-top-p))
(not (ebox-get cached-box :border-bottom-p))
(eq (ebox-get cached-box :vertical-align) 'top)
(null (ebox-get cached-box :surface-properties))))
(visible
(and chrome-free-p
(ebox--scroll-state-retained-window-ready-p
scroll-state))))
(if (and visible (cadr visible))
(let* ((lines (cadr visible))
(output (ebox-lines-join lines))
(fragment-data
(ebox-surface--scroll-fragment-data lines output)))
(when (and fragment-data
(plist-get state :retained-scroll-content-p))
(plist-put state :scroll-patch-fragment-data fragment-data))
(when (> (length output) 0)
(add-text-properties
0 (length output)
(list 'ebox-scroll-window region-id)
output))
output)
(let ((ebox--scroll-window-cached-state scroll-state)
(ebox--scroll-window-skip-state-rebuild-p
(plist-get scroll-state :content-lines-complete-p)))
(ebox-surface--render-candidate-node state root)))))))
(defun ebox-surface--native-scroll-full-output (state)
"Return the complete propertized root scroll output for native scrolling."
(let* ((region-id (plist-get state :scroll-patch-region-id))
(table (plist-get state :scroll-state-table))
(scroll-state (and region-id table (gethash region-id table)))
(lines (and scroll-state
(plist-get scroll-state :rendered-content-lines))))
(when (and lines
(plist-get scroll-state :content-lines-complete-p))
(let ((output (ebox-lines-join lines)))
(when (> (length output) 0)
(add-text-properties
0 (length output) (list 'ebox-scroll-window region-id) output))
output))))
(defun ebox-surface--runtime-index-ready-p (state)
"Return non-nil when STATE carries a complete prepared runtime index."
(let* ((root (plist-get state :root-node))
(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
(hash-table-p nodes)
(eq root (gethash root-id nodes))
(hash-table-p (plist-get state :parent-table))
(hash-table-p (plist-get state :region-id-set))
(hash-table-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 (plist-get state :host-ref-table))
(hash-table-p (plist-get state :range-ref-table))
(vectorp (plist-get state :native-node-postorder)))))
(defun ebox-surface--finish-runtime-state (state)
"Install or retain the prepared runtime indexes in candidate STATE."
(unless (ebox-surface--runtime-index-ready-p state)
(ebox--render-state-install-index
state (ebox--runtime-index (plist-get state :root-node) t))
(plist-put state :runtime-index-prepared-p t))
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 (gethash 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 (gethash 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 (gethash node-id parent-table)))))
(nreverse owners)))
(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 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)
(when origin
(remove-text-properties
position next (list ebox--paint-origin-property nil) rendered))
(cl-incf line (cl-count ?\n rendered :start position :end next))
(setq position (max next (1+ position)))))
(setq fragments (nreverse fragments))
(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)
"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."
(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)
(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 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))
(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
(context leaf fragments state node-objects region-objects
&optional attach-p)
"Attach merged owner ranges for FRAGMENTS to candidate LEAF.
Adjacent ranges merge only when both their owner and opaque tags match."
(let ((active (make-hash-table :test #'eq))
(owner-cache (make-hash-table :test #'equal))
(offset 0)
ranges)
(dolist (fragment fragments)
(let* ((role-ids (plist-get fragment :role-ids))
(owners (gethash role-ids owner-cache 'ebox/no-owners))
(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))))))
(when (eq owners 'ebox/no-owners)
(setq owners
(ebox-surface--fragment-owners
role-ids state node-objects region-objects))
(puthash role-ids 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 offset (if source-p end (+ offset (length (plist-get fragment :text)))))))
(setq ranges (nreverse ranges))
(when attach-p
(tp-object-attach-content-ranges-owned context leaf ranges))
ranges))
(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)))
(if-let* ((frame (and (listp ledger)
(plist-get ledger :native-frame))))
(ebox-native-reflow-frame-fragments frame)
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 (gethash owner-id (plist-get state :node-table))))
(region-id (and node (plist-get node :region-id)))
(block-start
(max 0
(1- (car (plist-get proof :old-block-span)))))
(block-end (+ block-start
(or (plist-get state
:formatting-context-reflow-new-length)
0)))
(filtered
(cl-remove-if (lambda (range)
(eq (plist-get range :object) owner))
ranges)))
(when (and owner region-id (integerp block-start) (> block-end block-start))
(push (list :object owner :start block-start :end block-end
:tags (list :ebox/region-id region-id
:ebox/roles '(content-owner content)))
filtered))
(setq filtered (nreverse filtered))
(tp-object-attach-content-ranges-owned context leaf filtered)
filtered))
(defun ebox-surface--surface-plan
(context surface-root output state node-objects region-objects
&optional transfer-text-p)
"Return one shared-text TP plan for OUTPUT and STATE.
NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(let* ((fragment-root
(tp-object-ensure context surface-root
ebox-surface--fragments-key 'ebox/fragments))
(fragment-data
(or (and transfer-text-p
(plist-get state :retained-scroll-content-p)
(plist-get state :scroll-patch-fragment-data))
(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))
(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
((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 (eq (plist-get state :projection-kind)
'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))
;; 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)))
((plist-get state :mixed-owner-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)
(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 (gethash 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 (gethash (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 (gethash 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--foreground-face (color)
"Return the Ebox foreground face for COLOR."
(if (eq color 'ebox/default-foreground)
'(:inherit default)
(list :foreground color)))
(defun ebox-surface--box-face-contributions (box)
"Return BOX typography and color contributions in render order."
(let (faces)
(when-let* ((font (ebox-buffer--font-face box)))
(push font faces))
(when-let* ((color (plist-get box :color)))
(push (ebox-surface--foreground-face color) faces))
(when-let* ((background (plist-get box :bgcolor)))
(push (list :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-surface--foreground-face color) 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) (plist-get box :border-top-p))
(setq faces
(append faces
(list (list :overline
(or (plist-get box :border-top-color) t))))))
(when (and (memq 'bb roles) (plist-get box :border-bottom-p))
(setq faces
(append
faces
(list
(list :underline
(append '(:position t)
(when-let* ((color
(plist-get box :border-bottom-color)))
(list :color color))))))))
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 (gethash 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)))))
(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))
(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 (gethash (plist-get dirty :node-id) nodes))
(box (ebox-fragment-style-source-node node))
(region-id (plist-get box :region-id)))
(dolist (entry '((:border-top-p . bt) (:border-bottom-p . bb)))
(when (memq (car entry) (plist-get dirty :changed-keys))
(ebox-surface--set-horizontal-border-role
fragments region-id (cdr entry) (plist-get box (car entry)))))))))
(defun ebox-surface--repaint-fragment
(fragment old-state new-state &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)))
(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 (gethash 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--mixed-projection-preserves-context-axes-p
(previous-state state-overrides projection-kind)
"Return non-nil when a mixed projection preserves viewport dependency axes.
PREVIOUS-STATE must own a completed axis index. STATE-OVERRIDES must carry a
strict mixed-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."
(and (eq projection-kind 'mixed-owner-reflow)
(plist-get previous-state :viewport-dependent-node-ids-ready)
(plist-member previous-state :viewport-dependent-node-id-axes)
(when-let* ((proof (plist-get state-overrides :mixed-owner-proof)))
(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)))
(plist-get proof :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))))
(plist-put state :root-node root)
(plist-put state :projection-kind projection-kind)
(plist-put state :cascade-active-p stylesheet-active-p)
(plist-put state :cascade-required-p cascade-required-p)
(when (and (eq projection-kind '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))
(scroll-fast-p
(and scroll-patch-p
(let ((table (plist-get state-overrides
:scroll-state-table))
(fast t))
(if (hash-table-p table)
(maphash
(lambda (_region-id scroll-state)
(unless
(ebox--scroll-state-retained-window-ready-p
scroll-state)
(setq fast nil)))
table)
(setq fast nil))
fast)))
(stylesheet-active-p
(if scroll-fast-p
(plist-get previous-state :cascade-active-p)
(ebox-style-cascade-active-p)))
(root (cond
(source-path-copied-p source)
(source-isolated-p
(if (and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p))
source
(ebox-surface--clear-runtime-attachments source)))
(t
(ebox-surface--candidate-root
source preserve-identities-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))
(inline-inheritance-required-p
(if scroll-fast-p
(plist-get previous-state :cascade-required-p)
(ebox-surface--inline-inheritance-required-p root)))
(cascade-required-p
(if scroll-fast-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
(plist-get previous-state :cascade-active-p)
(plist-get previous-state :cascade-required-p))))
(projection-kind
(if (and (null projection-kind)
(require 'ebox-native-commit nil t)
(ebox-native-commit-projection-eligible-p
previous-state state-overrides stylesheet-active-p))
'native-frame
projection-kind))
(projection
(ebox-surface--projection-start
context root style-required-p projection-kind previous-state
state-overrides)))
(unless (or source-isolated-p source-path-copied-p)
(ebox-surface--reconcile-candidate root previous-state))
(let* ((reuse-context-axes-p
(and signals
(or scroll-fast-p
(and (eq projection-kind 'native-frame)
(plist-get state-overrides
:native-topology-stable-p)
(plist-get state-overrides
:viewport-dependent-node-ids-ready))
(ebox-surface--mixed-projection-preserves-context-axes-p
previous-state state-overrides projection-kind))))
(axes
(and signals
(if reuse-context-axes-p
(plist-get previous-state
: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))))
(display-signature
(and signals
(tp-signal-read
(ebox-surface--signals-display 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 display-signature scroll-offsets)))
(when reuse-context-axes-p
(plist-put state :viewport-dependent-node-ids
(plist-get previous-state
: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 :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)))))))
(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)))
(unless (memq projection-kind
'(scroll-patch formatting-context-reflow
mixed-owner-reflow))
(plist-put state :region-box-table (make-hash-table :test 'equal)))
(let ((rendered
(cond
((and (eq projection-kind 'scroll-patch)
(plist-get state :native-scroll-materialize-p))
(or (ebox-surface--native-scroll-full-output state)
(ebox-surface--scroll-patch-output
(ebox-surface--signals-buffer signals) state)))
((eq projection-kind 'scroll-patch)
(or (ebox-surface--scroll-patch-output
(ebox-surface--signals-buffer signals) state)
(ebox-surface--render-candidate state)))
((eq projection-kind 'formatting-context-reflow)
(or (ebox-surface--formatting-context-reflow-output
(ebox-surface--signals-buffer signals) state)
(ebox-surface--render-candidate state)))
((eq projection-kind 'mixed-owner-reflow)
(or (ebox-surface--mixed-owner-output
(ebox-surface--signals-buffer signals)
previous-state state)
(ebox-surface--render-candidate state)))
((memq projection-kind '(span-patch owner-scoped))
(if-let* ((span-output
(ebox-surface--span-patch-output
(ebox-surface--signals-buffer signals) state)))
span-output
(setq projection
(ebox-surface--complete-projection
context root style-required-p projection))
(setq state
(ebox-surface--projection-state
root previous-state state-overrides nil
stylesheet-active-p cascade-required-p axes
viewport-width viewport-height display-signature
scroll-offsets))
(plist-put state :style-binding-states
(plist-get projection :style-binding-states))
(plist-put state :selector-tree-snapshot
(plist-get projection
:selector-tree-snapshot))
(plist-put state :selector-tree-token
(plist-get projection
:selector-tree-token))
(plist-put state :region-box-table
(make-hash-table :test 'equal))
(ebox-surface--render-candidate state)))
(t
(ebox-surface--render-candidate state)))))
(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)
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)))))
(provide 'ebox-surface)
;;; ebox-surface.el ends here
Reference in New Issue View Git Blame Copy Permalink