geekinney/ebox
1
0
Fork 0
Code Issues Pull Requests Actions 21 Packages Projects Releases Wiki Activity
dd731cfbbf
ebox/ebox-surface.el
Kinneyzhang dd731cfbbf Optimize incremental mixed-owner rendering
2026-08-24 02:08:53 +08:00

3222 lines
152 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)
(declare-function ebox--render-layout "ebox-layout" (node))
(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-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))
(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."
(let ((offset 0)
(line-index 0)
result)
(dolist (line lines)
(let ((template (ebox-surface--scroll-line-fragment-template line)))
(unless template
(cl-return-from ebox-surface--scroll-fragment-data nil))
(dolist (fragment template)
(let ((copy (copy-sequence fragment)))
(plist-put copy :text rendered)
(plist-put copy :start (+ offset (plist-get fragment :start)))
(plist-put copy :end (+ offset (plist-get fragment :end)))
(plist-put copy :line line-index)
(push copy result))))
(setq offset (+ offset (length line) 1))
(setq line-index (1+ line-index)))
(nreverse result)))
(defun ebox-surface--style-state-table (previous-state)
"Copy retained style state from PREVIOUS-STATE into a weak table."
(let ((table (make-hash-table :test 'eq :weakness 'key)))
(when-let ((previous (plist-get previous-state :style-binding-states)))
(maphash (lambda (object state) (puthash object state table)) previous))
table))
(defun ebox-surface--stylesheet-signature ()
"Return one immutable snapshot of the active Ebox stylesheet."
(list (ecss-stylesheet-rules ebox-style-stylesheet)
(ecss-stylesheet-layers ebox-style-stylesheet)))
(defun ebox-surface--subject-signature (subject)
"Return SUBJECT's complete selector subtree without retaining parent cycles."
(cl-labels
((subtree (node)
(list (ecss-subject-type node) (ecss-subject-id node)
(ecss-subject-classes node)
(ecss-subject-attributes node)
(ecss-subject-states node)
(mapcar #'subtree (ecss-subject-children node)))))
(subtree subject)))
(defconst ebox-surface--root-key 'ebox/surface
"Stable TP key for an Ebox surface projection root.")
(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--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 (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--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)))
;; Prefer the window the user is actually interacting with. A
;; buffer may also be visible in an older client frame; choosing
;; that arbitrary window would silently resize a live surface on a
;; later incremental commit.
(window
(or (and (window-live-p (selected-window))
(eq (window-buffer (selected-window)) buffer)
(selected-window))
(get-buffer-window buffer (selected-frame))
(get-buffer-window buffer t)
(and (not noninteractive) (selected-window)))))
(list :viewport-width
(value :viewport-width
(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))
(: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)
"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))
(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))
(stylesheet-signature
(and style-required-p
(if (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow))
nil
(ebox-surface--stylesheet-signature))))
(bindings-by-subject (make-hash-table :test 'eq))
(states-by-subject (make-hash-table :test 'eq))
(subjects (when (and style-required-p
(not (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow
mixed-owner-reflow))))
(ebox-tree-subject-index root)))
(selector-tree-snapshot
(if (memq projection-kind
'(owner-scoped scroll-patch
formatting-context-reflow mixed-owner-reflow))
(plist-get previous-state :selector-tree-snapshot)
(and subjects
(ebox-surface--subject-signature
(plist-get subjects :root-subject)))))
(selector-tree-token
(if (memq projection-kind
'(owner-scoped scroll-patch))
(plist-get previous-state :selector-tree-token)
(and selector-tree-snapshot
(if (and (equal selector-tree-snapshot
(plist-get previous-state
:selector-tree-snapshot))
(plist-get previous-state :selector-tree-token))
(plist-get previous-state :selector-tree-token)
(cons 'ebox/selector-tree nil))))))
(if (memq projection-kind
'(span-patch 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)))
(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--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))))
(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)
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)))
(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)))
(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)))
(if full-surface-p
(tp-surface-retained-content-result-create
context plan rendered owned-ranges state
t)
(tp-surface-result-create-owned context plan state)))))
(defun ebox-surface--mounted-object-for-node (state node-id)
"Return NODE-ID's nearest live retained object with mounts in STATE."
(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)
"Install and return NODE style binding on OBJECT for SUBJECT."
(let* ((parent (ecss-subject-parent subject))
(parent-binding (and parent (gethash parent bindings-by-subject)))
(parent-style-state (and parent (gethash parent states-by-subject)))
(declarations (ebox-style-node-declarations node))
(old-state (gethash object style-state-table))
(old-binding (and old-state (plist-get old-state :binding)))
(old-parent-style
(and old-state
(plist-get old-state :parent-binding)
(tp-binding-last-value
(plist-get old-state :parent-binding))))
(new-parent-style
(and parent-binding (tp-binding-last-value parent-binding)))
(theme-explicit-delta-style
(and old-state old-binding
(eq selector-tree-token
(plist-get old-state :selector-tree-token))
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))
(ebox-style--theme-delta-computed
(tp-binding-last-value old-binding)
(plist-get old-state :declarations)
declarations
old-parent-style
new-parent-style)))
(theme-parent-delta-style
(and old-state old-binding
(equal (plist-get old-state :declarations)
declarations)
(eq selector-tree-token
(plist-get old-state :selector-tree-token))
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))
(ebox-style--theme-parent-delta-computed
(tp-binding-last-value old-binding)
declarations old-parent-style new-parent-style)))
(theme-delta-style
(or theme-explicit-delta-style theme-parent-delta-style))
(theme-parent-delta-p
(and (null theme-explicit-delta-style)
theme-parent-delta-style))
(reused-p
(and old-state
(null theme-delta-style)
(eq selector-tree-token
(plist-get old-state :selector-tree-token))
(equal declarations (plist-get old-state :declarations))
(eq parent-binding (plist-get old-state :parent-binding))
(eq parent-style-state
(plist-get old-state :parent-style-state))
(= (if parent-binding 1 0)
(or (plist-get old-state
:inherited-dependency-count)
-1))
(equal stylesheet-signature
(plist-get old-state :stylesheet-signature))))
(state
(if reused-p
old-state
(let ((new-state
(list :selector-tree-token selector-tree-token
:declarations (copy-tree declarations)
:parent-binding parent-binding
:parent-style-state parent-style-state
:inherited-dependency-count
(if theme-parent-delta-p
1
(if theme-explicit-delta-style
0
(if parent-binding 1 0)))
:stylesheet-signature stylesheet-signature
:subject subject)))
(plist-put
new-state :compute
(let ((captured new-state)
(delta-style theme-delta-style)
(parent-delta-p theme-parent-delta-p)
(last-style (and old-binding
(tp-binding-last-value old-binding)))
(last-parent-style old-parent-style))
(if parent-delta-p
(lambda ()
(let ((parent-style
(and (plist-get captured :parent-binding)
(tp-binding-read
(plist-get captured :parent-binding)))))
(setq last-style
(or
(ebox-style--theme-parent-delta-computed
last-style
(plist-get captured :declarations)
last-parent-style parent-style)
(ebox-style-compute-subject
(plist-get captured :subject)
(plist-get captured :declarations)
parent-style)))
(setq last-parent-style parent-style)
last-style))
(lambda ()
(or delta-style
(ebox-style-compute-subject
(plist-get captured :subject)
(plist-get captured :declarations)
(and (plist-get captured :parent-binding)
(tp-binding-read
(plist-get captured :parent-binding)))))))))
new-state)))
(binding
(tp-bind
object 'ebox/computed-style
(plist-get state :compute))))
(unless reused-p
(plist-put state :binding binding)
(puthash object state style-state-table))
(puthash subject binding bindings-by-subject)
(puthash subject state states-by-subject)
binding))
(defun ebox-surface--apply-node-style
(object node subject-table bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token)
"Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE."
(when-let ((subject (gethash node subject-table)))
(ebox-style-apply-computed
node
(tp-binding-read
(ebox-surface--node-style-binding
object node subject bindings-by-subject states-by-subject
style-state-table
stylesheet-signature selector-tree-token)))))
(defun ebox-surface--static-style-state-p (state &optional seen)
"Return non-nil when STATE's inherited binding closure is static.
The style compute may depend on its parent binding exactly once. Any other
dependency is a dynamic TP source and prevents a local cascade proof."
(let* ((binding (and state (plist-get state :binding)))
(parent-binding (and state (plist-get state :parent-binding)))
(parent-state (and state (plist-get state :parent-style-state)))
(inherited-count
(and state (plist-get state :inherited-dependency-count))))
(and (tp-binding-live-p binding)
(not (memq state seen))
(integerp inherited-count)
(= (tp-binding-dependency-count binding)
inherited-count)
(if parent-binding
(and parent-state
(eq parent-binding (plist-get parent-state :binding))
(ebox-surface--static-style-state-p
parent-state (cons state seen)))
(null parent-state)))))
(defun ebox-surface--cascade-local-owner-proof-p
(state candidate-state dirty-set)
"Return non-nil when DIRTY-SET has a static cascade closure in STATE.
CANDIDATE-STATE supplies the declarative nodes before cascade projection.
Missing binding state, changed declarations or selector metadata, dynamic TP
dependencies, or any malformed index conservatively preserves root planning."
(let ((objects (plist-get state :surface-node-object-table))
(style-states (plist-get state :style-binding-states))
(candidate-nodes (plist-get candidate-state :node-table))
(stylesheet-signature
(let* ((cache ebox-incremental--allocated-slot-proof-cache)
(missing (make-symbol "ebox-stylesheet-proof-missing"))
(cached (and cache
(gethash 'stylesheet-signature cache missing))))
(if (and cached (not (eq cached missing)))
cached
(let ((signature (ebox-surface--stylesheet-signature)))
(when cache
(puthash 'stylesheet-signature signature cache))
signature)))))
(and (hash-table-p objects)
(hash-table-p style-states)
(hash-table-p candidate-nodes)
dirty-set
(cl-every
(lambda (entry)
(if (eq (plist-get entry :dirty-kind) 'paint)
t
(let* ((node-id (plist-get entry :node-id))
(object (and node-id (gethash node-id objects)))
(style-state (and object (gethash object style-states)))
(candidate-node (and node-id
(gethash node-id candidate-nodes)))
(subject (and style-state
(plist-get style-state :subject))))
(and style-state candidate-node subject
(or (equal (ebox-style-node-declarations candidate-node)
(plist-get style-state :declarations))
(ebox-style--paint-declarations-equivalent-p
(plist-get style-state :declarations)
(ebox-style-node-declarations candidate-node)))
(equal (ebox-tree-node-id candidate-node)
(ecss-subject-id subject))
(equal (ebox-tree-node-classes candidate-node)
(ecss-subject-classes subject))
(equal (ebox-tree-metadata-string
(ebox-tree-node-selector-type candidate-node))
(ecss-subject-type subject))
(equal (mapcar
(lambda (attribute)
(cons (substring (symbol-name (car attribute)) 1)
(cdr attribute)))
(ebox-tree-node-attributes candidate-node))
(ecss-subject-attributes subject))
(equal (ebox-tree-node-state candidate-node)
(ecss-subject-states subject))
(equal stylesheet-signature
(plist-get style-state :stylesheet-signature))
(ebox-surface--static-style-state-p style-state)))))
dirty-set))))
(defun ebox-surface--ensure-node-tree
(context parent node table subject-table bindings-by-subject
states-by-subject style-state-table stylesheet-signature
selector-tree-token)
"Ensure styled NODE descendants below PARENT in CONTEXT and fill TABLE."
(let ((object
(tp-object-ensure context parent
(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))
(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))
(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)
(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)))
(let ((rendered
(let ((ebox--surface-materialization-active t))
(ebox--render-layout node))))
(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)
state))
(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)
"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
(ebox-surface--render-candidate-node state render-node))
(owned-rendered
(if role-owned-lines-p
(ebox-buffer--rendered-owned-lines
rendered (plist-get old-snapshot :region-ids)
(length spans))
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)))
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))))
(dolist (candidate candidates)
(ebox-surface--install-span-patch-snapshot
state (plist-get candidate :owner-id)
(plist-get candidate :snapshot)
(cdr (assq candidate rebased))
shared-generation))
output)))))))
(defun ebox-surface--formatting-context-reflow-lines
(start rendered)
"Return absolute whole-line spans for RENDERED beginning at START."
(let ((offset start)
spans)
(dolist (line (ebox-string-lines rendered)
(nreverse spans))
(let ((end (+ offset (length line))))
(push (cons offset end) spans)
(setq offset (1+ end))))))
(defun ebox-surface--formatting-context-reflow-output (buffer state)
"Return full BUFFER text with one variable-line context replaced, or nil.
The proof owns a complete block of whole lines. Only that block is rendered
again; the surrounding buffer and retained node/object identities remain
untouched."
(let* ((proof (or (plist-get state :formatting-context-reflow-proof)
(plist-get (plist-get state :mixed-owner-proof)
:geometry-proof)))
(owner-id (and proof (plist-get proof :owner-id)))
(snapshot (and proof (plist-get proof :snapshot)))
(old-spans (and proof (plist-get proof :old-spans)))
(node (and owner-id
(gethash owner-id (plist-get state :node-table))))
(allocated-width (and proof
(plist-get proof :allocated-width))))
(when (and proof snapshot old-spans node
(ebox--spans-contiguous-lines-p old-spans)
(with-current-buffer buffer
(ebox--line-spans-cover-whole-lines-p old-spans)))
(let* ((rendered (ebox-surface--render-candidate-node state node))
(new-footprint
(ebox--rendered-span-footprint-signature rendered))
(new-max (plist-get (ebox--external-footprint-signature-from-span-footprint
new-footprint)
:max-line-pixel-width))
(new-roles
(ebox-surface--rendered-role-topology-signature
rendered (plist-get snapshot :region-ids)))
(old-roles (plist-get snapshot :role-topology-signature))
(new-overflow (ebox--overflow-signature node))
(old-block-span (plist-get proof :old-block-span))
(block-start
(and old-block-span
(max 0
(1- (car old-block-span)))))
;; Mount positions are buffer positions (one-based, exclusive
;; end); the output string is zero-based, so both boundaries
;; need the same conversion before splicing.
(block-end
(and old-block-span
(1- (cdr old-block-span))))
(old-block-text
(and (integerp block-start)
(integerp block-end)
(with-current-buffer buffer
(buffer-substring (1+ block-start)
(1+ block-end)))))
;; The material context sits between two column line breaks.
;; They belong to the context's retained scope even though the
;; local node renderer quite correctly emits only its content.
(leading-newline-p
(and old-block-text
(> (length old-block-text) 0)
(= (aref old-block-text 0) ?\n)))
(trailing-newline-p
(and old-block-text
(> (length old-block-text) 0)
(= (aref old-block-text (1- (length old-block-text)))
?\n)))
(context-rendered
(concat (if leading-newline-p "\n" "")
rendered
(if trailing-newline-p "\n" "")))
(content-start (+ block-start (if leading-newline-p 1 0)))
(new-spans
(ebox-surface--formatting-context-reflow-lines
content-start rendered)))
(when (and (integerp block-start)
(integerp block-end)
(> block-end block-start)
(> (length context-rendered) 0)
new-spans
(or (null allocated-width)
(null new-max)
(<= new-max allocated-width))
(equal old-roles new-roles)
(equal (plist-get snapshot :overflow-signature)
new-overflow))
(with-current-buffer buffer
(save-restriction
(widen)
(let* ((source (buffer-substring (point-min) (point-max)))
(output
(concat (substring source 0 block-start)
context-rendered
(substring source block-end)))
(generation
(1+ (or (plist-get state
:layout-snapshot-detail-generation)
0)))
(updated (copy-sequence snapshot))
(new-external
(ebox--external-footprint-signature-from-span-footprint
new-footprint)))
(dolist (entry `((:buffer-span . ,(car new-spans))
(:buffer-spans . ,new-spans)
(:line-signature
. ,(plist-get new-footprint
:line-pixel-widths))
(:span-footprint-signature . ,new-footprint)
(:external-footprint-signature
. ,new-external)
(:role-topology-signature . ,new-roles)
(:overflow-signature . ,new-overflow)
(:detail-generation . ,generation)))
(setq updated
(plist-put updated (car entry) (cdr entry))))
(puthash owner-id updated (plist-get state :layout-snapshots))
(plist-put state :layout-snapshot-detail-generation generation)
(plist-put state :layout-snapshots-complete-p nil)
(plist-put state :formatting-context-reflow-new-spans new-spans)
(plist-put state :formatting-context-reflow-new-length
(length context-rendered))
output))))))))
(defun ebox-surface--mixed-owner-output (buffer previous-state state)
"Return one geometry-plus-paint candidate output, or nil on proof miss.
The geometry context is rendered by the existing whole-line proof. Paint
owners are then recomposed from the committed semantic fragment ledger, never
by peeling an already-composed face suffix. Any missing address/baseline
causes the caller to use the ordinary full projection."
(let* ((proof (plist-get state :mixed-owner-proof))
(geometry-proof (and proof (plist-get proof :geometry-proof)))
(geometry-kind (and proof (plist-get proof :geometry-kind)))
(paint-owner-ids (and proof (plist-get proof :paint-owner-ids)))
(output
(when geometry-proof
(if (eq geometry-kind 'span-patch)
(ebox-surface--span-patch-output buffer state)
(plist-put state :render-cache (make-hash-table :test 'equal))
(plist-put state :render-signature-cache
(make-hash-table :test 'eq))
(let ((ebox--box-content-render-cache
(make-hash-table :test 'eq)))
(ebox-surface--formatting-context-reflow-output
buffer state)))))
(old-fragments (plist-get previous-state :surface-fragments))
(old-text
(and (buffer-live-p buffer)
(with-current-buffer buffer
(save-restriction
(widen)
(buffer-substring (point-min) (point-max))))))
(old-by-address (make-hash-table :test #'equal))
(old-by-local-address (make-hash-table :test #'equal)))
(when (and output old-fragments paint-owner-ids)
(dolist (fragment old-fragments)
(when-let ((address (plist-get fragment :paint-address)))
(puthash address fragment old-by-address)
(let* ((roles (plist-get fragment :paint-role-ids))
(owner (cdr (assq 'content roles)))
(key (and owner
(list owner
(plist-get address :content-index)
(plist-get address :ordinal)))))
(when key
(puthash key
(cons fragment (gethash key old-by-local-address))
old-by-local-address)))))
(let ((new-fragments (ebox-surface--rendered-fragments output)))
(catch 'mixed-owner-proof-miss
(let ((old-face-cache (make-hash-table :test #'equal))
(new-face-cache (make-hash-table :test #'equal))
pieces)
(dolist (fragment new-fragments)
(let* ((start (plist-get fragment :start))
(end (plist-get fragment :end))
(text (substring output start end))
(copy (copy-tree fragment))
(address (plist-get fragment :paint-address))
(roles (plist-get fragment :paint-role-ids))
(owner (cdr (assq 'content roles)))
(local-key
(and owner
(list owner
(plist-get address :content-index)
(plist-get address :ordinal))))
(matches (and local-key
(gethash local-key old-by-local-address)))
(old-fragment
(or (and address (gethash address old-by-address))
(and (= (length matches) 1) (car matches))))
(old-fragment-text
(and old-text old-fragment
(integerp (plist-get old-fragment :start))
(integerp (plist-get old-fragment :end))
(substring old-text
(plist-get old-fragment :start)
(plist-get old-fragment :end))))
(affected-p
(cl-some (lambda (entry)
(memq (cdr entry) paint-owner-ids))
roles)))
(plist-put copy :text text)
(plist-put copy :start 0)
(plist-put copy :end (length text))
(cl-remf copy :text-source-p)
(when affected-p
(unless (and address old-fragment
(or (plist-get old-fragment
:face-baseline-known-p)
(plist-get copy
:face-baseline-known-p)))
(throw 'mixed-owner-proof-miss nil))
(when (plist-get old-fragment :face-baseline-known-p)
(plist-put copy :face-baseline
(copy-tree
(plist-get old-fragment :face-baseline)))
(plist-put copy :face-baseline-known-p t)))
(plist-put copy :old-paint-role-ids
(copy-tree (or (and old-fragment
(plist-get old-fragment
:paint-role-ids))
roles)))
;; Geometry reflow still produces a complete candidate text,
;; but an unaffected fragment whose text/properties are
;; byte-for-byte identical and whose semantic face
;; contributions are unchanged already has the correct
;; composed face. Reuse its candidate metadata without
;; rebuilding it; changed/paint-owned fragments retain the
;; existing baseline-safe repaint path.
(let* ((old-roles (plist-get copy :old-paint-role-ids))
(new-roles (plist-get copy :paint-role-ids))
(reusable-p
(and old-fragment
(not affected-p)
old-fragment-text
(equal-including-properties
old-fragment-text text)
(equal old-roles new-roles)
(let ((old-faces
(or (gethash old-roles old-face-cache)
(let ((value
(ebox-surface--face-contributions
previous-state old-roles)))
(puthash old-roles value old-face-cache)
value)))
(new-faces
(or (gethash new-roles new-face-cache)
(let ((value
(ebox-surface--face-contributions
state new-roles)))
(puthash new-roles value new-face-cache)
value))))
(equal old-faces new-faces)))))
(push (if reusable-p
(progn
(cl-remf copy :old-paint-role-ids)
copy)
(ebox-surface--repaint-fragment
copy previous-state state
old-face-cache new-face-cache))
pieces))))
(let* ((fragments (nreverse pieces))
(rendered
(apply #'concat
(mapcar (lambda (fragment)
(plist-get fragment :text))
fragments)))
(offset 0))
(dolist (fragment fragments)
(let ((length (length (plist-get fragment :text))))
(plist-put fragment :start offset)
(plist-put fragment :end (+ offset length))
(setq offset (+ offset length))))
(plist-put state :mixed-owner-fragment-data fragments)
(plist-put state :mixed-owner-content-p t)
rendered)))))))
(defun ebox-surface--scroll-patch-output (_buffer state)
"Return a staged visible scroll window without rerunning layout when safe.
Chrome-free top-aligned root scroll boxes already store fully propertized
rendered lines. Join only the visible slice and add the scroll marker; any
box with wrapper chrome falls back to the retained wrapper renderer."
(let* ((region-id (plist-get state :scroll-patch-region-id))
(scroll-table (plist-get state :scroll-state-table))
(scroll-state (and region-id scroll-table
(gethash region-id scroll-table)))
(root (plist-get state :root-node))
(root-id (and root (plist-get root :node-id)))
(owner-id (plist-get state :span-patch-owner-id))
(cached-box (and scroll-state (plist-get scroll-state :box))))
(when (and scroll-state root owner-id root-id
(= owner-id root-id)
cached-box
(equal (plist-get cached-box :node-id) root-id))
(let* ((chrome-free-p
(and (= (or (ebox-get cached-box :padding-left-pixel) 0) 0)
(= (or (ebox-get cached-box :padding-right-pixel) 0) 0)
(= (or (ebox-get cached-box :padding-top-height) 0) 0)
(= (or (ebox-get cached-box :padding-bottom-height) 0) 0)
(= (or (ebox-get cached-box :margin-left-pixel) 0) 0)
(= (or (ebox-get cached-box :margin-right-pixel) 0) 0)
(= (or (ebox-get cached-box :margin-top-height) 0) 0)
(= (or (ebox-get cached-box :margin-bottom-height) 0) 0)
(= (or (ebox-get cached-box :border-left-pixel) 0) 0)
(= (or (ebox-get cached-box :border-right-pixel) 0) 0)
(not (ebox-get cached-box :border-top-p))
(not (ebox-get cached-box :border-bottom-p))
(eq (ebox-get cached-box :vertical-align) 'top)
(null (ebox-get cached-box :surface-properties))))
(visible
(and chrome-free-p
(ebox--scroll-state-retained-window-ready-p
scroll-state))))
(if (and visible (cadr visible))
(let* ((lines (cadr visible))
(output (ebox-lines-join lines))
(fragment-data
(ebox-surface--scroll-fragment-data lines output)))
(when (and fragment-data
(plist-get state :retained-scroll-content-p))
(plist-put state :scroll-patch-fragment-data fragment-data))
(when (> (length output) 0)
(add-text-properties
0 (length output)
(list 'ebox-scroll-window region-id)
output))
output)
(let ((ebox--scroll-window-cached-state scroll-state)
(ebox--scroll-window-skip-state-rebuild-p
(plist-get scroll-state :content-lines-complete-p)))
(ebox-surface--render-candidate-node state root)))))))
(defun ebox-surface--native-scroll-full-output (state)
"Return the complete propertized root scroll output for native scrolling."
(let* ((region-id (plist-get state :scroll-patch-region-id))
(table (plist-get state :scroll-state-table))
(scroll-state (and region-id table (gethash region-id table)))
(lines (and scroll-state
(plist-get scroll-state :rendered-content-lines))))
(when (and lines
(plist-get scroll-state :content-lines-complete-p))
(let ((output (ebox-lines-join lines)))
(when (> (length output) 0)
(add-text-properties
0 (length output) (list 'ebox-scroll-window region-id) output))
output))))
(defun ebox-surface--runtime-index-ready-p (state)
"Return non-nil when STATE carries a complete prepared runtime index."
(let* ((root (plist-get state :root-node))
(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)))
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--fragment-metadata (fragments)
"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."
(let ((offset 0)
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)))
(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)))))))
(when attach-p
(tp-object-attach-content-ranges-owned context leaf (nreverse ranges)))
ranges))
(defun ebox-surface--formatting-context-reflow-owned-ranges
(context leaf ranges state node-objects)
"Replace inferred owner ranges for the reflow context with one block range.
Ancestor-output role propagation can otherwise make a variable-line context
claim the first property run of the following sibling. The proof already
owns the complete old block, so its candidate scope is the exact new block;
all descendant ranges remain unchanged."
(let* ((proof (plist-get state :formatting-context-reflow-proof))
(owner-id (plist-get proof :owner-id))
(owner (and owner-id (gethash owner-id node-objects)))
(node (and owner-id (gethash owner-id (plist-get state :node-table))))
(region-id (and node (plist-get node :region-id)))
(block-start
(max 0
(1- (car (plist-get proof :old-block-span)))))
(block-end (+ block-start
(or (plist-get state
:formatting-context-reflow-new-length)
0)))
(filtered
(cl-remove-if (lambda (range)
(eq (plist-get range :object) owner))
ranges)))
(when (and owner region-id (integerp block-start) (> block-end block-start))
(push (list :object owner :start block-start :end block-end
:tags (list :ebox/region-id region-id
:ebox/roles '(content-owner content)))
filtered))
(setq filtered (nreverse filtered))
(tp-object-attach-content-ranges-owned context leaf filtered)
filtered))
(defun ebox-surface--surface-plan
(context surface-root output state node-objects region-objects
&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 (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))))
(owned-ranges
(ebox-surface--owned-ranges
context text-leaf fragment-data state node-objects region-objects
(and attach-p
(not (eq (plist-get state :projection-kind)
'formatting-context-reflow))
(not (and (eq (plist-get state :projection-kind)
'mixed-owner-reflow)
(eq (plist-get
(plist-get state :mixed-owner-proof)
:geometry-kind)
'formatting-context-reflow)))))))
(when (or (eq (plist-get state :projection-kind)
'formatting-context-reflow)
(and (eq (plist-get state :projection-kind)
'mixed-owner-reflow)
(eq (plist-get (plist-get state :mixed-owner-proof)
:geometry-kind)
'formatting-context-reflow)))
(setq owned-ranges
(ebox-surface--formatting-context-reflow-owned-ranges
context text-leaf owned-ranges state node-objects)))
(let* ((plan-text
(if (or transfer-text-p
(plist-get state :mixed-owner-content-p))
;; Scroll output is a fresh renderer-owned string. The TP
;; owned-result path copies the string spine once while
;; rendering the plan; recursively snapshotting every
;; property value here duplicated the hot scroll work.
rendered
(ebox-surface--candidate-plan-text
rendered (plist-get state :render-owned-text-values))))
(plan
(tp-surface-plan-create-owned
:key ebox-surface--root-key :kind 'ebox/surface
: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
(ebox-surface--fragment-metadata fragment-data))
(cl-remf state :mixed-owner-fragment-data)
(cl-remf state :mixed-owner-content-p)
(let ((rendered-length (length rendered)))
(list plan rendered 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 ((parents (plist-get state :parent-table)) (depth 0))
(while (setq node-id (and node-id (gethash node-id parents)))
(cl-incf depth))
depth))
(defun ebox-surface--paint-node-chain (state role-ids)
"Return the deepest rendered node and its ancestors for ROLE-IDS."
(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)))
(nreverse 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))
(defun ebox-surface--face-contributions (state role-ids)
"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)))
(setq result
(append
result
(ebox-surface--region-face-contributions
box
(cl-loop for (role . owner) in role-ids
when (equal owner region-id) collect role)
(not first))))
(setq first nil))))
result))
(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--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
(or (and old-face-cache (gethash old-roles old-face-cache))
(let ((value (ebox-surface--face-contributions
old-state old-roles)))
(when old-face-cache
(puthash old-roles value old-face-cache))
value)))
(new-faces
(or (and new-face-cache (gethash new-roles new-face-cache))
(let ((value (ebox-surface--face-contributions
new-state new-roles)))
(when new-face-cache
(puthash new-roles value new-face-cache))
value)))
(baseline (and (> (length text) 0)
(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))
(plist-get old-state :surface-fragments))))
(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--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 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
(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
(ebox-surface--projection-start
context root style-required-p projection-kind previous-state)))
(unless (or source-isolated-p source-path-copied-p)
(ebox-surface--reconcile-candidate root previous-state))
(let* ((axes
(and signals
(if scroll-fast-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)))
(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)
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