4822 lines
232 KiB
EmacsLisp
4822 lines
232 KiB
EmacsLisp
;;; ebox-surface.el --- Retained projection and publication -*- lexical-binding: t; -*-
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; Owns the boundary from an Ebox candidate runtime to a generic TP surface
|
|
;; plan, and the atomic publication participant that mirrors the committed TP
|
|
;; generation into Ebox's buffer-local runtime indexes.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'seq)
|
|
(require 'ebox-buffer-backend)
|
|
(require 'ebox-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-root-parent-kind)
|
|
(defvar ebox--render-cache-table)
|
|
(defvar ebox--render-cache-signature-cache)
|
|
(defvar ebox--layout-fragments-table)
|
|
(defvar ebox--layout-fragments-reuse-p)
|
|
(defvar ebox--flex-content-min-width-table)
|
|
(defvar ebox--scroll-window-initial-lookahead-lines-override)
|
|
(defvar ebox-viewport-width)
|
|
(defvar ebox-viewport-height)
|
|
(defvar ebox--render-display-signature)
|
|
(defvar ebox-incremental--allocated-slot-proof-cache)
|
|
(defvar ebox-incremental--buffer-render-state-override)
|
|
|
|
(defvar ebox-surface--inline-style-value-cache nil
|
|
"Per-projection cache for selector-free computed inline styles.")
|
|
|
|
(defun ebox-surface--mixed-range-splice-p (state)
|
|
"Return non-nil when STATE's mixed proof contains one Range splice."
|
|
(cl-some
|
|
(lambda (owner-proof)
|
|
(plist-get owner-proof :range-splice-p))
|
|
(plist-get
|
|
(plist-get (plist-get state :mixed-owner-proof) :geometry-proof)
|
|
:owner-proofs)))
|
|
|
|
(declare-function ebox--render-layout "ebox-layout" (node))
|
|
(declare-function ebox--maplines "ebox" (function string))
|
|
(declare-function ebox--ensure-node-id "ebox" (node))
|
|
(declare-function ebox-native-commit-render
|
|
"ebox-native-commit" (state node))
|
|
(declare-function ebox-native-reflow-frame-fragments
|
|
"ebox-native-reflow" (frame))
|
|
(declare-function ebox-native-reflow-layout-ready-p
|
|
"ebox-native-reflow" ())
|
|
(declare-function ebox-native-reflow-release-session
|
|
"ebox-native-reflow" (session))
|
|
(declare-function ebox-native-commit-projection-eligible-p
|
|
"ebox-native-commit"
|
|
(previous-state state-overrides stylesheet-active-p))
|
|
|
|
(defun ebox-surface--release-native-session (session)
|
|
"Release native SESSION when it is present."
|
|
(when (and session (require 'ebox-native-reflow nil t))
|
|
(ebox-native-reflow-release-session session)))
|
|
|
|
(defun ebox-surface--settle-native-session
|
|
(old-state state-overrides surface committed-p)
|
|
"Retire the losing native session after one candidate publication.
|
|
OLD-STATE owns the committed session before publication. STATE-OVERRIDES
|
|
owns the isolated candidate. When COMMITTED-P is non-nil, SURFACE identifies
|
|
the winning client state; otherwise only the candidate is disposable."
|
|
(let ((old-session (plist-get old-state :native-sync-session))
|
|
(candidate-session
|
|
(plist-get state-overrides :native-sync-session))
|
|
(committed-session
|
|
(and committed-p surface
|
|
(plist-get (tp-surface-client-state surface)
|
|
:native-sync-session))))
|
|
(if committed-p
|
|
(dolist (session
|
|
(delete-dups (delq nil (list old-session candidate-session))))
|
|
(unless (eq session committed-session)
|
|
(ebox-surface--release-native-session session)))
|
|
(when (and candidate-session
|
|
(not (eq candidate-session old-session)))
|
|
(ebox-surface--release-native-session candidate-session)))))
|
|
(declare-function tp-object-reuse "tp-surface" (context object))
|
|
(declare-function tp-object-ensure-at
|
|
"tp-surface" (context parent key kind position))
|
|
(declare-function tp-bind-precomputed
|
|
"tp-reactive"
|
|
(owner key compute value dependencies &rest options))
|
|
(declare-function ebox--record-render-output-provenance
|
|
"ebox-render-context" (rendered))
|
|
(declare-function ebox--render-owned-text-value-p
|
|
"ebox-render-context" (property value &optional registry))
|
|
(declare-function ebox-incremental--hash-snapshot
|
|
"ebox-incremental" (table keys))
|
|
(declare-function ebox-incremental--restore-hash-snapshot
|
|
"ebox-incremental" (table entries))
|
|
(declare-function ebox-incremental--replace-hash-entries
|
|
"ebox-incremental" (target keys source))
|
|
(declare-function ebox--runtime-region-id-conflict
|
|
"ebox-incremental" (region-id-set target-buffer))
|
|
(declare-function ebox--region-id-set
|
|
"ebox-incremental" (region-ids))
|
|
(declare-function ebox--flex-item-slot-sized-node
|
|
"ebox-incremental"
|
|
(buffer node-id snapshot &optional changed-keys))
|
|
(declare-function ebox--layout-snapshot-strip-details
|
|
"ebox-incremental" (snapshot))
|
|
(declare-function ebox--viewport-dependent-node-id-axes
|
|
"ebox-incremental" (node))
|
|
(declare-function ebox--update-report
|
|
"ebox-incremental" (region-id strategy &rest props))
|
|
(declare-function ebox-incremental--finalize-declarative-scroll-publication
|
|
"ebox-incremental" (scroll-keys &optional prefetch-delay))
|
|
(declare-function ebox--scroll-schedule-idle-prefetch
|
|
"ebox" (region-id &optional delay))
|
|
(declare-function ebox--scroll-clear-state "ebox" (region-id))
|
|
(declare-function ebox--smooth-scroll-stop "ebox" (region-id))
|
|
(declare-function ebox-put "ebox" (box property value))
|
|
(declare-function ebox-get "ebox" (box property))
|
|
(declare-function ebox-string-lines "ebox" (string))
|
|
(declare-function ebox-lines-join "ebox" (lines))
|
|
(declare-function ebox--scroll-state-rendered-visible-window
|
|
"ebox" (state))
|
|
(declare-function ebox--scroll-state-retained-window-ready-p
|
|
"ebox" (state))
|
|
(declare-function ebox--scroll-box-contains-grid-p
|
|
"ebox" (box))
|
|
(declare-function ebox--scroll-line-region-span
|
|
"ebox" (line region-set))
|
|
(declare-function ebox-buffer--span-slot-width
|
|
"ebox-buffer-backend" (span))
|
|
(declare-function ebox-pixel-space "ebox" (pixel-width))
|
|
(declare-function tp-object-mounted-p "tp-surface" (object))
|
|
(declare-function tp-object-attach-content-ranges-owned
|
|
"tp-surface" (context leaf ranges))
|
|
(declare-function tp-text-snapshot
|
|
"tp-core" (text &optional reuse-property-p))
|
|
(declare-function tp-surface-plan-create-owned
|
|
"tp-surface" (&rest arguments))
|
|
(declare-function tp-surface-result-create-owned
|
|
"tp-surface" (context plan &optional client-state))
|
|
(declare-function tp-surface-retained-content-result-create
|
|
"tp-surface"
|
|
(context plan rendered ranges &optional client-state
|
|
full-surface-p property-contributions))
|
|
(declare-function tp-surface-report-summary "tp-surface" (surface))
|
|
|
|
(defvar-local ebox-surface--buffer-surface nil
|
|
"Live TP content surface mounted for the current Ebox buffer.")
|
|
|
|
(cl-defstruct (ebox-surface--signals
|
|
(:constructor ebox-surface--make-signals))
|
|
"TP signals carrying one mounted Ebox surface's host context."
|
|
buffer viewport-width viewport-height display scroll)
|
|
|
|
(cl-defstruct (ebox-surface--framework-participant
|
|
(:constructor ebox-surface--make-framework-participant))
|
|
"One Ebox-owned framework publication participant."
|
|
publish rollback state report diagnostics runtime-state scroll-keys
|
|
scroll-diagnostics)
|
|
|
|
(defvar-local ebox-surface--context-signals nil
|
|
"Buffer-scoped TP signals consumed by the mounted Ebox producer.")
|
|
|
|
(defvar ebox-surface--scroll-line-fragment-cache
|
|
(make-hash-table :test #'eq :weakness 'key)
|
|
"Cached property-run templates for immutable rendered scroll lines.")
|
|
|
|
(defun ebox-surface--scroll-line-fragment-template (line)
|
|
"Return a reusable fragment template for rendered LINE, or nil.
|
|
The cache is keyed by the immutable line string object retained by scroll
|
|
state. Lines whose ownership is only implied through a neighboring line are
|
|
left on the conservative full fragment scanner path."
|
|
(or (gethash line ebox-surface--scroll-line-fragment-cache)
|
|
(let ((fragments (ebox-surface--rendered-fragments line)))
|
|
(when (and fragments
|
|
(cl-every (lambda (fragment)
|
|
(plist-get fragment :role-ids))
|
|
fragments))
|
|
(puthash line fragments ebox-surface--scroll-line-fragment-cache)
|
|
fragments))))
|
|
|
|
(defun ebox-surface--scroll-fragment-data (lines rendered)
|
|
"Return offset fragments for visible LINES in RENDERED, or nil.
|
|
Each cached line template is copied only at the plist spine and points at the
|
|
single joined RENDERED string. The text and role values remain candidate
|
|
owned; no per-fragment substring is allocated."
|
|
(cl-block ebox-surface--scroll-fragment-data
|
|
(let ((offset 0)
|
|
(line-index 0)
|
|
result)
|
|
(dolist (line lines)
|
|
(let ((template (ebox-surface--scroll-line-fragment-template line)))
|
|
(unless template
|
|
(cl-return-from ebox-surface--scroll-fragment-data nil))
|
|
(dolist (fragment template)
|
|
(let ((copy (copy-sequence fragment)))
|
|
(plist-put copy :text rendered)
|
|
(plist-put copy :start (+ offset (plist-get fragment :start)))
|
|
(plist-put copy :end (+ offset (plist-get fragment :end)))
|
|
(plist-put copy :line line-index)
|
|
(push copy result))))
|
|
(setq offset (+ offset (length line) 1))
|
|
(setq line-index (1+ line-index)))
|
|
(nreverse result))))
|
|
|
|
(defun ebox-surface--style-state-table (previous-state)
|
|
"Copy retained style state from PREVIOUS-STATE into a weak table."
|
|
(let ((table (make-hash-table :test 'eq :weakness 'key)))
|
|
(when-let* ((previous (plist-get previous-state :style-binding-states)))
|
|
(maphash (lambda (object state) (puthash object state table)) previous))
|
|
table))
|
|
|
|
(defun ebox-surface--stylesheet-signature ()
|
|
"Return one immutable snapshot of the active Ebox stylesheet."
|
|
(list (ecss-stylesheet-rules ebox-style-stylesheet)
|
|
(ecss-stylesheet-layers ebox-style-stylesheet)))
|
|
|
|
(defun ebox-surface--subject-signature (subject)
|
|
"Return SUBJECT's complete selector subtree without retaining parent cycles."
|
|
(cl-labels
|
|
((subtree (node)
|
|
(list (ecss-subject-type node) (ecss-subject-id node)
|
|
(ecss-subject-classes node)
|
|
(ecss-subject-attributes node)
|
|
(ecss-subject-states node)
|
|
(mapcar #'subtree (ecss-subject-children node)))))
|
|
(subtree subject)))
|
|
|
|
(defun ebox-surface--subject-local-equal-p (left right)
|
|
"Return non-nil when LEFT and RIGHT expose equal local selector fields."
|
|
(and left right
|
|
(equal (ecss-subject-type left) (ecss-subject-type right))
|
|
(equal (ecss-subject-id left) (ecss-subject-id right))
|
|
(equal (ecss-subject-classes left) (ecss-subject-classes right))
|
|
(equal (ecss-subject-attributes left)
|
|
(ecss-subject-attributes right))
|
|
(equal (ecss-subject-states left) (ecss-subject-states right))))
|
|
|
|
(defun ebox-surface--stylesheet-subject-local-p (stylesheet-signature)
|
|
"Return non-nil when STYLESHEET-SIGNATURE has only local selector rules.
|
|
Scoped rules remain tree-dependent because scope distance reads ancestors."
|
|
(cl-every
|
|
(lambda (rule)
|
|
(and (null (ecss-rule-scope rule))
|
|
(ecss-selector-subject-local-p (ecss-rule-selector rule))))
|
|
(car stylesheet-signature)))
|
|
|
|
(defconst ebox-surface--root-key 'ebox/surface
|
|
"Stable TP key for an Ebox surface projection root.")
|
|
|
|
(defconst ebox-surface--nodes-key 'ebox/nodes
|
|
"Stable TP key for the retained logical Ebox node tree.")
|
|
|
|
(defconst ebox-surface--fragments-key 'ebox/fragments
|
|
"Stable TP key for linear rendered fragments.")
|
|
|
|
(defconst ebox-surface--text-key 'ebox/text
|
|
"Stable TP key for the shared rendered text leaf.")
|
|
|
|
(defconst ebox-surface--inherited-style-properties
|
|
ebox-style--inherited-properties
|
|
"ECSS properties whose inline values can flow to descendants.")
|
|
|
|
(defun ebox-surface--style-consuming-node-p (node)
|
|
"Return non-nil when NODE owns a paintable style surface."
|
|
(and (eq (plist-get node :ebox-type) 'box)
|
|
(not (eq (plist-get node :ebox-kind) 'text))))
|
|
|
|
(defun ebox-surface--inherited-style-consumer-p (node)
|
|
"Return non-nil when NODE materializes inherited text style.
|
|
Canonical Box passes inherited facts through to descendants; canonical Text
|
|
is their final paint/typography owner. A legacy Box without a canonical kind
|
|
continues to own its inline text directly."
|
|
(and (eq (plist-get node :ebox-type) 'box)
|
|
(or (eq (plist-get node :ebox-kind) 'text)
|
|
(null (plist-get node :ebox-kind)))))
|
|
|
|
(defun ebox-surface--inline-inheritance-required-p (root)
|
|
"Return non-nil when inline styles in ROOT require an ECSS cascade.
|
|
An empty stylesheet still needs a cascade when an inherited declaration can
|
|
reach a descendant that does not declare the same property. Other inline
|
|
declarations are already projected into the candidate engine fields at node
|
|
construction time and can use the static projection path."
|
|
(let ((pending (list (cons root nil)))
|
|
required)
|
|
(while (and pending (not required))
|
|
(let* ((entry (pop pending))
|
|
(node (car entry))
|
|
(inherited (cdr entry))
|
|
(declarations (ebox-style-node-declarations node)))
|
|
(when (cl-some (lambda (property)
|
|
(and (ebox-surface--inherited-style-consumer-p node)
|
|
(memq property inherited)
|
|
(not (plist-member declarations property))))
|
|
ebox-surface--inherited-style-properties)
|
|
(setq required t))
|
|
(unless required
|
|
(let ((next (copy-sequence inherited)))
|
|
(dolist (property ebox-surface--inherited-style-properties)
|
|
(when (plist-member declarations property)
|
|
(cl-pushnew property next)))
|
|
(ebox-tree-for-each-direct-child
|
|
node (lambda (child) (push (cons child next) pending)))))))
|
|
required))
|
|
|
|
(defun ebox-surface--signals-live-p (signals)
|
|
"Return non-nil when every signal in SIGNALS is live."
|
|
(and (ebox-surface--signals-p signals)
|
|
(buffer-live-p (ebox-surface--signals-buffer signals))
|
|
(cl-every
|
|
#'tp-signal-live-p
|
|
(list (ebox-surface--signals-viewport-width signals)
|
|
(ebox-surface--signals-viewport-height signals)
|
|
(ebox-surface--signals-display signals)
|
|
(ebox-surface--signals-scroll signals)))))
|
|
|
|
(defun ebox-surface--dispose-signals (signals)
|
|
"Dispose live TP SIGNALS owned by an abandoned Ebox mount."
|
|
(when (ebox-surface--signals-p signals)
|
|
(dolist (signal
|
|
(list (ebox-surface--signals-viewport-width signals)
|
|
(ebox-surface--signals-viewport-height signals)
|
|
(ebox-surface--signals-display signals)
|
|
(ebox-surface--signals-scroll signals)))
|
|
(when (tp-signal-live-p signal)
|
|
(tp-signal-dispose signal)))
|
|
(when-let* ((buffer (ebox-surface--signals-buffer signals)))
|
|
(when (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(when (eq ebox-surface--context-signals signals)
|
|
(setq-local ebox-surface--context-signals nil)))))))
|
|
|
|
(defun ebox-surface--scroll-offsets (table)
|
|
"Return immutable sorted scroll offsets copied from TABLE."
|
|
(let (offsets)
|
|
(when (hash-table-p table)
|
|
(maphash
|
|
(lambda (region-id state)
|
|
(push (cons region-id (or (plist-get state :scroll-offset) 0))
|
|
offsets))
|
|
table))
|
|
(sort offsets (lambda (left right) (< (car left) (car right))))))
|
|
|
|
(defun ebox-surface--buffer-display-window (buffer)
|
|
"Return the canonical live display window for BUFFER.
|
|
Prefer the window the user is interacting with, then the selected frame, then
|
|
another visible frame. One mounted surface owns one viewport, so all context
|
|
and resize paths must consume this same choice."
|
|
(or (and (window-live-p (selected-window))
|
|
(eq (window-buffer (selected-window)) buffer)
|
|
(selected-window))
|
|
(get-buffer-window buffer (selected-frame))
|
|
(get-buffer-window buffer t)
|
|
(and (not noninteractive) (selected-window))))
|
|
|
|
(defun ebox-surface--context-values
|
|
(buffer old-state state-overrides)
|
|
"Return BUFFER context values after OLD-STATE and STATE-OVERRIDES."
|
|
(cl-labels
|
|
((value (key fallback)
|
|
(if (plist-member state-overrides key)
|
|
(plist-get state-overrides key)
|
|
(if (plist-member old-state key)
|
|
(plist-get old-state key)
|
|
fallback))))
|
|
(let ((scroll-table
|
|
(value :scroll-state-table
|
|
(plist-get old-state :scroll-state-table)))
|
|
(window (ebox-surface--buffer-display-window buffer)))
|
|
(list :viewport-width
|
|
(value :viewport-width
|
|
(or ebox-viewport-width
|
|
(and (window-live-p window)
|
|
(ebox-surface--window-content-width window))))
|
|
:viewport-height
|
|
(value :viewport-height
|
|
(or ebox-viewport-height
|
|
(and (window-live-p window)
|
|
(window-body-height window))))
|
|
:display-signature
|
|
(value :display-signature
|
|
(with-current-buffer buffer
|
|
(ebox--current-display-signature)))
|
|
:scroll-offsets
|
|
(ebox-surface--scroll-offsets scroll-table)))))
|
|
|
|
(defun ebox-surface--window-content-width (window)
|
|
"Return a safe pixel content width for live WINDOW.
|
|
Some Emacs GUI builds return a column-like half-width even when
|
|
`window-body-width' is called with PIXELWISE non-nil. When the result is
|
|
clearly inconsistent with the outer pixel width, prefer the outer width and
|
|
reserve two character columns for Emacs continuation/truncation display.
|
|
Headless/test windows retain the body width fallback."
|
|
(let ((body
|
|
(condition-case nil
|
|
(window-body-width window t)
|
|
(wrong-number-of-arguments nil)))
|
|
(outer
|
|
(condition-case nil
|
|
(window-pixel-width window)
|
|
(error nil))))
|
|
(let* ((char-width
|
|
(condition-case nil
|
|
(frame-char-width (window-frame window))
|
|
(error 1)))
|
|
(reserve (max 2 (* 2 (max 1 char-width)))))
|
|
(max 0
|
|
(- (if (and body outer (> outer (* 1.8 body)))
|
|
outer
|
|
(or body outer 0))
|
|
reserve)))))
|
|
|
|
(defun ebox-surface--ensure-signals (buffer values)
|
|
"Return BUFFER's context signals for VALUES and whether they were created."
|
|
(let ((signals
|
|
(with-current-buffer buffer ebox-surface--context-signals)))
|
|
(if (ebox-surface--signals-live-p signals)
|
|
(cons signals nil)
|
|
(when signals (ebox-surface--dispose-signals signals))
|
|
(setq signals
|
|
(ebox-surface--make-signals
|
|
:buffer buffer
|
|
:viewport-width
|
|
(tp-signal-create (plist-get values :viewport-width)
|
|
:scope buffer)
|
|
:viewport-height
|
|
(tp-signal-create (plist-get values :viewport-height)
|
|
:scope buffer)
|
|
:display
|
|
(tp-signal-create (plist-get values :display-signature)
|
|
:scope buffer)
|
|
:scroll
|
|
(tp-signal-create (plist-get values :scroll-offsets)
|
|
:scope buffer)))
|
|
(with-current-buffer buffer
|
|
(setq-local ebox-surface--context-signals signals))
|
|
(cons signals t))))
|
|
|
|
(defun ebox-surface--stage-signal-values (signals values)
|
|
"Stage VALUES into TP context SIGNALS in the active transaction."
|
|
(tp-signal-set (ebox-surface--signals-viewport-width signals)
|
|
(plist-get values :viewport-width))
|
|
(tp-signal-set (ebox-surface--signals-viewport-height signals)
|
|
(plist-get values :viewport-height))
|
|
(tp-signal-set (ebox-surface--signals-display signals)
|
|
(plist-get values :display-signature))
|
|
(tp-signal-set (ebox-surface--signals-scroll signals)
|
|
(plist-get values :scroll-offsets)))
|
|
|
|
(defun ebox-surface--live-buffer-surface (buffer)
|
|
"Return BUFFER's live Ebox TP surface, or nil."
|
|
(when (buffer-live-p buffer)
|
|
(let ((surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface)))
|
|
(and (tp-surface-live-p surface) surface))))
|
|
|
|
(defun ebox-surface-buffer-mounted-p (buffer)
|
|
"Return non-nil when BUFFER has a live Ebox TP surface."
|
|
(not (null (ebox-surface--live-buffer-surface buffer))))
|
|
|
|
(defun ebox-surface-region-mounts (buffer region-id &optional roles)
|
|
"Return REGION-ID's TP-owned output mounts in BUFFER.
|
|
When ROLES is non-nil, keep only direct mounts owning a listed Ebox role.
|
|
Without ROLES, include descendant output attached to the region's object.
|
|
The returned ranges are numeric snapshots; TP retains marker ownership."
|
|
(when-let* ((surface (ebox-surface--live-buffer-surface buffer))
|
|
(state (tp-surface-client-state surface))
|
|
(table (plist-get state :region-surface-object-table))
|
|
(object (gethash region-id table)))
|
|
(cl-remove-if-not
|
|
(lambda (mount)
|
|
(let ((tags (plist-get mount :tags)))
|
|
(if roles
|
|
(and (equal (plist-get tags :ebox/region-id) region-id)
|
|
(cl-intersection roles (plist-get tags :ebox/roles)))
|
|
(or (equal (plist-get tags :ebox/region-id) region-id)
|
|
(plist-get tags :ebox/descendant-output)))))
|
|
(tp-object-mounts object))))
|
|
|
|
(defun ebox-surface-region-bounds (buffer region-id &optional roles)
|
|
"Return numeric bounds for REGION-ID's TP mounts in BUFFER.
|
|
ROLES has the same filtering meaning as in `ebox-surface-region-mounts'."
|
|
(when-let* ((mounts (ebox-surface-region-mounts buffer region-id roles)))
|
|
(cons (apply #'min (mapcar (lambda (mount) (plist-get mount :start)) mounts))
|
|
(apply #'max (mapcar (lambda (mount) (plist-get mount :end)) mounts)))))
|
|
|
|
(defun ebox-surface--runtime-keys (state key)
|
|
"Return hash keys stored under KEY in runtime STATE."
|
|
(when-let* ((table (plist-get state key)))
|
|
(ebox-surface--hash-keys table)))
|
|
|
|
(defun ebox-surface--bind-scroll-states-to-buffer (state buffer)
|
|
"Bind every semantic scroll state in STATE to its owning BUFFER."
|
|
(when-let* ((table (plist-get state :scroll-state-table)))
|
|
(maphash
|
|
(lambda (region-id scroll-state)
|
|
(puthash region-id (plist-put scroll-state :buffer buffer) table))
|
|
table)))
|
|
|
|
(defun ebox-surface--commit-report (surface state report-base)
|
|
"Return Ebox's compact report for SURFACE, STATE, and REPORT-BASE."
|
|
(let* ((tp-report (tp-surface-report-summary surface))
|
|
(text-operations (or (plist-get tp-report :text-operations) 0))
|
|
(property-operations
|
|
(or (plist-get tp-report :property-operations) 0))
|
|
(patch-count (+ text-operations property-operations))
|
|
(report (copy-sequence report-base))
|
|
(scoped-p (and (not (plist-get tp-report :full-root))
|
|
(> (or (plist-get tp-report :scope-count) 0) 0)))
|
|
(planned-publication-scope (plist-get report :publication-scope)))
|
|
(dolist (entry
|
|
`((:runtime-published . t)
|
|
(:runtime-revision . ,(plist-get state :runtime-revision))
|
|
(:native-frame-kind . ,(plist-get state :native-frame-kind))
|
|
(:surface-revision . ,(tp-surface-revision surface))
|
|
(:publication-scope . tp-surface)
|
|
(:planned-publication-scope . ,planned-publication-scope)
|
|
(:tp-render-scope . ,(if scoped-p 'objects 'surface-plan))
|
|
(:tp-full-root . ,(plist-get tp-report :full-root))
|
|
(:tp-scope-count . ,(plist-get tp-report :scope-count))
|
|
(:tp-scope-range-count
|
|
. ,(plist-get tp-report :scope-range-count))
|
|
(:tp-scope-fallback . ,(plist-get tp-report :scope-fallback))
|
|
(:tp-retained-content . ,(plist-get tp-report :retained-content-p))
|
|
(:tp-operation-count . ,patch-count)
|
|
(:tp-transaction-id . ,(plist-get tp-report :transaction-id))
|
|
(:tp-text-operations . ,text-operations)
|
|
(:tp-property-operations . ,property-operations)
|
|
(:reconciled-objects
|
|
. ,(plist-get tp-report :reconciled-objects))
|
|
(:created-objects . ,(plist-get tp-report :created-objects))
|
|
(:removed-objects . ,(plist-get tp-report :removed-objects))
|
|
(:moved-objects . ,(plist-get tp-report :moved-objects))))
|
|
(setq report (plist-put report (car entry) (cdr entry))))
|
|
(unless (plist-member report :strategy)
|
|
(setq report
|
|
(plist-put report :strategy
|
|
(if (zerop patch-count) 'no-op 'surface-commit))))
|
|
(unless (plist-member report :constraint-source)
|
|
(setq report (plist-put report :constraint-source 'declarative)))
|
|
(unless (plist-member report :constraint-root-node-id)
|
|
(setq report
|
|
(plist-put report :constraint-root-node-id
|
|
(plist-get (plist-get state :root-node) :node-id))))
|
|
(unless (plist-member report :dirty-count)
|
|
(setq report
|
|
(plist-put report :dirty-count
|
|
(if (zerop patch-count) 0 1))))
|
|
(unless (plist-member report :patch-count)
|
|
(setq report (plist-put report :patch-count patch-count)))
|
|
(unless (plist-member report :patch-ops)
|
|
(setq report
|
|
(plist-put report :patch-ops
|
|
(and (> patch-count 0) '(tp-surface)))))
|
|
report))
|
|
|
|
(defun ebox-surface--participant-report (participant report state)
|
|
"Attach PARTICIPANT's read-only STATE and diagnostics to REPORT."
|
|
(when participant
|
|
(setq report (plist-put report :framework-participant-state state))
|
|
(setq report
|
|
(plist-put report :framework-participant-diagnostics
|
|
(copy-tree
|
|
(ebox-surface--framework-participant-diagnostics
|
|
participant))))
|
|
(setq report
|
|
(plist-put report :scroll-finalization-diagnostics
|
|
(copy-tree
|
|
(ebox-surface--framework-participant-scroll-diagnostics
|
|
participant))))
|
|
(setf (ebox-surface--framework-participant-report participant) report))
|
|
report)
|
|
|
|
(defun ebox-surface--participant-run-publish (participant report)
|
|
"Publish PARTICIPANT with REPORT exactly once and return updated REPORT."
|
|
(unless (eq (ebox-surface--framework-participant-state participant)
|
|
'unpublished)
|
|
(error "Ebox framework participant is not unpublished"))
|
|
(setf (ebox-surface--framework-participant-state participant) 'published)
|
|
(setq report (ebox-surface--participant-report participant report 'published))
|
|
(when-let* ((publish (ebox-surface--framework-participant-publish participant)))
|
|
(funcall publish report))
|
|
report)
|
|
|
|
(defun ebox-surface--participant-run-rollback (participant)
|
|
"Run PARTICIPANT's paired rollback once without allowing failure to escape."
|
|
(when (and participant
|
|
(eq (ebox-surface--framework-participant-state participant)
|
|
'published))
|
|
(setf (ebox-surface--framework-participant-state participant) 'rolled-back)
|
|
(ebox-surface--participant-report
|
|
participant (ebox-surface--framework-participant-report participant)
|
|
'rolled-back)
|
|
(when-let* ((rollback
|
|
(ebox-surface--framework-participant-rollback participant)))
|
|
(let ((inhibit-quit t)
|
|
(quit-flag nil))
|
|
(condition-case failure
|
|
(funcall rollback
|
|
(ebox-surface--framework-participant-report participant))
|
|
((error quit)
|
|
(push (list :phase 'framework-rollback :condition failure)
|
|
(ebox-surface--framework-participant-diagnostics
|
|
participant))))))
|
|
(ebox-surface--participant-report
|
|
participant (ebox-surface--framework-participant-report participant)
|
|
'rolled-back)))
|
|
|
|
(defun ebox-surface--participant-complete (participant diagnostics)
|
|
"Complete PARTICIPANT after scroll DIAGNOSTICS are contained."
|
|
(when participant
|
|
(setf (ebox-surface--framework-participant-scroll-diagnostics participant)
|
|
diagnostics)
|
|
(let* ((state
|
|
(ebox-surface--framework-participant-runtime-state participant))
|
|
(report (ebox-surface--framework-participant-report participant)))
|
|
(plist-put state :last-update-report
|
|
(ebox-surface--participant-report
|
|
participant report 'completed)))
|
|
(setf (ebox-surface--framework-participant-state participant) 'completed)))
|
|
|
|
(defun ebox-surface--publish-runtime-state
|
|
(buffer surface old-state report-base after-publication
|
|
&optional framework-participant)
|
|
"Register BUFFER runtime publication for SURFACE after OLD-STATE.
|
|
REPORT-BASE requests an Ebox commit report. AFTER-PUBLICATION, when non-nil,
|
|
runs after TP and Ebox point at the same candidate generation.
|
|
FRAMEWORK-PARTICIPANT owns paired framework publication when non-nil."
|
|
(let (new-state region-snapshot scroll-snapshot
|
|
old-surface old-mirror region-keys scroll-keys)
|
|
(tp-transaction-participate
|
|
(list 'ebox/runtime buffer)
|
|
(lambda ()
|
|
(setq new-state (tp-surface-client-state surface)
|
|
old-surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface)
|
|
old-mirror (gethash buffer ebox--buffer-render-state-table)
|
|
region-keys
|
|
(delete-dups
|
|
(append (ebox-surface--runtime-keys old-state :region-id-set)
|
|
(ebox-surface--runtime-keys new-state :region-id-set)))
|
|
scroll-keys
|
|
(delete-dups
|
|
(append (copy-sequence (plist-get old-state :scroll-region-ids))
|
|
(copy-sequence (plist-get new-state :scroll-region-ids)))))
|
|
(setq region-snapshot
|
|
(ebox-incremental--hash-snapshot
|
|
ebox--region-box-table region-keys)
|
|
scroll-snapshot
|
|
(ebox-incremental--hash-snapshot
|
|
ebox--scroll-global-state scroll-keys))
|
|
(when framework-participant
|
|
(setf (ebox-surface--framework-participant-runtime-state
|
|
framework-participant)
|
|
new-state
|
|
(ebox-surface--framework-participant-scroll-keys
|
|
framework-participant)
|
|
scroll-keys))
|
|
(when new-state
|
|
(plist-put new-state :surface surface)
|
|
(plist-put new-state :runtime-revision
|
|
(1- (tp-surface-revision surface)))
|
|
;; A fixed-basis role-owned patch rendered against the previous
|
|
;; allocation. Its installed details describe that proof render,
|
|
;; not the now-committed TP mounts. Drop only those owners' derived
|
|
;; geometry so the next transaction lazily captures the committed
|
|
;; spans and cannot drift across a repeated selection round trip.
|
|
(when-let* ((snapshots (plist-get new-state :layout-snapshots)))
|
|
(dolist (proof (plist-get new-state :owner-scoped-proofs))
|
|
(when (plist-get proof :role-owned-lines-p)
|
|
(let ((owner-id (plist-get proof :owner-id)))
|
|
(when-let* ((snapshot (gethash owner-id snapshots)))
|
|
(puthash owner-id
|
|
(ebox--layout-snapshot-strip-details snapshot)
|
|
snapshots))))))
|
|
(when (plist-get report-base :scroll-state-transaction)
|
|
;; Scroll changes invalidate every buffer-span coordinate. Keep
|
|
;; the committed generation structurally snapshot-free so a later
|
|
;; hidden-owner update recaptures spans from the current buffer,
|
|
;; never from the pre-scroll marker positions.
|
|
(plist-put new-state :layout-snapshots
|
|
(make-hash-table :test 'equal))
|
|
(plist-put new-state :layout-snapshots-complete-p nil))
|
|
(ebox-surface--bind-scroll-states-to-buffer new-state buffer)
|
|
(when report-base
|
|
(plist-put new-state :last-update-report
|
|
(ebox-surface--commit-report
|
|
surface new-state report-base))))
|
|
(with-current-buffer buffer
|
|
(setq-local ebox-surface--buffer-surface surface))
|
|
(if new-state
|
|
(puthash buffer new-state ebox--buffer-render-state-table)
|
|
(remhash buffer ebox--buffer-render-state-table))
|
|
(ebox-incremental--replace-hash-entries
|
|
ebox--region-box-table region-keys
|
|
(plist-get new-state :region-box-table))
|
|
(ebox-incremental--replace-hash-entries
|
|
ebox--scroll-global-state scroll-keys
|
|
(plist-get new-state :scroll-state-table))
|
|
(if framework-participant
|
|
(plist-put
|
|
new-state :last-update-report
|
|
(ebox-surface--participant-run-publish
|
|
framework-participant
|
|
(plist-get new-state :last-update-report)))
|
|
(when after-publication
|
|
(funcall after-publication
|
|
(plist-get new-state :last-update-report))))
|
|
(unless (buffer-live-p buffer)
|
|
(error "Ebox declarative target died during publication")))
|
|
(lambda ()
|
|
(unwind-protect
|
|
(ebox-surface--participant-run-rollback framework-participant)
|
|
(if (buffer-live-p buffer)
|
|
(progn
|
|
(when region-snapshot
|
|
(ebox-incremental--restore-hash-snapshot
|
|
ebox--region-box-table region-snapshot))
|
|
(when scroll-snapshot
|
|
(ebox-incremental--restore-hash-snapshot
|
|
ebox--scroll-global-state scroll-snapshot))
|
|
(with-current-buffer buffer
|
|
(setq-local ebox-surface--buffer-surface old-surface))
|
|
(if old-mirror
|
|
(puthash buffer old-mirror ebox--buffer-render-state-table)
|
|
(remhash buffer ebox--buffer-render-state-table)))
|
|
(remhash buffer ebox--buffer-render-state-table)
|
|
(dolist (region-id region-keys)
|
|
(remhash region-id ebox--region-box-table))
|
|
(dolist (region-id scroll-keys)
|
|
(ebox--scroll-clear-state region-id)
|
|
(ebox--smooth-scroll-stop region-id))))))))
|
|
|
|
(defun ebox-surface-mount-buffer
|
|
(buffer source &optional report-base after-publication
|
|
preserve-identities-p state-overrides framework-participant)
|
|
"Mount or atomically update BUFFER from Ebox SOURCE and return its surface.
|
|
REPORT-BASE requests a committed Ebox report. AFTER-PUBLICATION runs inside
|
|
the rollback-capable transaction. PRESERVE-IDENTITIES-P retains identities
|
|
already present in a logical candidate. STATE-OVERRIDES augments its runtime.
|
|
FRAMEWORK-PARTICIPANT retains post-TP publication facts when non-nil."
|
|
(let* ((surface (ebox-surface--live-buffer-surface buffer))
|
|
(old-state (and surface (tp-surface-client-state surface)))
|
|
(context-values
|
|
(ebox-surface--context-values buffer old-state state-overrides))
|
|
(signals-result
|
|
(ebox-surface--ensure-signals buffer context-values))
|
|
(signals (car signals-result))
|
|
(signals-created-p (cdr signals-result))
|
|
(preserve-identities-p
|
|
(or preserve-identities-p
|
|
(and (null old-state)
|
|
(ebox-surface--source-identities-available-p
|
|
source buffer))))
|
|
(producer
|
|
(ebox-surface-producer
|
|
source old-state preserve-identities-p state-overrides signals))
|
|
success)
|
|
(unwind-protect
|
|
(progn
|
|
(tp-with-transaction
|
|
(ebox-surface--stage-signal-values signals context-values)
|
|
(if surface
|
|
(tp-surface-update surface producer)
|
|
(setq surface
|
|
(tp-surface-mount
|
|
buffer producer
|
|
'(:capability content :inhibit-read-only t
|
|
:coordinate-mounts t))))
|
|
(ebox-surface--publish-runtime-state
|
|
buffer surface old-state report-base after-publication
|
|
framework-participant))
|
|
(setq success t)
|
|
(let ((scroll-keys
|
|
(if framework-participant
|
|
(ebox-surface--framework-participant-scroll-keys
|
|
framework-participant)
|
|
(let ((new-state (tp-surface-client-state surface)))
|
|
(delete-dups
|
|
(append
|
|
(copy-sequence (plist-get old-state :scroll-region-ids))
|
|
(copy-sequence
|
|
(plist-get new-state :scroll-region-ids))))))))
|
|
(ebox-surface--participant-complete
|
|
framework-participant
|
|
(ebox-incremental--finalize-declarative-scroll-publication
|
|
scroll-keys)))
|
|
surface)
|
|
(ebox-surface--settle-native-session
|
|
old-state state-overrides surface success)
|
|
(when (and signals-created-p (not success))
|
|
(ebox-surface--dispose-signals signals)))))
|
|
|
|
(defun ebox-surface--viewport-report (state width height axes strategy)
|
|
"Return a viewport report for STATE, WIDTH, HEIGHT, AXES, and STRATEGY."
|
|
(let ((root (plist-get state :root-node)))
|
|
(ebox--update-report
|
|
nil strategy
|
|
:constraint-source 'viewport
|
|
:constraint-owner-id 'viewport
|
|
:constraint-owner-type 'viewport
|
|
:constraint-root-node-id (plist-get root :node-id)
|
|
:viewport-axes axes
|
|
:target-viewport-width width
|
|
:target-viewport-height height
|
|
:dirty-kinds (unless (eq axes 'none) '(geometry))
|
|
:dirty-count (if (eq axes 'none) 0 1)
|
|
:patch-count (if (eq axes 'none) 0 1)
|
|
:patch-ops (unless (eq axes 'none) '(root-rerender))
|
|
:owner-ids (unless (eq axes 'none)
|
|
(list (plist-get root :node-id)))
|
|
:root-rerender (not (eq axes 'none)))))
|
|
|
|
(defun ebox-surface--publish-context-no-op
|
|
(buffer surface state values state-overrides report)
|
|
"Commit VALUES and no-op STATE-OVERRIDES into STATE for BUFFER and SURFACE."
|
|
(let ((signals
|
|
(with-current-buffer buffer ebox-surface--context-signals))
|
|
(old-width (plist-get state :viewport-width))
|
|
(old-height (plist-get state :viewport-height))
|
|
(old-display (plist-get state :display-signature))
|
|
(old-report (plist-get state :last-update-report)))
|
|
(unless (ebox-surface--signals-live-p signals)
|
|
(error "Ebox mounted surface has no live context signals"))
|
|
(tp-with-transaction
|
|
(ebox-surface--stage-signal-values signals values)
|
|
(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)))
|
|
(style-context-stable-p
|
|
(equal (ebox-surface--stylesheet-signature)
|
|
(plist-get state :stylesheet-signature)))
|
|
(axes (cond ((and width-changed height-changed) 'both)
|
|
(width-changed 'width)
|
|
(height-changed 'height)
|
|
(t 'none))))
|
|
(if (and (eq axes 'none) (not display-changed))
|
|
(let ((report
|
|
(ebox-surface--viewport-report
|
|
state width target-height axes 'no-op)))
|
|
(plist-put state :last-update-report report)
|
|
report)
|
|
(ebox-incremental--notify-before-runtime-mutation buffer 'viewport)
|
|
(unless (eq state (tp-surface-client-state surface))
|
|
(error "Ebox runtime changed during viewport update notification"))
|
|
(let ((commit-input
|
|
(ebox-incremental-prepare-viewport-commit
|
|
buffer width target-height axes display-signature
|
|
style-context-stable-p)))
|
|
(if (plist-get commit-input :no-op)
|
|
(let* ((state-overrides
|
|
(plist-get commit-input :state-overrides))
|
|
(values
|
|
(ebox-surface--context-values
|
|
buffer state state-overrides)))
|
|
(ebox-surface--publish-context-no-op
|
|
buffer surface state values state-overrides
|
|
(plist-get commit-input :report-base)))
|
|
(ebox-surface-update-buffer-scoped
|
|
buffer
|
|
(plist-get commit-input :root)
|
|
(plist-get commit-input :scope-node-ids)
|
|
(plist-get commit-input :report-base)
|
|
(plist-get commit-input :state-overrides)
|
|
nil nil 0
|
|
(plist-get commit-input :projection-kind)
|
|
;; The incremental viewport candidate aliases the published root
|
|
;; while it proves the reflow shape. Let the surface create its
|
|
;; own copy before layout can attach caches or TP handles.
|
|
nil)
|
|
(plist-get (tp-surface-client-state surface)
|
|
:last-update-report)))))))
|
|
|
|
(defun ebox-surface--projection-start
|
|
(context root &optional style-required-p projection-kind previous-state
|
|
state-overrides)
|
|
"Create retained TP identities and optional computed styles for ROOT.
|
|
STYLE-REQUIRED-P is non-nil when the candidate must refresh cascade results.
|
|
When it is nil, inline declarations already projected by node construction
|
|
are sufficient for the static layout pass. PROJECTION-KIND may request a
|
|
strict span patch or retained viewport reflow, both of which reuse
|
|
PREVIOUS-STATE's node-object table."
|
|
(let* ((surface-root
|
|
(tp-object-ensure context nil ebox-surface--root-key 'ebox/surface))
|
|
(node-root
|
|
(tp-object-ensure context surface-root
|
|
ebox-surface--nodes-key 'ebox/nodes))
|
|
(range-splice-p
|
|
(and (eq projection-kind 'mixed-owner-reflow)
|
|
(ebox-surface--mixed-range-splice-p state-overrides)))
|
|
(objects-by-node
|
|
(if (memq projection-kind
|
|
'(span-patch owner-scoped scroll-patch
|
|
formatting-context-reflow mixed-owner-reflow
|
|
viewport-reflow viewport-reflow-mixed-scroll
|
|
native-frame))
|
|
(if (or (eq projection-kind 'native-frame) range-splice-p)
|
|
(make-hash-table :test 'eq)
|
|
(or (plist-get previous-state :surface-node-object-table)
|
|
(error "Ebox span projection has no retained node table")))
|
|
(make-hash-table :test 'eq)))
|
|
(style-state-table
|
|
(ebox-surface--style-state-table previous-state))
|
|
(ebox-surface--inline-style-value-cache
|
|
(and style-required-p
|
|
(not (ebox-style-cascade-active-p))
|
|
(make-hash-table :test 'equal)))
|
|
(stylesheet-signature
|
|
(and style-required-p
|
|
(if (and (memq projection-kind
|
|
'(owner-scoped scroll-patch
|
|
formatting-context-reflow mixed-owner-reflow))
|
|
(not range-splice-p))
|
|
nil
|
|
(ebox-surface--stylesheet-signature))))
|
|
(stylesheet-subject-local-p
|
|
(and stylesheet-signature
|
|
(ebox-surface--stylesheet-subject-local-p
|
|
stylesheet-signature)))
|
|
(bindings-by-subject (make-hash-table :test 'eq))
|
|
(states-by-subject (make-hash-table :test 'eq))
|
|
(subjects (when (and style-required-p
|
|
(not (and (eq projection-kind 'native-frame)
|
|
(plist-get state-overrides
|
|
:native-topology-stable-p)))
|
|
(not (and (memq projection-kind
|
|
'(owner-scoped scroll-patch
|
|
formatting-context-reflow
|
|
mixed-owner-reflow))
|
|
(not range-splice-p))))
|
|
(ebox-tree-subject-index root)))
|
|
(selector-tree-snapshot
|
|
(if (and (memq projection-kind
|
|
'(owner-scoped scroll-patch
|
|
formatting-context-reflow mixed-owner-reflow
|
|
native-frame))
|
|
(not range-splice-p))
|
|
(plist-get previous-state :selector-tree-snapshot)
|
|
(and subjects
|
|
(ebox-surface--subject-signature
|
|
(plist-get subjects :root-subject)))))
|
|
(selector-tree-token
|
|
(if (and (memq projection-kind
|
|
'(owner-scoped scroll-patch native-frame))
|
|
(not range-splice-p))
|
|
(plist-get previous-state :selector-tree-token)
|
|
(and selector-tree-snapshot
|
|
(if (and (equal selector-tree-snapshot
|
|
(plist-get previous-state
|
|
:selector-tree-snapshot))
|
|
(plist-get previous-state :selector-tree-token))
|
|
(plist-get previous-state :selector-tree-token)
|
|
(cons 'ebox/selector-tree nil))))))
|
|
(cond
|
|
((eq projection-kind 'native-frame)
|
|
(ebox-surface--project-node-delta
|
|
context root previous-state state-overrides node-root objects-by-node
|
|
(and subjects (plist-get subjects :node-subject-table))
|
|
bindings-by-subject states-by-subject style-state-table
|
|
stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p))
|
|
(range-splice-p
|
|
(ebox-surface--project-node-delta
|
|
context root previous-state state-overrides node-root objects-by-node
|
|
(and subjects (plist-get subjects :node-subject-table))
|
|
bindings-by-subject states-by-subject style-state-table
|
|
stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p))
|
|
((memq projection-kind
|
|
'(span-patch owner-scoped scroll-patch
|
|
formatting-context-reflow mixed-owner-reflow
|
|
viewport-reflow viewport-reflow-mixed-scroll))
|
|
(tp-object-reuse-subtree context node-root))
|
|
(t
|
|
(tp-object-retain context node-root)
|
|
(ebox-surface--ensure-node-tree
|
|
context node-root root objects-by-node
|
|
(and subjects (plist-get subjects :node-subject-table))
|
|
bindings-by-subject states-by-subject style-state-table
|
|
stylesheet-signature
|
|
selector-tree-token stylesheet-subject-local-p
|
|
ebox--render-root-parent-kind)))
|
|
(when (and subjects (> (ebox-tree-author-style-count root) 0))
|
|
(ebox-tree-clear-author-style-pending root))
|
|
(list :surface-root surface-root
|
|
:node-root node-root
|
|
:objects-by-node objects-by-node
|
|
:style-binding-states style-state-table
|
|
:stylesheet-signature stylesheet-signature
|
|
:selector-tree-snapshot selector-tree-snapshot
|
|
:selector-tree-token selector-tree-token)))
|
|
|
|
(defun ebox-surface--project-stable-node-table
|
|
(context nodes node-root old-objects objects-by-node)
|
|
"Reuse native NODES whose object topology is proven unchanged."
|
|
(tp-object-reuse-subtree context node-root)
|
|
(maphash
|
|
(lambda (node-id node)
|
|
(let ((object (gethash node-id old-objects)))
|
|
(unless object
|
|
(error "Ebox native projection lost retained node %S" node-id))
|
|
(plist-put node :surface-object object)
|
|
(puthash node object objects-by-node)))
|
|
nodes)
|
|
objects-by-node)
|
|
|
|
(defun ebox-surface--project-node-delta
|
|
(context root previous-state state-overrides node-root objects-by-node
|
|
subject-table bindings-by-subject states-by-subject
|
|
style-state-table stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p)
|
|
"Project ROOT objects from its exact native touched-node delta."
|
|
(let* ((nodes (plist-get state-overrides :node-table))
|
|
(parents (plist-get state-overrides :parent-table))
|
|
(touched-ids (plist-get state-overrides :native-touched-node-ids))
|
|
(old-objects (plist-get previous-state :surface-node-object-table))
|
|
(touched (make-hash-table :test 'equal))
|
|
(objects-by-id (make-hash-table :test 'equal)))
|
|
(unless (and (hash-table-p nodes) (hash-table-p parents)
|
|
(hash-table-p old-objects)
|
|
(or (plist-get state-overrides :native-topology-stable-p)
|
|
touched-ids))
|
|
(error "Ebox native projection has no candidate object delta"))
|
|
(if (plist-get state-overrides :native-topology-stable-p)
|
|
(ebox-surface--project-stable-node-table
|
|
context nodes node-root old-objects objects-by-node)
|
|
(tp-object-retain context node-root)
|
|
(dolist (node-id touched-ids) (puthash node-id t touched))
|
|
(maphash
|
|
(lambda (node-id node)
|
|
(when subject-table
|
|
(when-let* ((subject (gethash node subject-table))
|
|
(object (gethash node-id old-objects))
|
|
(style-state (gethash object style-state-table))
|
|
(binding (plist-get style-state :binding)))
|
|
(puthash subject binding bindings-by-subject)
|
|
(puthash subject style-state states-by-subject)))
|
|
(unless (gethash node-id touched)
|
|
(let ((object (gethash node-id old-objects)))
|
|
(unless object
|
|
(error "Ebox native projection lost retained node %S" node-id))
|
|
(tp-object-reuse context object)
|
|
(puthash node object objects-by-node)
|
|
(puthash node-id object objects-by-id))))
|
|
nodes)
|
|
(dolist (node-id touched-ids)
|
|
(let* ((node (gethash node-id nodes))
|
|
(parent-id (and node (gethash node-id parents)))
|
|
(old-object (and node (gethash node-id old-objects)))
|
|
(parent-node (and parent-id (gethash parent-id nodes)))
|
|
(position
|
|
(if parent-node
|
|
(or (cl-position
|
|
node (ebox-tree--children-raw parent-node) :test #'eq)
|
|
(error "Ebox native projection lost child position"))
|
|
0))
|
|
(parent (if parent-id
|
|
(gethash parent-id objects-by-id)
|
|
node-root)))
|
|
(unless (and node parent)
|
|
(error "Ebox native projection has an unordered node delta"))
|
|
(let ((object
|
|
(tp-object-ensure-at context parent
|
|
(ebox-surface--node-key node)
|
|
(ebox-surface--node-kind node)
|
|
position)))
|
|
(tp-object-retain context object)
|
|
(if (eq object old-object)
|
|
(tp-object-reuse context object)
|
|
(when subject-table
|
|
(ebox-surface--apply-node-style
|
|
object node subject-table bindings-by-subject
|
|
states-by-subject style-state-table stylesheet-signature
|
|
selector-tree-token stylesheet-subject-local-p)))
|
|
(plist-put node :surface-object object)
|
|
(puthash node object objects-by-node)
|
|
(puthash node-id object objects-by-id))))
|
|
(unless (gethash (plist-get root :node-id) objects-by-id)
|
|
(error "Ebox native projection lost its root object"))
|
|
(when (and subject-table
|
|
(not (plist-get state-overrides
|
|
:computed-participation-validated-p)))
|
|
(ebox-tree-validate-indexed-participation
|
|
nodes parents touched-ids 'computed)))
|
|
objects-by-node))
|
|
|
|
(defun ebox-surface--complete-projection
|
|
(context root style-required-p projection)
|
|
"Complete a retained PROJECTION for ROOT after a local proof miss.
|
|
The initial span attempt already owns the surface and node-root identities in
|
|
CONTEXT, so full fallback must populate those same objects instead of creating
|
|
the projection roots a second time."
|
|
(let* ((node-root (plist-get projection :node-root))
|
|
(objects-by-node (plist-get projection :objects-by-node))
|
|
(style-state-table
|
|
(plist-get projection :style-binding-states))
|
|
(stylesheet-signature
|
|
(or (plist-get projection :stylesheet-signature)
|
|
(and style-required-p
|
|
(ebox-surface--stylesheet-signature))))
|
|
(stylesheet-subject-local-p
|
|
(and stylesheet-signature
|
|
(ebox-surface--stylesheet-subject-local-p
|
|
stylesheet-signature)))
|
|
(selector-tree-token
|
|
(plist-get projection :selector-tree-token))
|
|
(bindings-by-subject (make-hash-table :test 'eq))
|
|
(states-by-subject (make-hash-table :test 'eq))
|
|
(subjects (when style-required-p
|
|
(ebox-tree-subject-index root))))
|
|
(tp-object-retain context node-root)
|
|
(ebox-surface--ensure-node-tree
|
|
context node-root root objects-by-node
|
|
(and subjects (plist-get subjects :node-subject-table))
|
|
bindings-by-subject states-by-subject style-state-table
|
|
stylesheet-signature
|
|
selector-tree-token stylesheet-subject-local-p
|
|
ebox--render-root-parent-kind)
|
|
(when (> (ebox-tree-author-style-count root) 0)
|
|
(ebox-tree-clear-author-style-pending root))
|
|
projection))
|
|
|
|
(defun ebox-surface--projection-result
|
|
(context projection state output &optional projection-kind)
|
|
"Complete CONTEXT PROJECTION for STATE from rendered OUTPUT."
|
|
(let* ((surface-root (plist-get projection :surface-root))
|
|
(objects-by-node (plist-get projection :objects-by-node))
|
|
(root-node (plist-get state :root-node))
|
|
(root-id (and root-node (plist-get root-node :node-id)))
|
|
(owner-id (plist-get state :span-patch-owner-id))
|
|
(scroll-fast-p (and (eq projection-kind 'scroll-patch)
|
|
(plist-get state :scroll-fast-window-p)))
|
|
(full-surface-p
|
|
(and scroll-fast-p
|
|
(plist-get state :retained-scroll-content-p)
|
|
root-id owner-id (= root-id owner-id)))
|
|
(native-retained-p
|
|
(and (eq projection-kind 'native-frame)
|
|
(plist-get state :native-topology-stable-p)))
|
|
(previous-owned-ranges
|
|
(plist-get state :previous-surface-owned-ranges))
|
|
(node-objects
|
|
(or (and scroll-fast-p
|
|
(plist-get state :surface-node-object-table))
|
|
(ebox-surface--node-object-table objects-by-node)))
|
|
(region-objects
|
|
(or (and scroll-fast-p
|
|
(plist-get state :region-surface-object-table))
|
|
(ebox-surface--region-object-table state node-objects))))
|
|
(plist-put state :surface-node-object-table node-objects)
|
|
(plist-put state :region-surface-object-table region-objects)
|
|
(unless (and scroll-fast-p
|
|
(plist-get state :surface-object-region-table))
|
|
(plist-put state :surface-object-region-table
|
|
(ebox-surface--object-region-table region-objects)))
|
|
(unless (and scroll-fast-p
|
|
(plist-get state :logical-id-region-table))
|
|
(plist-put state :logical-id-region-table
|
|
(ebox-surface--logical-id-region-table state region-objects)))
|
|
(or (and native-retained-p
|
|
(ebox-surface--native-patch-result
|
|
context projection state output node-objects region-objects))
|
|
(and (memq projection-kind
|
|
'(span-patch owner-scoped mixed-owner-reflow))
|
|
(ebox-surface--span-coordinate-result
|
|
context projection state output previous-owned-ranges))
|
|
(let* ((range-splice-p
|
|
(and (eq projection-kind 'mixed-owner-reflow)
|
|
(ebox-surface--mixed-range-splice-p state)))
|
|
(prepared
|
|
(ebox-surface--surface-plan
|
|
context surface-root output state node-objects region-objects
|
|
scroll-fast-p))
|
|
(plan (car prepared))
|
|
(rendered (cadr prepared))
|
|
(owned-ranges (nth 2 prepared))
|
|
(property-contributions
|
|
(plist-get state :paint-property-contributions)))
|
|
(or (and (memq projection-kind
|
|
'(span-patch owner-scoped mixed-owner-reflow))
|
|
(ebox-surface--coordinate-commit
|
|
context state rendered owned-ranges (nth 3 prepared)
|
|
previous-owned-ranges))
|
|
(if (and (not range-splice-p)
|
|
(or full-surface-p native-retained-p
|
|
property-contributions))
|
|
(tp-surface-retained-content-result-create
|
|
context plan rendered owned-ranges state
|
|
full-surface-p property-contributions)
|
|
(tp-surface-result-create-owned context plan state)))))))
|
|
|
|
(defun ebox-surface--native-patch-result
|
|
(context projection state rendered node-objects region-objects)
|
|
"Return a TP batch directly from STATE's exact native patch, or nil."
|
|
(let ((frame (plist-get state :native-render-frame)))
|
|
(when (and (plist-get frame :native-patch)
|
|
(plist-get state :native-topology-stable-p)
|
|
(stringp rendered))
|
|
(let* ((surface-root (plist-get projection :surface-root))
|
|
(fragment-root
|
|
(tp-object-ensure context surface-root
|
|
ebox-surface--fragments-key 'ebox/fragments))
|
|
(text-leaf
|
|
(tp-object-ensure context fragment-root
|
|
ebox-surface--text-key 'ebox/text))
|
|
(fragment-data
|
|
(plist-get state :native-render-fragment-template))
|
|
(reuse-mount-projection-p
|
|
(and (plist-get state :native-reuse-mount-projection-p) t))
|
|
(owned-ranges
|
|
(if (or reuse-mount-projection-p
|
|
(plist-get state :native-reuse-ownership-p))
|
|
(let ((ranges
|
|
(plist-get state :native-committed-owned-ranges)))
|
|
(unless ranges
|
|
(error "Native retained frame has no ownership base"))
|
|
ranges)
|
|
(unless (vectorp fragment-data)
|
|
(error "Native retained patch has no target fragments"))
|
|
(ebox-surface--native-owned-ranges
|
|
context text-leaf fragment-data state node-objects
|
|
region-objects nil)))
|
|
(rendered-length (length rendered))
|
|
(mount-records
|
|
(list (list :object text-leaf :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf t)
|
|
(list :object fragment-root :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf nil)
|
|
(list :object surface-root :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf nil))))
|
|
(plist-put state :surface-owned-ranges owned-ranges)
|
|
(plist-put state :native-committed-rendered rendered)
|
|
(plist-put state :native-committed-owned-ranges owned-ranges)
|
|
(plist-put state :native-committed-fragment-template fragment-data)
|
|
(plist-put state :surface-fragments (list :native-frame frame))
|
|
(cl-remf state :native-reuse-ownership-p)
|
|
(cl-remf state :native-reuse-mount-projection-p)
|
|
(cl-remf state :native-coordinate-patches)
|
|
(cl-remf state :native-render-output)
|
|
(cl-remf state :native-render-fragments)
|
|
(cl-remf state :native-render-fragment-template)
|
|
(cl-remf state :native-render-frame)
|
|
(cl-remf state :previous-surface-owned-ranges)
|
|
(ebox-surface--native-commit-batch
|
|
context state mount-records owned-ranges
|
|
reuse-mount-projection-p)))))
|
|
|
|
(defun ebox-surface--coordinate-patches-identity-p (frame)
|
|
"Return non-nil when FRAME preserves every character coordinate."
|
|
(and (= (plist-get frame :base-character-count)
|
|
(plist-get frame :target-character-count))
|
|
(cl-every
|
|
(lambda (patch)
|
|
(and (= (plist-get patch :old-start)
|
|
(plist-get patch :new-start))
|
|
(= (plist-get patch :old-end)
|
|
(plist-get patch :new-end))))
|
|
(plist-get frame :coordinate-patches))))
|
|
|
|
(defun ebox-surface--commit-mount-specs (records owned-ranges)
|
|
"Return exact target mount specs from RECORDS and OWNED-RANGES.
|
|
The text record precedes logical ownership ranges, matching TP's normal
|
|
content projection order; fragment and surface records follow unchanged."
|
|
(unless records
|
|
(error "Ebox native commit has no target mount records"))
|
|
(append (list (car records)) owned-ranges (cdr records)))
|
|
|
|
(defun ebox-surface--native-commit-batch
|
|
(context state mount-records owned-ranges &optional retain-mount-state-p)
|
|
"Return a strict TP batch result for STATE's stable-topology native patch."
|
|
(let* ((frame (or (plist-get state :native-render-frame)
|
|
(plist-get (plist-get state :surface-fragments)
|
|
:native-frame)))
|
|
(patches (and frame (plist-get frame :patches)))
|
|
(base (and frame (plist-get frame :base-character-count)))
|
|
(target (and frame (plist-get frame :target-character-count))))
|
|
(when (and (plist-get frame :native-patch)
|
|
(plist-get state :native-topology-stable-p)
|
|
(integerp base) (integerp target)
|
|
(proper-list-p patches))
|
|
(let ((batch
|
|
(tp-commit-batch-create
|
|
:base-revision (plist-get state :runtime-revision)
|
|
:target-revision (1+ (plist-get state :runtime-revision))
|
|
:base-extent base :target-extent target
|
|
:patches patches
|
|
:coordinate-patches (plist-get frame :coordinate-patches))))
|
|
(if retain-mount-state-p
|
|
(tp-commit-batch-result-create
|
|
context batch :client-state state :reuse-mount-projection t)
|
|
(tp-commit-batch-result-create
|
|
context batch
|
|
:mount-specs
|
|
(ebox-surface--commit-mount-specs mount-records owned-ranges)
|
|
:client-state state))))))
|
|
|
|
(defun ebox-surface--coordinate-commit
|
|
(context state rendered owned-ranges mount-records previous-owned-ranges)
|
|
"Return STATE's exact proven-owner coordinate commit, or nil.
|
|
PREVIOUS-OWNED-RANGES identify the committed owner intervals. The mixed
|
|
projection has already produced exact coordinate patches and final text; this
|
|
function composes those retained facts into TP's standard validated commit
|
|
batch without asking TP to rediscover the same diff from a full plan."
|
|
(let* ((proof (plist-get state :mixed-owner-proof))
|
|
(owner-ids
|
|
(or (plist-get proof :owner-ids)
|
|
(mapcar (lambda (owner-proof)
|
|
(plist-get owner-proof :owner-id))
|
|
(plist-get state :owner-scoped-proofs))
|
|
(and (plist-get state :span-patch-owner-id)
|
|
(list (plist-get state :span-patch-owner-id)))))
|
|
(objects (plist-get state :surface-node-object-table))
|
|
(coordinate-patches (plist-get state :content-coordinate-patches))
|
|
(target-extent (and (stringp rendered) (length rendered)))
|
|
(source-extent (plist-get state :content-base-extent))
|
|
owner-set intervals)
|
|
(when (and owner-ids (hash-table-p objects) coordinate-patches
|
|
(integerp source-extent) (integerp target-extent)
|
|
previous-owned-ranges)
|
|
(setq owner-set (make-hash-table :test #'eq))
|
|
(dolist (owner-id owner-ids)
|
|
(when-let* ((object (gethash owner-id objects)))
|
|
(puthash object t owner-set)))
|
|
;; Coordinate patches are the authoritative old-to-new mapping for
|
|
;; changed content. Owner mounts supplement that mapping with
|
|
;; property-only intervals (for example a button whose enabled face
|
|
;; changes after a preceding Range grows). Starting from owner mounts
|
|
;; alone loses every boundary inside a replacement by design, leaving
|
|
;; later intervals shifted without the patch that introduced the shift.
|
|
(setq intervals
|
|
(mapcar
|
|
(lambda (patch)
|
|
(list :old-start (plist-get patch :old-start)
|
|
:old-end (plist-get patch :old-end)
|
|
:new-start (plist-get patch :new-start)
|
|
:new-end (plist-get patch :new-end)))
|
|
coordinate-patches))
|
|
(dolist (range previous-owned-ranges)
|
|
(when (gethash (plist-get range :object) owner-set)
|
|
(when-let* ((new-start
|
|
(ebox-surface--rebase-coordinate
|
|
(plist-get range :start) coordinate-patches))
|
|
(new-end
|
|
(ebox-surface--rebase-coordinate
|
|
(plist-get range :end) coordinate-patches)))
|
|
(push (list :old-start (plist-get range :start)
|
|
:old-end (plist-get range :end)
|
|
:new-start (car new-start)
|
|
:new-end (car new-end))
|
|
intervals))))
|
|
(setq intervals
|
|
(sort intervals
|
|
(lambda (left right)
|
|
(< (plist-get left :old-start)
|
|
(plist-get right :old-start)))))
|
|
(let (coalesced)
|
|
(dolist (interval intervals)
|
|
(let ((previous (car coalesced)))
|
|
(if (and previous
|
|
(<= (plist-get interval :old-start)
|
|
(plist-get previous :old-end))
|
|
(<= (plist-get interval :new-start)
|
|
(plist-get previous :new-end)))
|
|
(progn
|
|
(plist-put previous :old-end
|
|
(max (plist-get previous :old-end)
|
|
(plist-get interval :old-end)))
|
|
(plist-put previous :new-end
|
|
(max (plist-get previous :new-end)
|
|
(plist-get interval :new-end))))
|
|
(push (copy-sequence interval) coalesced))))
|
|
(setq intervals (nreverse coalesced)))
|
|
(when intervals
|
|
(let* ((patches
|
|
(mapcar
|
|
(lambda (interval)
|
|
(append
|
|
interval
|
|
(list :replacement
|
|
(substring rendered
|
|
(plist-get interval :new-start)
|
|
(plist-get interval :new-end)))))
|
|
intervals))
|
|
(delta
|
|
(cl-loop for patch in intervals
|
|
sum (- (- (plist-get patch :new-end)
|
|
(plist-get patch :new-start))
|
|
(- (plist-get patch :old-end)
|
|
(plist-get patch :old-start)))))
|
|
(derived-base-extent (- target-extent delta))
|
|
(base-revision (plist-get state :runtime-revision))
|
|
(batch
|
|
(and (= source-extent derived-base-extent)
|
|
;; TP's constructor is the canonical coordinate validator.
|
|
;; A composed local proof may still expose overlapping
|
|
;; owner intervals after all geometry owners are united;
|
|
;; that is a fast-path proof miss, so preserve the normal
|
|
;; Surface plan instead of surfacing an internal batch
|
|
;; construction error to the application.
|
|
(condition-case nil
|
|
(tp-commit-batch-create
|
|
:base-revision base-revision
|
|
:target-revision (1+ base-revision)
|
|
:base-extent source-extent
|
|
:target-extent target-extent
|
|
:patches patches
|
|
:coordinate-patches intervals)
|
|
(tp-surface-error nil)))))
|
|
(when batch
|
|
(prog1
|
|
(tp-commit-batch-result-create
|
|
context batch
|
|
:mount-specs
|
|
(ebox-surface--commit-mount-specs mount-records owned-ranges)
|
|
:client-state state)
|
|
(cl-remf state :content-base-extent))))))))
|
|
|
|
(defun ebox-surface--span-coordinate-result
|
|
(context projection state rendered previous-owned-ranges)
|
|
"Return a direct span commit from retained coordinate metadata, or nil."
|
|
(when-let* ((fragments
|
|
(or (plist-get state :mixed-owner-fragment-data)
|
|
(plist-get state :span-patch-fragment-data)))
|
|
(patches (plist-get state :content-coordinate-patches))
|
|
(rebased
|
|
(and previous-owned-ranges
|
|
(ebox-surface--rebase-owned-ranges
|
|
previous-owned-ranges patches (length rendered))))
|
|
(surface-root (plist-get projection :surface-root))
|
|
(fragment-root
|
|
(tp-object-ensure context surface-root
|
|
ebox-surface--fragments-key 'ebox/fragments))
|
|
(text-leaf
|
|
(tp-object-ensure context fragment-root
|
|
ebox-surface--text-key 'ebox/text)))
|
|
(let* ((owned-ranges (cdr rebased))
|
|
(rendered-length (length rendered))
|
|
(mount-records
|
|
(list (list :object text-leaf :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf t)
|
|
(list :object fragment-root :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf nil)
|
|
(list :object surface-root :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf nil)))
|
|
(result
|
|
(ebox-surface--coordinate-commit
|
|
context state rendered owned-ranges mount-records
|
|
previous-owned-ranges)))
|
|
(when result
|
|
(plist-put state :surface-owned-ranges
|
|
(ebox-surface--snapshot-owned-ranges owned-ranges))
|
|
(plist-put state :surface-fragments fragments)
|
|
(cl-remf state :previous-surface-owned-ranges)
|
|
(cl-remf state :mixed-owner-fragment-data)
|
|
(cl-remf state :mixed-owner-content-p)
|
|
(cl-remf state :span-patch-fragment-data)
|
|
(cl-remf state :span-patch-content-p)
|
|
result))))
|
|
|
|
(defun ebox-surface--mounted-object-for-node (state node-id)
|
|
"Return NODE-ID's nearest live retained object with mounts in STATE."
|
|
(let ((objects (plist-get state :surface-node-object-table))
|
|
(parents (plist-get state :parent-table))
|
|
object)
|
|
(while (and node-id
|
|
(progn
|
|
(setq object (and objects (gethash node-id objects)))
|
|
(or (not object) (not (tp-object-mounted-p object)))))
|
|
(setq node-id (and parents (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)
|
|
(ebox-surface--settle-native-session
|
|
old-state state-overrides surface success)
|
|
(when (and signals-created-p (not success))
|
|
(ebox-surface--dispose-signals signals))))))))
|
|
|
|
(defun ebox-surface--clear-runtime-attachments (root)
|
|
"Clear TP handles and render-cache attachments below ROOT."
|
|
(cl-labels
|
|
((visit (node)
|
|
(when (and (listp node) (not (stringp node)))
|
|
(when (plist-member node :surface-object)
|
|
(plist-put node :surface-object nil))
|
|
(when (plist-member node :render-cache)
|
|
(plist-put node :render-cache nil))
|
|
(ebox-tree-for-each-direct-child node #'visit))))
|
|
(visit root))
|
|
root)
|
|
|
|
(defun ebox-surface--candidate-root
|
|
(source preserve-identities-p &optional validated-p)
|
|
"Return an isolated runtime copy of SOURCE.
|
|
When PRESERVE-IDENTITIES-P is non-nil, retain existing Ebox node and region
|
|
identities while always discarding TP handles and render-cache attachments.
|
|
VALIDATED-P means the caller owns a current topology certificate for SOURCE."
|
|
(unless (and (listp source) (not (stringp source)))
|
|
(error "Ebox surface source must be an Ebox node"))
|
|
(unless validated-p
|
|
(ebox-tree-validate-declarative-root
|
|
source t ebox--render-root-parent-kind))
|
|
(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 &optional positional-p)
|
|
"Return NODE's namespaced sibling key, or nil for positional identity."
|
|
(when-let* ((key (and (not positional-p)
|
|
(not (plist-get node :ebox-sequence-location))
|
|
(plist-get node :key))))
|
|
(list 'ebox/key key)))
|
|
|
|
(defun ebox-surface--node-kind (node)
|
|
"Return the TP kind discriminator for Ebox NODE."
|
|
(list 'ebox/node (plist-get node :ebox-type)))
|
|
|
|
(defun ebox-surface--node-style-binding
|
|
(object node subject bindings-by-subject states-by-subject style-state-table
|
|
stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p)
|
|
"Install and return NODE style binding on OBJECT for SUBJECT."
|
|
(let* ((parent (ecss-subject-parent subject))
|
|
(parent-binding (and parent (gethash parent bindings-by-subject)))
|
|
(parent-style-state (and parent (gethash parent states-by-subject)))
|
|
(declarations (ebox-style-node-declarations node))
|
|
(old-state (gethash object style-state-table))
|
|
(old-binding (and old-state (plist-get old-state :binding)))
|
|
(selector-context-stable-p
|
|
(and old-state
|
|
(or (eq selector-tree-token
|
|
(plist-get old-state :selector-tree-token))
|
|
(and stylesheet-subject-local-p
|
|
(ebox-surface--subject-local-equal-p
|
|
subject (plist-get old-state :subject))))))
|
|
(old-parent-style
|
|
(and old-state
|
|
(plist-get old-state :parent-binding)
|
|
(tp-binding-last-value
|
|
(plist-get old-state :parent-binding))))
|
|
(new-parent-style
|
|
(and parent-binding (tp-binding-last-value parent-binding)))
|
|
(theme-explicit-delta-style
|
|
(and old-state old-binding
|
|
selector-context-stable-p
|
|
(equal stylesheet-signature
|
|
(plist-get old-state :stylesheet-signature))
|
|
(ebox-style--theme-delta-computed
|
|
(tp-binding-last-value old-binding)
|
|
(plist-get old-state :declarations)
|
|
declarations
|
|
old-parent-style
|
|
new-parent-style)))
|
|
(theme-parent-delta-style
|
|
(and old-state old-binding
|
|
(equal (plist-get old-state :declarations)
|
|
declarations)
|
|
selector-context-stable-p
|
|
(equal stylesheet-signature
|
|
(plist-get old-state :stylesheet-signature))
|
|
(ebox-style--theme-parent-delta-computed
|
|
(tp-binding-last-value old-binding)
|
|
declarations old-parent-style new-parent-style)))
|
|
(theme-delta-style
|
|
(or theme-explicit-delta-style theme-parent-delta-style))
|
|
(theme-parent-delta-p
|
|
(and (null theme-explicit-delta-style)
|
|
theme-parent-delta-style))
|
|
(reused-p
|
|
(and old-state
|
|
(not (plist-get node :ebox-candidate-computed-style-p))
|
|
(null theme-delta-style)
|
|
selector-context-stable-p
|
|
(equal declarations (plist-get old-state :declarations))
|
|
(eq parent-binding (plist-get old-state :parent-binding))
|
|
(= (if parent-binding 1 0)
|
|
(or (plist-get old-state
|
|
:inherited-dependency-count)
|
|
-1))
|
|
(equal stylesheet-signature
|
|
(plist-get old-state :stylesheet-signature))))
|
|
(state
|
|
(if reused-p
|
|
(let ((reused-state (copy-sequence old-state)))
|
|
(plist-put reused-state :selector-tree-token
|
|
selector-tree-token)
|
|
(plist-put reused-state :subject subject)
|
|
(plist-put reused-state :parent-style-state
|
|
parent-style-state)
|
|
reused-state)
|
|
(let ((new-state
|
|
(list :selector-tree-token selector-tree-token
|
|
:declarations (copy-tree declarations)
|
|
:parent-binding parent-binding
|
|
:parent-style-state parent-style-state
|
|
:inherited-dependency-count
|
|
(if theme-parent-delta-p
|
|
1
|
|
(if theme-explicit-delta-style
|
|
0
|
|
(if parent-binding 1 0)))
|
|
:stylesheet-signature stylesheet-signature
|
|
:subject subject)))
|
|
(plist-put
|
|
new-state :compute
|
|
(let ((captured new-state)
|
|
(delta-style theme-delta-style)
|
|
(parent-delta-p theme-parent-delta-p)
|
|
(last-style (and old-binding
|
|
(tp-binding-last-value old-binding)))
|
|
(last-parent-style old-parent-style))
|
|
(if parent-delta-p
|
|
(lambda ()
|
|
(let ((parent-style
|
|
(and (plist-get captured :parent-binding)
|
|
(tp-binding-read
|
|
(plist-get captured :parent-binding)))))
|
|
(setq last-style
|
|
(or
|
|
(ebox-style--theme-parent-delta-computed
|
|
last-style
|
|
(plist-get captured :declarations)
|
|
last-parent-style parent-style)
|
|
(ebox-surface--compute-node-style
|
|
(plist-get captured :subject)
|
|
(plist-get captured :declarations)
|
|
parent-style)))
|
|
(setq last-parent-style parent-style)
|
|
last-style))
|
|
(lambda ()
|
|
(or delta-style
|
|
(ebox-surface--compute-node-style
|
|
(plist-get captured :subject)
|
|
(plist-get captured :declarations)
|
|
(and (plist-get captured :parent-binding)
|
|
(tp-binding-read
|
|
(plist-get captured :parent-binding)))))))))
|
|
new-state)))
|
|
(precomputed-style
|
|
(and (not reused-p)
|
|
(or (and (null old-state)
|
|
(plist-get node :ebox-candidate-computed-style-p)
|
|
(plist-get node :ebox-computed-style))
|
|
(and (null old-state)
|
|
(hash-table-p ebox-surface--inline-style-value-cache)
|
|
(ebox-surface--compute-node-style
|
|
subject declarations new-parent-style)))))
|
|
(binding
|
|
(if precomputed-style
|
|
(tp-bind-precomputed
|
|
object 'ebox/computed-style (plist-get state :compute)
|
|
precomputed-style (and parent-binding (list parent-binding)))
|
|
(tp-bind
|
|
object 'ebox/computed-style
|
|
(plist-get state :compute)))))
|
|
(unless reused-p
|
|
(plist-put state :binding binding))
|
|
(puthash object state style-state-table)
|
|
(puthash subject binding bindings-by-subject)
|
|
(puthash subject state states-by-subject)
|
|
(when (plist-get node :ebox-candidate-computed-style-p)
|
|
(cl-remf node :ebox-candidate-computed-style-p))
|
|
binding))
|
|
|
|
(defun ebox-surface--compute-node-style (subject declarations parent-style)
|
|
"Compute one node style, reusing selector-free immutable results."
|
|
(if (not (hash-table-p ebox-surface--inline-style-value-cache))
|
|
(ebox-style-compute-subject subject declarations parent-style)
|
|
(let* ((key (list (ecss-subject-type subject)
|
|
(ecss-subject-id subject)
|
|
(ecss-subject-classes subject)
|
|
(ecss-subject-attributes subject)
|
|
(ecss-subject-states subject)
|
|
declarations
|
|
(ebox-style--inherited-style-signature parent-style)))
|
|
(missing (make-symbol "ebox-inline-style-cache-missing"))
|
|
(cached (gethash key ebox-surface--inline-style-value-cache
|
|
missing)))
|
|
(if (not (eq cached missing))
|
|
cached
|
|
(let ((style
|
|
(ebox-style-compute-subject
|
|
subject declarations parent-style)))
|
|
(puthash key style ebox-surface--inline-style-value-cache)
|
|
style)))))
|
|
|
|
(defun ebox-surface--closed-canonical-node-p (node)
|
|
"Return non-nil when NODE needs only closed inherited style projection."
|
|
(let ((declarations (ebox-style-node-declarations node)))
|
|
(and (eq (plist-get node :ebox-type) 'box)
|
|
(memq (plist-get node :ebox-kind) '(box text))
|
|
(not (ebox-style-cascade-active-p))
|
|
(ebox-style--closed-declarations-p declarations)
|
|
(cl-loop for (property _value) on declarations by #'cddr
|
|
never (ebox-style--custom-property-p property)))))
|
|
|
|
(defun ebox-surface-prepare-inline-candidate-styles
|
|
(old-state candidate-index node-ids)
|
|
"Prepare selector-free computed styles for candidate NODE-IDS.
|
|
|
|
OLD-STATE supplies published immutable computed styles. CANDIDATE-INDEX owns
|
|
the unpublished node and parent tables. Unchanged declaration/subject chains
|
|
reuse their exact prior style; changed nodes compute once against the prepared
|
|
candidate parent style. Stylesheet rules deliberately disable this local
|
|
path because selector scope may extend outside NODE-IDS. Return the prepared
|
|
node-to-subject table when the requested local preparation was completed."
|
|
(let ((stylesheet-signature (ebox-surface--stylesheet-signature)))
|
|
(when (and node-ids
|
|
(ebox-surface--stylesheet-subject-local-p
|
|
stylesheet-signature))
|
|
(let ((old-nodes (plist-get old-state :node-table))
|
|
(new-nodes (plist-get candidate-index :node-table))
|
|
(parents (plist-get candidate-index :parent-table))
|
|
(resolved (make-hash-table :test 'equal))
|
|
(visiting (make-hash-table :test 'equal))
|
|
(subjects-by-id (make-hash-table :test 'equal))
|
|
(subjects-by-node (make-hash-table :test 'eq))
|
|
(ebox-surface--inline-style-value-cache
|
|
(make-hash-table :test 'equal)))
|
|
(cl-labels
|
|
((resolve
|
|
(node-id)
|
|
(let ((missing (make-symbol "ebox-style-unresolved")))
|
|
(let ((cached (gethash node-id resolved missing)))
|
|
(if (not (eq cached missing))
|
|
cached
|
|
(when (gethash node-id visiting)
|
|
(error "Ebox candidate style parent cycle at %S" node-id))
|
|
(puthash node-id t visiting)
|
|
(let* ((node (gethash node-id new-nodes))
|
|
(old-node (gethash node-id old-nodes))
|
|
(parent-id (gethash node-id parents))
|
|
(parent-style (and parent-id (resolve parent-id)))
|
|
(parent-subject
|
|
(and parent-id (gethash parent-id subjects-by-id)))
|
|
(old-parent-id
|
|
(and old-node
|
|
(gethash node-id
|
|
(plist-get old-state :parent-table))))
|
|
(old-parent
|
|
(and old-parent-id
|
|
(gethash old-parent-id old-nodes)))
|
|
(old-parent-style
|
|
(and old-parent
|
|
(plist-get old-parent :ebox-computed-style)))
|
|
(old-style
|
|
(and old-node
|
|
(plist-get old-node :ebox-computed-style)))
|
|
(declarations
|
|
(and node (ebox-style-node-declarations node)))
|
|
(old-declarations
|
|
(and old-node
|
|
(ebox-style-node-declarations old-node)))
|
|
(subject
|
|
(and node
|
|
(or (gethash node-id subjects-by-id)
|
|
(let ((created
|
|
(ebox-tree-node-subject node)))
|
|
(setf (ecss-subject-parent created)
|
|
parent-subject)
|
|
(puthash node-id created subjects-by-id)
|
|
(puthash node created subjects-by-node)
|
|
created))))
|
|
(old-subject
|
|
(and old-node
|
|
(or
|
|
(when-let* ((object
|
|
(plist-get old-node
|
|
:surface-object))
|
|
(state
|
|
(gethash
|
|
object
|
|
(plist-get
|
|
old-state
|
|
:style-binding-states))))
|
|
(plist-get state :subject))
|
|
(ebox-tree-node-subject old-node))))
|
|
(source-stable-p
|
|
(and old-node
|
|
(equal parent-id old-parent-id)
|
|
(eq parent-style old-parent-style)
|
|
(ebox-style-declarations-equal-p
|
|
declarations old-declarations)
|
|
(ebox-surface--subject-local-equal-p
|
|
subject old-subject)))
|
|
(style
|
|
(or (and source-stable-p old-style)
|
|
(and node (not source-stable-p)
|
|
(or parent-style
|
|
declarations)
|
|
(ebox-surface--compute-node-style
|
|
subject declarations
|
|
parent-style)))))
|
|
(when (and node style (not (eq node old-node)))
|
|
(cond
|
|
(source-stable-p)
|
|
((and (null (plist-get node :ebox-computed-style))
|
|
(ebox-surface--closed-canonical-node-p node))
|
|
(ebox-style-apply-closed-inheritance node style))
|
|
(t
|
|
(ebox-style-apply-computed node style)))
|
|
(plist-put node :ebox-computed-style style)
|
|
(plist-put node :ebox-candidate-computed-style-p t))
|
|
(remhash node-id visiting)
|
|
(puthash node-id style resolved)
|
|
style))))))
|
|
(dolist (node-id node-ids)
|
|
(when (gethash node-id new-nodes)
|
|
(resolve node-id))))
|
|
subjects-by-node))))
|
|
|
|
(defun ebox-surface--node-style-binding-required-p (node)
|
|
"Return non-nil when selector-free NODE needs its own style binding."
|
|
(let ((declarations (ebox-style-node-declarations node)))
|
|
(or (ebox-surface--style-consuming-node-p node)
|
|
(cl-some (lambda (property)
|
|
(plist-member declarations property))
|
|
ebox-surface--inherited-style-properties)
|
|
(cl-loop for (property _value) on declarations by #'cddr
|
|
thereis (and (symbolp property)
|
|
(string-prefix-p "--" (symbol-name property)))))))
|
|
|
|
(defun ebox-surface--apply-node-style
|
|
(object node subject-table bindings-by-subject states-by-subject
|
|
style-state-table
|
|
stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p)
|
|
"Compute and apply NODE style using retained OBJECT and SUBJECT-TABLE."
|
|
(when-let* ((subject (gethash node subject-table)))
|
|
(if (and (hash-table-p ebox-surface--inline-style-value-cache)
|
|
(not (ebox-surface--node-style-binding-required-p node)))
|
|
(when-let* ((parent (ecss-subject-parent subject))
|
|
(binding (gethash parent bindings-by-subject)))
|
|
(puthash subject binding bindings-by-subject)
|
|
(when-let* ((state (gethash parent states-by-subject)))
|
|
(puthash subject state states-by-subject))
|
|
(let ((style (tp-binding-read binding)))
|
|
(unless (equal style (plist-get node :ebox-computed-style))
|
|
(ebox-style-apply-closed-inheritance node style))))
|
|
(let ((style
|
|
(tp-binding-read
|
|
(ebox-surface--node-style-binding
|
|
object node subject bindings-by-subject states-by-subject
|
|
style-state-table
|
|
stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p))))
|
|
(unless (equal style (plist-get node :ebox-computed-style))
|
|
(if (and (null (plist-get node :ebox-computed-style))
|
|
(ebox-surface--closed-canonical-node-p node))
|
|
(ebox-style-apply-closed-inheritance node style)
|
|
(ebox-style-apply-computed node style)))))))
|
|
|
|
(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)))
|
|
(candidate-declarations
|
|
(and candidate-node
|
|
(ebox-style-node-declarations candidate-node)))
|
|
(locally-computed-p
|
|
(and candidate-node
|
|
(plist-get candidate-node
|
|
:ebox-candidate-computed-style-p)
|
|
(ecss-computed-style-p
|
|
(plist-get candidate-node :ebox-computed-style))
|
|
(ebox-style--closed-declarations-p
|
|
candidate-declarations))))
|
|
(and style-state candidate-node subject
|
|
(or locally-computed-p
|
|
(and
|
|
(or (ebox-style-declarations-equal-p
|
|
candidate-declarations
|
|
(plist-get style-state :declarations))
|
|
(ebox-style--paint-declarations-equivalent-p
|
|
(plist-get style-state :declarations)
|
|
candidate-declarations))
|
|
(equal (ebox-tree-node-id candidate-node)
|
|
(ecss-subject-id subject))
|
|
(equal (ebox-tree-node-classes candidate-node)
|
|
(ecss-subject-classes subject))
|
|
(equal (ebox-tree-metadata-string
|
|
(ebox-tree-node-selector-type candidate-node))
|
|
(ecss-subject-type subject))
|
|
(equal
|
|
(mapcar
|
|
(lambda (attribute)
|
|
(cons
|
|
(substring (symbol-name (car attribute)) 1)
|
|
(cdr attribute)))
|
|
(ebox-tree-node-attributes candidate-node))
|
|
(ecss-subject-attributes subject))
|
|
(equal (ebox-tree-node-state candidate-node)
|
|
(ecss-subject-states subject))))
|
|
(equal stylesheet-signature
|
|
(plist-get style-state :stylesheet-signature))
|
|
(ebox-surface--static-style-state-p style-state)))))
|
|
dirty-set))))
|
|
|
|
(defun ebox-surface--ensure-node-tree
|
|
(context parent node table subject-table bindings-by-subject
|
|
states-by-subject style-state-table stylesheet-signature
|
|
selector-tree-token stylesheet-subject-local-p
|
|
&optional parent-kind positional-p)
|
|
"Ensure styled NODE descendants below PARENT in CONTEXT and fill TABLE."
|
|
(ebox--ensure-node-id node)
|
|
(let ((object
|
|
(tp-object-ensure context parent
|
|
(ebox-surface--node-key node positional-p)
|
|
(ebox-surface--node-kind node))))
|
|
(tp-object-retain context object)
|
|
(plist-put node :surface-object object)
|
|
(puthash node object table)
|
|
(when subject-table
|
|
(ebox-surface--apply-node-style
|
|
object node subject-table bindings-by-subject states-by-subject
|
|
style-state-table
|
|
stylesheet-signature selector-tree-token
|
|
stylesheet-subject-local-p))
|
|
(let ((child-kind (ebox-tree--child-layout-kind node parent-kind)))
|
|
(ebox-tree-for-each-direct-child
|
|
node
|
|
(lambda (child)
|
|
(ebox-surface--ensure-node-tree
|
|
context object child table subject-table bindings-by-subject
|
|
states-by-subject style-state-table stylesheet-signature
|
|
selector-tree-token stylesheet-subject-local-p
|
|
child-kind (and (plist-get node :ebox-child-sequence) t)))))
|
|
(when subject-table
|
|
(ebox-tree--validate-node-parent-participation
|
|
node parent-kind 'computed))
|
|
object))
|
|
|
|
(defun ebox-surface--node-object-table (objects-by-node)
|
|
"Return a node-id keyed table from OBJECTS-BY-NODE."
|
|
(let ((table (make-hash-table :test 'equal)))
|
|
(maphash
|
|
(lambda (node object)
|
|
(let ((node-id (if (listp node)
|
|
(plist-get node :node-id)
|
|
node)))
|
|
(unless node-id
|
|
(error "Ebox rendered node has no runtime identity"))
|
|
(puthash node-id object table)))
|
|
objects-by-node)
|
|
table))
|
|
|
|
(defun ebox-surface--region-object-table (state node-objects)
|
|
"Return region-to-object table from candidate STATE and NODE-OBJECTS."
|
|
(let ((table (make-hash-table :test 'equal)))
|
|
(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))
|
|
(_ nil)))
|
|
|
|
(defun ebox-surface--logical-id-region-table (state region-objects)
|
|
"Return root-scoped logical-id entries for STATE and REGION-OBJECTS."
|
|
(let ((table (make-hash-table :test 'equal)))
|
|
(maphash
|
|
(lambda (logical-id entries)
|
|
(dolist (entry entries)
|
|
(when-let* ((region-id
|
|
(ebox-surface--node-editable-region-id (car entry)))
|
|
(object (gethash region-id region-objects)))
|
|
(push (cons object region-id) (gethash logical-id table)))))
|
|
(plist-get state :selector-id-table))
|
|
(maphash (lambda (logical-id matches)
|
|
(puthash logical-id (nreverse matches) table))
|
|
table)
|
|
table))
|
|
|
|
(defun ebox-surface--hash-keys (table)
|
|
"Return TABLE keys in unspecified order."
|
|
(let (keys)
|
|
(maphash (lambda (key _value) (push key keys)) table)
|
|
keys))
|
|
|
|
(defun ebox-surface--retained-scroll-lookahead (state)
|
|
"Return lookahead needed to retain STATE's prepared lazy prefixes."
|
|
(when-let* ((table (plist-get state :scroll-state-table)))
|
|
(let ((maximum 0))
|
|
(maphash
|
|
(lambda (_region-id scroll-state)
|
|
(let ((retained (length (plist-get scroll-state :content-lines)))
|
|
(offset (or (plist-get scroll-state :scroll-offset) 0))
|
|
(height (or (plist-get scroll-state :content-height) 0)))
|
|
(setq maximum
|
|
(max maximum (- retained offset height 1)))))
|
|
table)
|
|
(max 0 maximum))))
|
|
|
|
(defun ebox-surface--scroll-metadata-snapshot (table producer-region-ids)
|
|
"Return reusable lazy-scroll metadata copied from TABLE.
|
|
PRODUCER-REGION-IDS names scroll-only updates whose producer closures remain
|
|
valid because their declarative layout and viewport did not change."
|
|
(let ((snapshot (make-hash-table :test 'equal)))
|
|
(maphash
|
|
(lambda (region-id state)
|
|
(let ((preserve-producer-p
|
|
(member region-id producer-region-ids))
|
|
(producer-keys
|
|
'(:content-lines :rendered-content-lines
|
|
:content-lines-complete-p :render-content-prefix
|
|
:materialize-content-lines :region-line-bounds-index
|
|
:region-line-span-index :region-line-span-index-deferred
|
|
:rendered-region-line-span-index
|
|
:rendered-region-line-span-index-deferred
|
|
:region-line-span-hints :cache-miss-prefetch-target-lines
|
|
:native-reflow-target-prefix-p
|
|
:native-reflow-prefix-reset-p :native-reflow-visible-offset
|
|
:native-reflow-visible-lines))
|
|
metadata)
|
|
(dolist (key (append
|
|
'(:content-region-id-set :lazy-scroll-prefix-dirty
|
|
:lazy-scroll-window-refresh-required)
|
|
(and preserve-producer-p producer-keys)))
|
|
(when (if (memq key producer-keys)
|
|
(plist-member state key)
|
|
(plist-get state key))
|
|
(setq metadata
|
|
(plist-put metadata key (plist-get state key)))))
|
|
(when metadata
|
|
(puthash region-id metadata snapshot))))
|
|
table)
|
|
snapshot))
|
|
|
|
(defun ebox-surface--restore-scroll-metadata (table snapshot)
|
|
"Restore reusable lazy-scroll SNAPSHOT fields into TABLE."
|
|
(maphash
|
|
(lambda (region-id metadata)
|
|
(when-let* ((state (gethash region-id table)))
|
|
(while metadata
|
|
(setq state
|
|
(plist-put state (pop metadata) (pop metadata))))
|
|
(puthash region-id state table)))
|
|
snapshot))
|
|
|
|
(defun ebox-surface--render-candidate (state)
|
|
"Render candidate STATE or optional NODE in isolated side tables."
|
|
(ebox-surface--render-candidate-node state (plist-get state :root-node)))
|
|
|
|
(defun ebox-surface--render-candidate-node (state node)
|
|
"Render NODE from candidate STATE in isolated Ebox side tables."
|
|
(let ((scroll-table
|
|
(or (plist-get state :scroll-state-table)
|
|
(make-hash-table :test 'equal)))
|
|
(scroll-metadata
|
|
(ebox-surface--scroll-metadata-snapshot
|
|
(or (plist-get state :scroll-state-table)
|
|
(make-hash-table :test 'equal))
|
|
(plist-get state :preserve-scroll-producer-region-ids)))
|
|
(timer-table (make-hash-table :test 'equal))
|
|
(smooth-table (make-hash-table :test 'equal)))
|
|
(cl-remf state :preserve-scroll-producer-region-ids)
|
|
(cl-remf state :native-render-p)
|
|
(cl-remf state :native-render-output)
|
|
(cl-remf state :native-render-fragments)
|
|
(cl-remf state :native-render-frame)
|
|
(cl-remf state :native-render-fragment-template)
|
|
(cl-remf state :native-render-fallback)
|
|
(let ((ebox-viewport-width (plist-get state :viewport-width))
|
|
(ebox-viewport-height (plist-get state :viewport-height))
|
|
(ebox--render-display-signature
|
|
(plist-get state :display-signature))
|
|
(ebox--region-box-table (plist-get state :region-box-table))
|
|
(ebox--scroll-global-state scroll-table)
|
|
(ebox--scroll-idle-prefetch-timers timer-table)
|
|
(ebox--smooth-scroll-state-table smooth-table)
|
|
(ebox--render-runtime-revision
|
|
(plist-get state :runtime-revision))
|
|
(ebox--render-cache-table (plist-get state :render-cache))
|
|
(ebox--layout-fragments-table
|
|
(plist-get state :layout-fragments))
|
|
(ebox--layout-fragments-reuse-p
|
|
(plist-get state :layout-fragments-reuse-p))
|
|
(ebox--render-cache-signature-cache
|
|
(plist-get state :render-signature-cache))
|
|
(ebox--scroll-window-initial-lookahead-lines-override
|
|
(ebox-surface--retained-scroll-lookahead state))
|
|
(ebox--viewport-dependent-node-ids-cache
|
|
(make-hash-table :test 'eq))
|
|
(ebox--viewport-dependent-subtree-cache
|
|
(make-hash-table :test 'eq))
|
|
(ebox--viewport-height-dependent-subtree-cache
|
|
(plist-get state :viewport-height-dependent-subtree-cache))
|
|
(ebox--flex-content-min-width-table
|
|
(plist-get state :flex-content-min-widths))
|
|
(ebox--paint-origin-capture-p t)
|
|
(ebox--render-owned-text-values
|
|
(make-hash-table :test #'eq)))
|
|
(cl-letf (((symbol-function 'ebox--scroll-schedule-idle-prefetch)
|
|
(lambda (&rest _) nil)))
|
|
(when (and (require 'ebox-native-commit nil t)
|
|
(not (ebox-surface--runtime-index-ready-p state)))
|
|
(setq state (ebox-surface--finish-runtime-state state)))
|
|
(let ((rendered
|
|
(or (and (require 'ebox-native-commit nil t)
|
|
(ebox-native-commit-render state node))
|
|
(let ((ebox--surface-materialization-active t))
|
|
(ebox--render-layout node)))))
|
|
(unless (plist-get state :native-render-p)
|
|
(ebox--record-render-output-provenance rendered))
|
|
(ebox-surface--restore-scroll-metadata
|
|
scroll-table scroll-metadata)
|
|
(plist-put state :scroll-state-table scroll-table)
|
|
(plist-put state :scroll-region-ids
|
|
(ebox-surface--hash-keys scroll-table))
|
|
(plist-put state :render-owned-text-values
|
|
ebox--render-owned-text-values)
|
|
rendered)))))
|
|
|
|
(defun ebox-surface--attach-retained-node-objects (state)
|
|
"Attach retained TP objects to candidate nodes in STATE."
|
|
(let ((nodes (plist-get state :node-table))
|
|
(objects (plist-get state :surface-node-object-table)))
|
|
(when (and (hash-table-p nodes) (hash-table-p objects))
|
|
(maphash
|
|
(lambda (node-id object)
|
|
(when-let* ((node (gethash node-id nodes)))
|
|
(plist-put node :surface-object object)))
|
|
objects))
|
|
state))
|
|
|
|
(defun ebox-surface--apply-retained-owner-styles (state)
|
|
"Apply retained static computed styles to owner-scoped nodes in STATE."
|
|
(let* ((proofs (plist-get state :owner-scoped-proofs))
|
|
(owner-ids
|
|
(or (mapcar (lambda (proof) (plist-get proof :owner-id)) proofs)
|
|
(and (plist-get state :span-patch-owner-id)
|
|
(list (plist-get state :span-patch-owner-id)))))
|
|
(nodes (plist-get state :node-table))
|
|
(objects (plist-get state :surface-node-object-table))
|
|
(style-states (plist-get state :style-binding-states)))
|
|
(dolist (owner-id owner-ids)
|
|
(when-let* ((node (and nodes (gethash owner-id nodes)))
|
|
(object (and objects (gethash owner-id objects)))
|
|
(style-state (and style-states
|
|
(gethash object style-states)))
|
|
(binding (plist-get style-state :binding)))
|
|
(ebox-style-apply-computed node (tp-binding-read binding))))
|
|
(when owner-ids
|
|
(ebox-tree-validate-indexed-participation
|
|
nodes (plist-get state :parent-table) owner-ids 'computed))
|
|
state))
|
|
|
|
(defun ebox-surface--rendered-role-topology-signature
|
|
(rendered region-ids)
|
|
"Return rendered Ebox role topology for REGION-IDS in RENDERED."
|
|
(let ((wanted (make-hash-table :test 'equal))
|
|
(roles-table (make-hash-table :test 'eq))
|
|
(position 0)
|
|
(limit (length rendered)))
|
|
(dolist (region-id region-ids)
|
|
(puthash region-id t wanted))
|
|
(while (< position limit)
|
|
(dolist (entry (ebox-surface--role-ids-at rendered position))
|
|
(when (gethash (cdr entry) wanted)
|
|
(puthash (car entry) t roles-table)))
|
|
(setq position
|
|
(max (or (next-property-change position rendered limit) limit)
|
|
(1+ position))))
|
|
(let (roles)
|
|
(maphash (lambda (role _value) (push role roles)) roles-table)
|
|
(list :roles
|
|
(sort roles
|
|
(lambda (left right)
|
|
(string< (symbol-name left)
|
|
(symbol-name right))))))))
|
|
|
|
(defun ebox-surface--span-patch-lines
|
|
(buffer spans rendered &optional variable-content-p
|
|
variable-content-max-width owner-set)
|
|
"Return RENDERED shaped for BUFFER SPANS, or nil when unsafe.
|
|
When VARIABLE-CONTENT-P is non-nil, allow a stable partial slot to retain its
|
|
old allocated width while the owner changes its natural content length."
|
|
(with-current-buffer buffer
|
|
(if (ebox-buffer--partial-line-slots-p spans)
|
|
(if variable-content-p
|
|
(let ((lines (ebox-string-lines rendered)))
|
|
(when (and (= (length spans) (length lines))
|
|
(or (null variable-content-max-width)
|
|
(cl-every
|
|
(lambda (line)
|
|
(<= (ebox--string-pixel-width line)
|
|
variable-content-max-width))
|
|
lines)))
|
|
rendered))
|
|
(ebox-buffer--rendered-in-existing-slots
|
|
spans rendered owner-set t))
|
|
(and (= (length spans) (length (ebox-string-lines rendered)))
|
|
rendered))))
|
|
|
|
(defun ebox-surface--projected-span-positions (spans lines)
|
|
"Return BUFFER span positions after replacing SPANS with LINES."
|
|
(when (= (length spans) (length lines))
|
|
(let ((delta 0) result)
|
|
(cl-loop for span in spans
|
|
for line in lines
|
|
do (let* ((start (+ (car span) delta))
|
|
(end (+ start (length line))))
|
|
(push (cons start end) result)
|
|
(setq delta
|
|
(+ delta (- (length line)
|
|
(- (cdr span) (car span)))))))
|
|
(nreverse result))))
|
|
|
|
(defun ebox-surface--replace-buffer-spans
|
|
(source origin spans lines)
|
|
"Return SOURCE with buffer SPANS replaced by propertized LINES."
|
|
(catch 'invalid
|
|
(let ((cursor origin) pieces)
|
|
(cl-loop for span in spans
|
|
for line in lines
|
|
do (let ((start (car span)) (end (cdr span)))
|
|
(when (or (< start cursor) (< end start))
|
|
(throw 'invalid nil))
|
|
(push (substring source (- cursor origin) (- start origin))
|
|
pieces)
|
|
(push line pieces)
|
|
(setq cursor end)))
|
|
(push (substring source (- cursor origin)) pieces)
|
|
(apply #'concat (nreverse pieces)))))
|
|
|
|
(defun ebox-surface--span-patch-details
|
|
(_buffer snapshot node spans rendered
|
|
&optional variable-content-p variable-content-max-width)
|
|
"Return validated replacement details for SNAPSHOT and RENDERED."
|
|
(let* ((lines (ebox-string-lines rendered))
|
|
(new-spans (ebox-surface--projected-span-positions spans lines))
|
|
(old-footprint (plist-get snapshot :span-footprint-signature))
|
|
(new-footprint
|
|
(and new-spans (ebox--rendered-span-footprint-signature rendered)))
|
|
(new-external
|
|
(and new-footprint
|
|
(ebox--external-footprint-signature-from-span-footprint
|
|
new-footprint)))
|
|
(new-parent
|
|
(and new-footprint
|
|
(ebox--project-parent-slot-signature
|
|
(plist-get snapshot :parent-slot-signature)
|
|
new-footprint)))
|
|
(new-roles
|
|
(and new-spans
|
|
(ebox-surface--rendered-role-topology-signature
|
|
rendered (plist-get snapshot :region-ids))))
|
|
(new-overflow (ebox--overflow-signature node)))
|
|
(when (and old-footprint new-footprint
|
|
(if variable-content-p
|
|
(and (= (plist-get old-footprint :span-count)
|
|
(plist-get new-footprint :span-count))
|
|
(or (null variable-content-max-width)
|
|
(<= (or (plist-get new-external
|
|
:max-line-pixel-width)
|
|
0)
|
|
variable-content-max-width)))
|
|
(and (ebox--span-footprint-compatible-p
|
|
old-footprint new-footprint)
|
|
(ebox--external-footprint-compatible-p
|
|
(plist-get snapshot :external-footprint-signature)
|
|
new-external)
|
|
(ebox--parent-slot-compatible-p
|
|
(plist-get snapshot :parent-slot-signature)
|
|
new-parent)))
|
|
(equal (plist-get snapshot :role-topology-signature)
|
|
new-roles)
|
|
(equal (plist-get snapshot :overflow-signature)
|
|
new-overflow))
|
|
(list :lines lines :spans new-spans :footprint new-footprint
|
|
:external new-external :parent new-parent :roles new-roles
|
|
:overflow new-overflow
|
|
:variable-content-p variable-content-p))))
|
|
|
|
(defun ebox-surface--install-span-patch-snapshot
|
|
(state owner-id snapshot details &optional generation-override)
|
|
"Install DETAILS for OWNER-ID into candidate STATE snapshots."
|
|
(let* ((current-generation
|
|
(or (plist-get state :layout-snapshot-detail-generation) 0))
|
|
(old-footprint (plist-get snapshot :span-footprint-signature))
|
|
(new-footprint (plist-get details :footprint))
|
|
(coordinates-stable-p
|
|
(equal (plist-get old-footprint :char-lengths)
|
|
(plist-get new-footprint :char-lengths)))
|
|
(generation (or generation-override
|
|
(if coordinates-stable-p
|
|
current-generation
|
|
(1+ current-generation))))
|
|
(updated (copy-sequence snapshot))
|
|
(spans (plist-get details :spans))
|
|
(footprint new-footprint))
|
|
(dolist (entry `((:buffer-span . ,(car spans))
|
|
(:buffer-spans . ,spans)
|
|
(:line-signature . ,(plist-get footprint
|
|
:line-pixel-widths))
|
|
(:span-footprint-signature . ,footprint)
|
|
(:external-footprint-signature
|
|
. ,(plist-get details :external))
|
|
(:parent-slot-signature
|
|
. ,(if (plist-get details :variable-content-p)
|
|
(plist-get snapshot :parent-slot-signature)
|
|
(plist-get details :parent)))
|
|
(:role-topology-signature . ,(plist-get details :roles))
|
|
(:overflow-signature . ,(plist-get details :overflow))
|
|
(:detail-generation . ,generation)))
|
|
(setq updated (plist-put updated (car entry) (cdr entry))))
|
|
(puthash owner-id updated (plist-get state :layout-snapshots))
|
|
(plist-put state :layout-snapshot-detail-generation generation)
|
|
(plist-put state :layout-snapshots-complete-p nil)
|
|
(when-let* ((proof
|
|
(cl-find owner-id
|
|
(plist-get state :allocation-certificate-proofs)
|
|
:key (lambda (candidate)
|
|
(plist-get candidate :owner-id))
|
|
:test #'equal))
|
|
(signature (plist-get proof :ancestor-slot-signature)))
|
|
(let ((certificates
|
|
(or (plist-get state :retained-allocation-certificates)
|
|
(make-hash-table :test 'equal))))
|
|
(puthash
|
|
owner-id
|
|
(list :root-id
|
|
(plist-get (plist-get state :root-node) :node-id)
|
|
:viewport-width (plist-get state :viewport-width)
|
|
:viewport-height (plist-get state :viewport-height)
|
|
:display-signature
|
|
(copy-tree (plist-get state :display-signature))
|
|
:signature (copy-tree signature))
|
|
certificates)
|
|
(plist-put state :retained-allocation-certificates certificates)))
|
|
state))
|
|
|
|
(defun ebox-surface--allocation-owner-line-signature (lines region-ids)
|
|
"Return local content-owner run signatures for propertized LINES."
|
|
(let ((local (ebox--region-id-set region-ids)))
|
|
(mapcar
|
|
(lambda (line)
|
|
(let ((position 0) (limit (length line)) previous runs)
|
|
(while (< position limit)
|
|
(let* ((owners
|
|
(copy-sequence
|
|
(or (get-text-property position
|
|
'ebox-content-owners line)
|
|
nil)))
|
|
(owner (get-text-property position
|
|
'ebox-content-owner line))
|
|
(stack (if (and owner (not (member owner owners)))
|
|
(append owners (list owner))
|
|
owners))
|
|
(local-stack
|
|
(cl-remove-if-not (lambda (id) (gethash id local)) stack))
|
|
(next (or (next-property-change position line limit)
|
|
limit)))
|
|
(unless (equal local-stack previous)
|
|
(push local-stack runs)
|
|
(setq previous local-stack))
|
|
(setq position (max (1+ position) next))))
|
|
(nreverse runs)))
|
|
lines)))
|
|
|
|
(defun ebox-surface--retained-external-owner-suffix
|
|
(buffer spans region-ids)
|
|
"Return one common retained content-owner suffix outside REGION-IDS."
|
|
(let ((local (ebox--region-id-set region-ids)) common seen valid)
|
|
(setq valid t)
|
|
(with-current-buffer buffer
|
|
(dolist (span spans)
|
|
(let ((position (car span)) (limit (cdr span)))
|
|
(while (and valid (< position limit))
|
|
(let* ((owners
|
|
(copy-sequence
|
|
(or (get-text-property position 'ebox-content-owners)
|
|
nil)))
|
|
(owner (get-text-property position 'ebox-content-owner))
|
|
(stack (if (and owner (not (member owner owners)))
|
|
(append owners (list owner)) owners))
|
|
(external
|
|
(cl-remove-if (lambda (id) (gethash id local)) stack))
|
|
(next (or (next-property-change position nil limit)
|
|
limit)))
|
|
(when stack
|
|
(if seen
|
|
(unless (equal common external) (setq valid nil))
|
|
(setq common external seen t)))
|
|
(setq position (max (1+ position) next)))))))
|
|
(and valid seen common)))
|
|
|
|
(defun ebox-surface--owner-patch-candidate
|
|
(buffer state owner-id allocated-width
|
|
&optional variable-content-p variable-content-max-width
|
|
role-owned-lines-p changed-keys allocation-closure-p
|
|
retain-external-owner-suffix-p)
|
|
"Return validated patch details for OWNER-ID, or nil."
|
|
(let* (
|
|
(old-snapshot
|
|
(and owner-id (ebox--ensure-layout-snapshot-details buffer owner-id)))
|
|
(spans (and old-snapshot (plist-get old-snapshot :buffer-spans)))
|
|
(node (and owner-id (gethash owner-id (plist-get state :node-table))))
|
|
(parent-id (and owner-id
|
|
(gethash owner-id (plist-get state :parent-table))))
|
|
(parent (and parent-id
|
|
(gethash parent-id (plist-get state :node-table))))
|
|
(slot-sized-render-p
|
|
(and role-owned-lines-p parent
|
|
(eq (ebox-tree-display-inner parent) 'flex)))
|
|
(render-node
|
|
(if slot-sized-render-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)))
|
|
;; Variable content is explicitly shaped into a retained slot.
|
|
;; Typography-only changes must render at their natural size so
|
|
;; the final footprint check observes any intrinsic-width change
|
|
;; instead of hiding it behind the old allocation.
|
|
(if (and node allocated-width variable-content-p)
|
|
(plist-put (copy-sequence node) :width allocated-width)
|
|
node))))
|
|
(when (and old-snapshot spans node render-node)
|
|
(let* ((rendered
|
|
(prog1
|
|
(ebox-surface--render-candidate-node state render-node)
|
|
(when (and allocation-closure-p (not (eq render-node node)))
|
|
(ebox--flex-recache-source-boxes node))))
|
|
(region-ids (plist-get old-snapshot :region-ids))
|
|
(old-allocation-signature
|
|
(and allocation-closure-p
|
|
(with-current-buffer buffer
|
|
(ebox-surface--allocation-owner-line-signature
|
|
(mapcar (lambda (span)
|
|
(buffer-substring (car span) (cdr span)))
|
|
spans)
|
|
region-ids))))
|
|
(new-allocation-signature
|
|
(and allocation-closure-p
|
|
(ebox-surface--allocation-owner-line-signature
|
|
(ebox-string-lines rendered) region-ids)))
|
|
(owned-rendered
|
|
(if role-owned-lines-p
|
|
(ebox-buffer--rendered-owned-lines
|
|
rendered region-ids
|
|
(length spans))
|
|
rendered))
|
|
(owned-rendered
|
|
(if allocation-closure-p
|
|
(and (equal old-allocation-signature
|
|
new-allocation-signature)
|
|
owned-rendered)
|
|
owned-rendered))
|
|
(owned-rendered
|
|
(if (or allocation-closure-p
|
|
retain-external-owner-suffix-p)
|
|
(and owned-rendered
|
|
(when-let* ((owners
|
|
(ebox-surface--retained-external-owner-suffix
|
|
buffer spans region-ids)))
|
|
(ebox--add-content-owners owned-rendered owners)))
|
|
owned-rendered))
|
|
(replacement
|
|
(and owned-rendered
|
|
(ebox-surface--span-patch-lines
|
|
buffer spans owned-rendered variable-content-p
|
|
variable-content-max-width
|
|
(and role-owned-lines-p
|
|
(ebox--region-id-set
|
|
(plist-get old-snapshot :region-ids))))))
|
|
(details
|
|
(and replacement
|
|
(ebox-surface--span-patch-details
|
|
buffer old-snapshot node spans replacement
|
|
variable-content-p variable-content-max-width))))
|
|
(and details
|
|
(list :owner-id owner-id :snapshot old-snapshot
|
|
:old-spans spans :details details))))))
|
|
|
|
(defun ebox-surface--range-patch-candidate (buffer state proof)
|
|
"Return PROOF's exact equal-line Range replacement candidate, or nil."
|
|
(let* ((owner-id (plist-get proof :owner-id))
|
|
(old-snapshot (plist-get proof :snapshot))
|
|
(spans (plist-get old-snapshot :buffer-spans))
|
|
(node (gethash owner-id (plist-get state :node-table)))
|
|
(render-node
|
|
(if (and node (numberp (plist-get proof :allocated-width)))
|
|
(plist-put (copy-sequence node)
|
|
:width (plist-get proof :allocated-width))
|
|
node))
|
|
(rendered
|
|
(and render-node
|
|
(ebox-surface--render-candidate-node state render-node)))
|
|
(external-owners
|
|
(and rendered
|
|
(ebox-surface--retained-external-owner-suffix
|
|
buffer spans (plist-get old-snapshot :region-ids))))
|
|
(rendered
|
|
(and external-owners
|
|
(ebox--add-content-owners rendered external-owners)))
|
|
(replacement
|
|
(and rendered
|
|
(ebox-buffer--rendered-in-existing-slots
|
|
spans rendered nil t)))
|
|
(lines (and replacement (ebox-string-lines replacement)))
|
|
(new-spans
|
|
(and lines (ebox-surface--projected-span-positions spans lines)))
|
|
(new-footprint
|
|
(and new-spans
|
|
(ebox--rendered-span-footprint-signature replacement)))
|
|
(new-external
|
|
(and new-footprint
|
|
(ebox--external-footprint-signature-from-span-footprint
|
|
new-footprint)))
|
|
(new-parent
|
|
(and new-footprint
|
|
(ebox--project-parent-slot-signature
|
|
(plist-get old-snapshot :parent-slot-signature)
|
|
new-footprint)))
|
|
(new-region-ids (and node (ebox--node-all-region-ids node)))
|
|
(new-roles
|
|
(and replacement
|
|
(ebox-surface--rendered-role-topology-signature
|
|
replacement new-region-ids)))
|
|
(new-overflow (and node (ebox--overflow-signature node))))
|
|
(when (and owner-id old-snapshot spans node replacement new-spans
|
|
new-footprint new-region-ids new-roles
|
|
(ebox--span-footprint-compatible-p
|
|
(plist-get old-snapshot :span-footprint-signature)
|
|
new-footprint)
|
|
(ebox--external-footprint-compatible-p
|
|
(plist-get old-snapshot :external-footprint-signature)
|
|
new-external)
|
|
(ebox--parent-slot-compatible-p
|
|
(plist-get old-snapshot :parent-slot-signature)
|
|
new-parent)
|
|
(equal (plist-get old-snapshot :overflow-signature)
|
|
new-overflow))
|
|
(let ((snapshot (copy-sequence old-snapshot)))
|
|
(plist-put snapshot :region-ids new-region-ids)
|
|
(plist-put snapshot :role-topology-signature new-roles)
|
|
(list :owner-id owner-id :snapshot snapshot :old-spans spans
|
|
:range-splice-p t
|
|
:details
|
|
(list :lines lines :spans new-spans :footprint new-footprint
|
|
:external new-external :parent new-parent :roles new-roles
|
|
:overflow new-overflow :variable-content-p nil))))))
|
|
|
|
(defun ebox-surface--span-patch-output (buffer previous-state state)
|
|
"Return a proven single- or multi-owner local patch output, or nil."
|
|
(let* ((proofs (plist-get state :owner-scoped-proofs))
|
|
(candidates
|
|
(if proofs
|
|
(mapcar
|
|
(lambda (proof)
|
|
(if (plist-get proof :range-splice-p)
|
|
(ebox-surface--range-patch-candidate buffer state proof)
|
|
(ebox-surface--owner-patch-candidate
|
|
buffer state (plist-get proof :owner-id)
|
|
(plist-get proof :allocated-width)
|
|
(plist-get proof :variable-content-p)
|
|
(plist-get proof :variable-content-max-width)
|
|
(plist-get proof :role-owned-lines-p)
|
|
(plist-get proof :changed-keys)
|
|
(plist-get proof :allocation-closure-p)
|
|
(plist-get proof :retain-external-owner-suffix-p))))
|
|
proofs)
|
|
(list
|
|
(ebox-surface--owner-patch-candidate
|
|
buffer state (plist-get state :span-patch-owner-id)
|
|
(plist-get state :owner-scoped-allocated-width)
|
|
nil)))))
|
|
(when (and candidates (cl-every #'identity candidates))
|
|
(with-current-buffer buffer
|
|
(save-restriction
|
|
(widen)
|
|
(let* ((source (buffer-substring (point-min) (point-max)))
|
|
(origin (point-min))
|
|
(coordinate-shift-p
|
|
(cl-some
|
|
(lambda (candidate)
|
|
(let* ((details (plist-get candidate :details))
|
|
(old-footprint
|
|
(plist-get (plist-get candidate :snapshot)
|
|
:span-footprint-signature))
|
|
(new-footprint (plist-get details :footprint)))
|
|
(not (equal (plist-get old-footprint :char-lengths)
|
|
(plist-get new-footprint :char-lengths)))))
|
|
candidates))
|
|
(shared-generation
|
|
;; Glyph-width-only changes keep every buffer coordinate.
|
|
;; Any character-count delta, regardless of which proof
|
|
;; admitted the owner, shifts later snapshots and therefore
|
|
;; advances the global lazy-detail generation. Restricting
|
|
;; this to variable-content proofs left fixed-slot and theme
|
|
;; label updates with stale downstream coordinates.
|
|
(and coordinate-shift-p
|
|
(1+ (or (plist-get state
|
|
:layout-snapshot-detail-generation)
|
|
0))))
|
|
(ordered
|
|
(sort (copy-sequence candidates)
|
|
(lambda (left right)
|
|
(< (car (car (plist-get left :old-spans)))
|
|
(car (car (plist-get right :old-spans)))))))
|
|
(delta 0)
|
|
(rebased nil)
|
|
pairs)
|
|
;; Candidate details are first computed against the committed
|
|
;; coordinates. Once one owner changes length, every later
|
|
;; owner's new snapshot must be rebased by the accumulated delta;
|
|
;; installing each proof independently would leave stale spans.
|
|
(dolist (candidate ordered)
|
|
(let* ((details (plist-get candidate :details))
|
|
(old-spans (plist-get candidate :old-spans))
|
|
(new-spans
|
|
(mapcar (lambda (span)
|
|
(cons (+ (car span) delta)
|
|
(+ (cdr span) delta)))
|
|
(plist-get details :spans)))
|
|
(updated (copy-sequence details))
|
|
(line-delta
|
|
(cl-loop for old-span in old-spans
|
|
for line in (plist-get details :lines)
|
|
sum (- (length line)
|
|
(- (cdr old-span) (car old-span))))))
|
|
(plist-put updated :spans new-spans)
|
|
(push (cons candidate updated) rebased)
|
|
(setq delta (+ delta line-delta))))
|
|
(dolist (candidate candidates)
|
|
(cl-mapc
|
|
(lambda (span line) (push (cons span line) pairs))
|
|
(plist-get candidate :old-spans)
|
|
(plist-get (plist-get candidate :details) :lines)))
|
|
(setq pairs
|
|
(sort pairs
|
|
(lambda (left right)
|
|
(< (car (car left)) (car (car right))))))
|
|
(when-let* ((output
|
|
(ebox-surface--replace-buffer-spans
|
|
source origin (mapcar #'car pairs)
|
|
(mapcar #'cdr pairs))))
|
|
(plist-put state :content-base-extent (length source))
|
|
(plist-put
|
|
state :content-coordinate-patches
|
|
(let ((coordinate-delta 0)
|
|
patches)
|
|
;; PAIRS are the actual source replacements consumed by
|
|
;; `ebox-surface--replace-buffer-spans'. Snapshot spans
|
|
;; describe semantic ownership inside those replacement
|
|
;; strings and may begin after wrapper padding; using them as
|
|
;; edit coordinates creates artificial gaps and an invalid
|
|
;; old-to-new mapping when several owners are composed.
|
|
(dolist (pair pairs (nreverse patches))
|
|
(let* ((old-span (car pair))
|
|
(replacement (cdr pair))
|
|
(old-start (- (car old-span) origin))
|
|
(old-end (- (cdr old-span) origin))
|
|
(new-start (+ old-start coordinate-delta))
|
|
(new-end (+ new-start (length replacement))))
|
|
(push (list :old-start old-start :old-end old-end
|
|
:new-start new-start :new-end new-end)
|
|
patches)
|
|
(setq coordinate-delta
|
|
(+ coordinate-delta
|
|
(- (length replacement)
|
|
(- old-end old-start))))))))
|
|
(dolist (candidate candidates)
|
|
(ebox-surface--install-span-patch-snapshot
|
|
state (plist-get candidate :owner-id)
|
|
(plist-get candidate :snapshot)
|
|
(cdr (assq candidate rebased))
|
|
shared-generation))
|
|
(when-let* ((old-fragments
|
|
(ebox-surface--materialized-fragment-ledger
|
|
previous-state))
|
|
(fragments
|
|
(ebox-surface--incremental-patched-fragments
|
|
output old-fragments
|
|
(plist-get state :content-coordinate-patches))))
|
|
(plist-put state :span-patch-fragment-data fragments)
|
|
(plist-put state :span-patch-content-p t))
|
|
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))
|
|
(parent-table (plist-get state :parent-table))
|
|
(ancestor-owner-ids
|
|
(let ((walk (and parent-table
|
|
(gethash owner-id parent-table)))
|
|
owners)
|
|
(while walk
|
|
(when-let* ((ancestor
|
|
(gethash walk (plist-get state :node-table)))
|
|
(region-id
|
|
(ebox-surface--node-editable-region-id
|
|
ancestor)))
|
|
(setq owners (append owners (list region-id))))
|
|
(setq walk (gethash walk parent-table)))
|
|
owners))
|
|
(rendered
|
|
(ebox--maplines
|
|
(lambda (line)
|
|
(ebox--add-content-owners line ancestor-owner-ids))
|
|
rendered))
|
|
(new-footprint
|
|
(ebox--rendered-span-footprint-signature rendered))
|
|
(new-max (plist-get (ebox--external-footprint-signature-from-span-footprint
|
|
new-footprint)
|
|
:max-line-pixel-width))
|
|
(new-roles
|
|
(ebox-surface--rendered-role-topology-signature
|
|
rendered (plist-get snapshot :region-ids)))
|
|
(old-roles (plist-get snapshot :role-topology-signature))
|
|
(new-overflow (ebox--overflow-signature node))
|
|
(old-block-span (plist-get proof :old-block-span))
|
|
(block-start
|
|
(and old-block-span
|
|
(max 0
|
|
(1- (car old-block-span)))))
|
|
;; Mount positions are buffer positions (one-based, exclusive
|
|
;; end); the output string is zero-based, so both boundaries
|
|
;; need the same conversion before splicing.
|
|
(block-end
|
|
(and old-block-span
|
|
(1- (cdr old-block-span))))
|
|
(old-block-text
|
|
(and (integerp block-start)
|
|
(integerp block-end)
|
|
(with-current-buffer buffer
|
|
(buffer-substring (1+ block-start)
|
|
(1+ block-end)))))
|
|
;; The material context sits between two column line breaks.
|
|
;; They belong to the context's retained scope even though the
|
|
;; local node renderer quite correctly emits only its content.
|
|
(leading-newline-p
|
|
(and old-block-text
|
|
(> (length old-block-text) 0)
|
|
(= (aref old-block-text 0) ?\n)))
|
|
(trailing-newline-p
|
|
(and old-block-text
|
|
(> (length old-block-text) 0)
|
|
(= (aref old-block-text (1- (length old-block-text)))
|
|
?\n)))
|
|
(context-rendered
|
|
(concat (if leading-newline-p
|
|
"\n"
|
|
"")
|
|
rendered
|
|
(if trailing-newline-p
|
|
"\n"
|
|
"")))
|
|
(content-start (+ block-start (if leading-newline-p 1 0)))
|
|
(new-spans
|
|
(ebox-surface--formatting-context-reflow-lines
|
|
content-start rendered)))
|
|
(when (and (integerp block-start)
|
|
(integerp block-end)
|
|
(> block-end block-start)
|
|
(> (length context-rendered) 0)
|
|
new-spans
|
|
(or (null allocated-width)
|
|
(null new-max)
|
|
(<= new-max allocated-width))
|
|
(equal old-roles new-roles)
|
|
(equal (plist-get snapshot :overflow-signature)
|
|
new-overflow))
|
|
(with-current-buffer buffer
|
|
(save-restriction
|
|
(widen)
|
|
(let* ((source (buffer-substring (point-min) (point-max)))
|
|
(output
|
|
(concat (substring source 0 block-start)
|
|
context-rendered
|
|
(substring source block-end)))
|
|
(generation
|
|
(1+ (or (plist-get state
|
|
:layout-snapshot-detail-generation)
|
|
0)))
|
|
(updated (copy-sequence snapshot))
|
|
(new-external
|
|
(ebox--external-footprint-signature-from-span-footprint
|
|
new-footprint)))
|
|
(dolist (entry `((:buffer-span . ,(car new-spans))
|
|
(:buffer-spans . ,new-spans)
|
|
(:line-signature
|
|
. ,(plist-get new-footprint
|
|
:line-pixel-widths))
|
|
(:span-footprint-signature . ,new-footprint)
|
|
(:external-footprint-signature
|
|
. ,new-external)
|
|
(:role-topology-signature . ,new-roles)
|
|
(:overflow-signature . ,new-overflow)
|
|
(:detail-generation . ,generation)))
|
|
(setq updated
|
|
(plist-put updated (car entry) (cdr entry))))
|
|
(puthash owner-id updated (plist-get state :layout-snapshots))
|
|
(plist-put state :layout-snapshot-detail-generation generation)
|
|
(plist-put state :layout-snapshots-complete-p nil)
|
|
(plist-put state :formatting-context-reflow-new-spans new-spans)
|
|
(plist-put state :formatting-context-reflow-new-length
|
|
(length context-rendered))
|
|
(plist-put
|
|
state :content-coordinate-patches
|
|
(list (list :old-start block-start :old-end block-end
|
|
:new-start block-start
|
|
:new-end (+ block-start
|
|
(length context-rendered)))))
|
|
output))))))))
|
|
|
|
(defvar ebox-surface--paint-node-depth-cache nil
|
|
"Dynamically bound node-id depth cache for one mixed paint projection.")
|
|
|
|
(defvar ebox-surface--paint-node-chain-cache nil
|
|
"Dynamically bound role-chain cache for one mixed paint projection.")
|
|
|
|
(defconst ebox-surface--paint-node-depth-missing
|
|
(make-symbol "ebox-paint-node-depth-missing")
|
|
"Sentinel distinguishing an uncached paint node depth.")
|
|
|
|
(defconst ebox-surface--paint-node-chain-missing
|
|
(make-symbol "ebox-paint-node-chain-missing")
|
|
"Sentinel distinguishing an uncached paint node chain.")
|
|
|
|
(defun ebox-surface--repaint-output-fragment!
|
|
(output fragment old-state new-state old-face-cache new-face-cache
|
|
old-node-face-cache new-node-face-cache)
|
|
"Recompose FRAGMENT's face directly in mutable OUTPUT and return metadata.
|
|
FRAGMENT retains absolute offsets into OUTPUT. Avoiding one substring, one
|
|
fragment-local copy, and a final full concat per run keeps mixed projection
|
|
work proportional to semantic face composition instead of allocation churn."
|
|
(let* ((start (plist-get fragment :start))
|
|
(end (plist-get fragment :end))
|
|
(old-roles (plist-get fragment :old-paint-role-ids))
|
|
(new-roles (plist-get fragment :paint-role-ids))
|
|
(old-faces
|
|
(ebox-surface--cached-face-contributions
|
|
old-face-cache old-state old-roles old-node-face-cache))
|
|
(new-faces
|
|
(ebox-surface--cached-face-contributions
|
|
new-face-cache new-state new-roles new-node-face-cache))
|
|
(baseline
|
|
(and (< start end)
|
|
(if (plist-get fragment :face-baseline-known-p)
|
|
(copy-tree (plist-get fragment :face-baseline))
|
|
(ebox-surface--face-baseline
|
|
(get-text-property start 'face output) old-faces))))
|
|
(unchanged (and (equal old-roles new-roles)
|
|
(equal old-faces new-faces)))
|
|
(face (and (not unchanged)
|
|
(ebox-surface--compose-face baseline new-faces))))
|
|
(when (and (not unchanged) (< start end))
|
|
(if face
|
|
(put-text-property start end 'face face output)
|
|
(remove-text-properties start end '(face nil) output)))
|
|
(cl-remf fragment :text)
|
|
(plist-put fragment :text-source-p t)
|
|
(cl-remf fragment :old-paint-role-ids)
|
|
fragment))
|
|
|
|
(defun ebox-surface--mixed-owner-output (buffer previous-state state)
|
|
"Return one geometry-plus-paint candidate output, or nil on proof miss.
|
|
The geometry context is rendered by the existing whole-line proof. Paint
|
|
owners are then recomposed from the committed semantic fragment ledger, never
|
|
by peeling an already-composed face suffix. Any missing address/baseline
|
|
causes the caller to use the ordinary full projection."
|
|
(let* ((proof (plist-get state :mixed-owner-proof))
|
|
(geometry-proof (and proof (plist-get proof :geometry-proof)))
|
|
(geometry-kind (and proof (plist-get proof :geometry-kind)))
|
|
(paint-owner-ids (and proof (plist-get proof :paint-owner-ids)))
|
|
(output
|
|
(when geometry-proof
|
|
(if (eq geometry-kind 'span-patch)
|
|
(ebox-surface--span-patch-output
|
|
buffer previous-state state)
|
|
(plist-put state :render-cache (make-hash-table :test 'equal))
|
|
(plist-put state :render-signature-cache
|
|
(make-hash-table :test 'eq))
|
|
(let ((ebox--box-content-render-cache
|
|
(make-hash-table :test 'eq)))
|
|
(ebox-surface--formatting-context-reflow-output
|
|
buffer state)))))
|
|
(old-fragments
|
|
(ebox-surface--materialized-fragment-ledger previous-state))
|
|
(old-by-address (make-hash-table :test #'equal))
|
|
(old-by-local-address (make-hash-table :test #'equal))
|
|
(ebox-surface--paint-node-depth-cache
|
|
(make-hash-table :test #'eql))
|
|
(ebox-surface--paint-node-chain-cache
|
|
(make-hash-table :test #'equal)))
|
|
(when (and output old-fragments paint-owner-ids)
|
|
(dolist (fragment old-fragments)
|
|
(when-let* ((address (plist-get fragment :paint-address)))
|
|
(puthash address fragment old-by-address)
|
|
(let* ((roles (plist-get fragment :paint-role-ids))
|
|
(owner (cdr (assq 'content roles)))
|
|
(key (and owner
|
|
(list owner
|
|
(plist-get address :content-index)
|
|
(plist-get address :ordinal)))))
|
|
(when key
|
|
(puthash key
|
|
(cons fragment (gethash key old-by-local-address))
|
|
old-by-local-address)))))
|
|
(let ((new-fragments
|
|
(or (and (eq geometry-kind 'span-patch)
|
|
(plist-get state :span-patch-fragment-data))
|
|
(ebox-surface--rendered-fragments output))))
|
|
(catch 'mixed-owner-proof-miss
|
|
(let (pieces)
|
|
(dolist (fragment new-fragments)
|
|
(let* (;; Fragment metadata is immutable below its plist spine;
|
|
;; repaint replaces every mutable field it owns.
|
|
(copy (copy-sequence fragment))
|
|
(address (plist-get fragment :paint-address))
|
|
(roles (plist-get fragment :paint-role-ids))
|
|
(owner (cdr (assq 'content roles)))
|
|
(local-key
|
|
(and owner
|
|
(list owner
|
|
(plist-get address :content-index)
|
|
(plist-get address :ordinal))))
|
|
(matches (and local-key
|
|
(gethash local-key old-by-local-address)))
|
|
(old-fragment
|
|
(or (and address (gethash address old-by-address))
|
|
(and (= (length matches) 1) (car matches))))
|
|
(old-roles (and old-fragment
|
|
(plist-get old-fragment
|
|
:paint-role-ids)))
|
|
(paint-chain
|
|
(if (and old-fragment (equal old-roles roles)
|
|
(plist-get old-fragment :paint-node-chain))
|
|
(copy-sequence
|
|
(plist-get old-fragment :paint-node-chain))
|
|
(ebox-surface--paint-node-chain state roles)))
|
|
(direct-affected-p
|
|
(cl-some (lambda (entry)
|
|
(memq (cdr entry) paint-owner-ids))
|
|
roles))
|
|
(affected-p
|
|
(cl-some (lambda (node-id)
|
|
(memq node-id paint-owner-ids))
|
|
paint-chain))
|
|
(paint-change-p
|
|
(and affected-p
|
|
(not
|
|
(equal
|
|
(and old-fragment
|
|
(ebox-surface--face-contributions
|
|
previous-state old-roles))
|
|
(ebox-surface--face-contributions
|
|
state roles))))))
|
|
(plist-put copy :paint-node-chain paint-chain)
|
|
(if (not affected-p)
|
|
(progn
|
|
(cl-remf copy :text)
|
|
(plist-put copy :text-source-p t)
|
|
(push copy pieces))
|
|
(when (plist-get old-fragment :face-baseline-known-p)
|
|
(plist-put copy :face-baseline
|
|
(copy-tree
|
|
(plist-get old-fragment :face-baseline)))
|
|
(plist-put copy :face-baseline-known-p t))
|
|
;; When Range identity changes prevent an old-address match,
|
|
;; OUTPUT still contains the freshly rendered candidate
|
|
;; face. Remove the candidate's own new contributions to
|
|
;; recover the semantic baseline exactly; subsequent paint
|
|
;; composition can then proceed without guessing from an
|
|
;; unrelated old fragment.
|
|
(when (and (< (plist-get copy :start)
|
|
(plist-get copy :end))
|
|
(not (plist-get copy
|
|
:face-baseline-known-p)))
|
|
(plist-put
|
|
copy :face-baseline
|
|
(ebox-surface--face-baseline
|
|
(get-text-property (plist-get copy :start)
|
|
'face output)
|
|
(ebox-surface--face-contributions state roles)))
|
|
(plist-put copy :face-baseline-known-p t))
|
|
(when (and direct-affected-p paint-change-p
|
|
(< (plist-get copy :start)
|
|
(plist-get copy :end))
|
|
(not (plist-get copy
|
|
:face-baseline-known-p)))
|
|
(throw 'mixed-owner-proof-miss nil))
|
|
(plist-put copy :old-paint-role-ids
|
|
(copy-tree (or old-roles roles)))
|
|
(push copy pieces))))
|
|
(let ((fragments (nreverse pieces)))
|
|
(setq fragments
|
|
(ebox-surface--layer-paint-contributions
|
|
output fragments state))
|
|
(plist-put state :mixed-owner-fragment-data fragments)
|
|
(plist-put state :mixed-owner-content-p t)
|
|
output)))))))
|
|
|
|
(defun ebox-surface--scroll-patch-output (_buffer state)
|
|
"Return a staged visible scroll window without rerunning layout when safe.
|
|
Chrome-free top-aligned root scroll boxes already store fully propertized
|
|
rendered lines. Join only the visible slice and add the scroll marker; any
|
|
box with wrapper chrome falls back to the retained wrapper renderer."
|
|
(let* ((region-id (plist-get state :scroll-patch-region-id))
|
|
(scroll-table (plist-get state :scroll-state-table))
|
|
(scroll-state (and region-id scroll-table
|
|
(gethash region-id scroll-table)))
|
|
(root (plist-get state :root-node))
|
|
(root-id (and root (plist-get root :node-id)))
|
|
(owner-id (plist-get state :span-patch-owner-id))
|
|
(cached-box (and scroll-state (plist-get scroll-state :box))))
|
|
(when (and scroll-state root owner-id root-id
|
|
(= owner-id root-id)
|
|
cached-box
|
|
(equal (plist-get cached-box :node-id) root-id))
|
|
(let* ((chrome-free-p
|
|
(and (= (or (ebox-get cached-box :padding-left-pixel) 0) 0)
|
|
(= (or (ebox-get cached-box :padding-right-pixel) 0) 0)
|
|
(= (or (ebox-get cached-box :padding-top-height) 0) 0)
|
|
(= (or (ebox-get cached-box :padding-bottom-height) 0) 0)
|
|
(= (or (ebox-get cached-box :margin-left-pixel) 0) 0)
|
|
(= (or (ebox-get cached-box :margin-right-pixel) 0) 0)
|
|
(= (or (ebox-get cached-box :margin-top-height) 0) 0)
|
|
(= (or (ebox-get cached-box :margin-bottom-height) 0) 0)
|
|
(= (or (ebox-get cached-box :border-left-pixel) 0) 0)
|
|
(= (or (ebox-get cached-box :border-right-pixel) 0) 0)
|
|
(not (ebox-get cached-box :border-top-p))
|
|
(not (ebox-get cached-box :border-bottom-p))
|
|
(eq (ebox-get cached-box :vertical-align) 'top)
|
|
(null (ebox-get cached-box :surface-properties))))
|
|
(visible
|
|
(and chrome-free-p
|
|
(ebox--scroll-state-retained-window-ready-p
|
|
scroll-state))))
|
|
(if (and visible (cadr visible))
|
|
(let* ((lines (cadr visible))
|
|
(output (ebox-lines-join lines))
|
|
(fragment-data
|
|
(ebox-surface--scroll-fragment-data lines output)))
|
|
(when (and fragment-data
|
|
(plist-get state :retained-scroll-content-p))
|
|
(plist-put state :scroll-patch-fragment-data fragment-data))
|
|
(when (> (length output) 0)
|
|
(add-text-properties
|
|
0 (length output)
|
|
(list 'ebox-scroll-window region-id)
|
|
output))
|
|
output)
|
|
(let ((ebox--scroll-window-cached-state scroll-state)
|
|
(ebox--scroll-window-skip-state-rebuild-p
|
|
(plist-get scroll-state :content-lines-complete-p)))
|
|
(ebox-surface--render-candidate-node state root)))))))
|
|
|
|
(defun ebox-surface--native-scroll-full-output (state)
|
|
"Return the complete propertized root scroll output for native scrolling."
|
|
(let* ((region-id (plist-get state :scroll-patch-region-id))
|
|
(table (plist-get state :scroll-state-table))
|
|
(scroll-state (and region-id table (gethash region-id table)))
|
|
(lines (and scroll-state
|
|
(plist-get scroll-state :rendered-content-lines))))
|
|
(when (and lines
|
|
(plist-get scroll-state :content-lines-complete-p))
|
|
(let ((output (ebox-lines-join lines)))
|
|
(when (> (length output) 0)
|
|
(add-text-properties
|
|
0 (length output) (list 'ebox-scroll-window region-id) output))
|
|
output))))
|
|
|
|
(defun ebox-surface--runtime-index-ready-p (state)
|
|
"Return non-nil when STATE carries a complete prepared runtime index."
|
|
(let* ((root (plist-get state :root-node))
|
|
(root-id (and root (plist-get root :node-id)))
|
|
(nodes (plist-get state :node-table)))
|
|
(and (plist-get state :runtime-index-prepared-p)
|
|
root-id
|
|
(hash-table-p nodes)
|
|
(eq root (gethash root-id nodes))
|
|
(hash-table-p (plist-get state :parent-table))
|
|
(hash-table-p (plist-get state :region-id-set))
|
|
(hash-table-p (plist-get state :region-node-table))
|
|
(hash-table-p (plist-get state :region-box-count-table))
|
|
(hash-table-p (plist-get state :region-box-table))
|
|
(hash-table-p (plist-get state :host-ref-table))
|
|
(hash-table-p (plist-get state :range-ref-table))
|
|
(vectorp (plist-get state :native-node-postorder)))))
|
|
|
|
(defun ebox-surface--finish-runtime-state (state)
|
|
"Install or retain the prepared runtime indexes in candidate STATE."
|
|
(unless (ebox-surface--runtime-index-ready-p state)
|
|
(ebox--render-state-install-index
|
|
state (ebox--runtime-index (plist-get state :root-node) t))
|
|
(plist-put state :runtime-index-prepared-p t))
|
|
state)
|
|
|
|
(defun ebox-surface--role-ids-from-properties (properties)
|
|
"Return namespaced Ebox role/id pairs from PROPERTIES."
|
|
(let (roles)
|
|
(when-let* ((region-id
|
|
(plist-get properties 'ebox-overflow-foreground-source)))
|
|
(push (cons 'overflow-foreground region-id) roles))
|
|
(dolist (region-id (plist-get properties 'ebox-content-owners))
|
|
(cl-pushnew (cons 'content-owner region-id) roles :test #'equal))
|
|
(dolist (entry ebox-region-types)
|
|
(when-let* ((region-id (plist-get properties (cdr entry))))
|
|
(cl-pushnew (cons (car entry) region-id) roles :test #'equal)))
|
|
(nreverse roles)))
|
|
|
|
(defun ebox-surface--role-ids-at (rendered position &optional cache)
|
|
"Return namespaced Ebox role/id pairs at POSITION in RENDERED.
|
|
CACHE, when non-nil, reuses role extraction for equal property plists during
|
|
one output projection."
|
|
(let* ((properties (text-properties-at position rendered))
|
|
(missing (make-symbol "ebox-role-cache-missing"))
|
|
(cached (and cache (gethash properties cache missing))))
|
|
(if (and cache (not (eq cached missing)))
|
|
cached
|
|
(let ((roles (ebox-surface--role-ids-from-properties properties)))
|
|
(when cache
|
|
(puthash properties roles cache))
|
|
roles))))
|
|
|
|
(defun ebox-surface--paint-address-at
|
|
(rendered position role-cache ordinal-table)
|
|
"Return the semantic paint address at POSITION in RENDERED.
|
|
ROLE-CACHE is the per-render role extraction cache and ORDINAL-TABLE tracks
|
|
the first-to-last occurrence of an otherwise equal owner/content address.
|
|
The result deliberately contains semantic owner/role facts only; it never
|
|
uses a string, buffer, marker, or TP object identity as an address."
|
|
(let* ((properties (text-properties-at position rendered))
|
|
(roles (ebox-surface--role-ids-at rendered position role-cache))
|
|
(content-owner (plist-get properties 'ebox-content-owner))
|
|
(content-index (plist-get properties 'ebox-content-idx))
|
|
(prefix (and (or roles content-owner (integerp content-index))
|
|
(list :roles (copy-tree roles)
|
|
:content-owner content-owner
|
|
:content-index content-index)))
|
|
(ordinal (and prefix (gethash prefix ordinal-table 0))))
|
|
(when prefix
|
|
(puthash prefix (1+ ordinal) ordinal-table)
|
|
(list :roles (copy-tree roles)
|
|
:content-owner content-owner
|
|
:content-index content-index
|
|
:ordinal ordinal))))
|
|
|
|
(defun ebox-surface--candidate-plan-text (rendered owned-values)
|
|
"Return a private snapshot of RENDERED for an owned TP plan.
|
|
OWNED-VALUES is the candidate-local provenance registry created by Ebox's
|
|
render helpers. TP transfers only mutable values present in this registry;
|
|
all other values remain defensively copied."
|
|
(tp-text-snapshot
|
|
rendered
|
|
(and (hash-table-p owned-values)
|
|
(lambda (property value)
|
|
(and (ebox--render-owned-text-value-p
|
|
property value owned-values)
|
|
(not (memq property '(face font-lock-face mouse-face))))))))
|
|
|
|
(defun ebox-surface--region-role-tags (region-id role-ids)
|
|
"Return projection tags for REGION-ID from ROLE-IDS."
|
|
(list :ebox/region-id region-id
|
|
:ebox/roles
|
|
(cl-loop for (role . owner) in role-ids
|
|
when (equal owner region-id) collect role)))
|
|
|
|
(defun ebox-surface--fragment-owners
|
|
(role-ids state node-objects region-objects)
|
|
"Return ordered Ebox owner and tag pairs for ROLE-IDS.
|
|
Each owner appears at most once for one rendered fragment."
|
|
(let ((attached (make-hash-table :test #'eq))
|
|
(region-node-table (plist-get state :region-node-table))
|
|
(parent-table (plist-get state :parent-table))
|
|
owners)
|
|
(dolist (region-id (delete-dups (mapcar #'cdr role-ids)))
|
|
(let ((object (gethash region-id region-objects))
|
|
(node-id (gethash region-id region-node-table)))
|
|
(unless (and object node-id)
|
|
(error "Ebox output references unknown region %S" region-id))
|
|
(unless (gethash object attached)
|
|
(push (list object
|
|
(ebox-surface--region-role-tags region-id role-ids))
|
|
owners)
|
|
(puthash object t attached))
|
|
(setq node-id (gethash node-id parent-table))
|
|
(while node-id
|
|
(let ((ancestor (gethash node-id node-objects)))
|
|
(unless ancestor
|
|
(error "Ebox output ancestor has no TP object: %S" node-id))
|
|
(unless (gethash ancestor attached)
|
|
(push (list ancestor (list :ebox/descendant-output t)) owners)
|
|
(puthash ancestor t attached)))
|
|
(setq node-id (gethash node-id parent-table)))))
|
|
(nreverse owners)))
|
|
|
|
(defun ebox-surface--rendered-fragments (rendered)
|
|
"Return an offset index of Ebox-owned property runs in RENDERED.
|
|
The complete propertized string remains the sole text storage. Runs keep
|
|
START and END offsets into that string instead of allocating one substring
|
|
per property interval; paint projection materializes its private copies only
|
|
when it needs to mutate them."
|
|
(let ((position 0)
|
|
(limit (length rendered))
|
|
(line 0)
|
|
(role-cache (make-hash-table :test #'equal))
|
|
(ordinal-table (make-hash-table :test #'equal))
|
|
fragments previous-role-ids next-role-ids)
|
|
(while (< position limit)
|
|
(let* ((next (or (next-property-change position rendered limit)
|
|
limit))
|
|
(origin (get-text-property position
|
|
ebox--paint-origin-property
|
|
rendered))
|
|
(roles (ebox-surface--role-ids-at rendered position role-cache))
|
|
(address
|
|
(ebox-surface--paint-address-at
|
|
rendered position role-cache ordinal-table))
|
|
(baseline
|
|
(and origin
|
|
(copy-tree
|
|
(ebox--paint-origin-baseline origin)))))
|
|
(push (list :text rendered :text-source-p t
|
|
:start position :end next
|
|
:line line :paint-role-ids roles
|
|
:role-ids roles
|
|
:paint-address address
|
|
:paint-token
|
|
(and address
|
|
(list :baseline (copy-tree baseline)
|
|
:roles (copy-tree roles)
|
|
:content-owner
|
|
(plist-get address :content-owner)
|
|
:content-index
|
|
(plist-get address :content-index)))
|
|
:face-baseline baseline
|
|
:face-baseline-known-p (and origin t))
|
|
fragments)
|
|
(when origin
|
|
(remove-text-properties
|
|
position next (list ebox--paint-origin-property nil) rendered))
|
|
(cl-incf line (cl-count ?\n rendered :start position :end next))
|
|
(setq position (max next (1+ position)))))
|
|
(setq fragments (nreverse fragments))
|
|
(dolist (fragment fragments)
|
|
(if-let* ((roles (plist-get fragment :role-ids)))
|
|
(setq previous-role-ids roles)
|
|
(plist-put fragment :previous-role-ids previous-role-ids)))
|
|
(dolist (fragment (reverse (copy-sequence fragments)))
|
|
(if-let* ((roles (plist-get fragment :role-ids)))
|
|
(setq next-role-ids roles)
|
|
(plist-put fragment :role-ids
|
|
(delete-dups
|
|
(append (copy-sequence
|
|
(plist-get fragment :previous-role-ids))
|
|
(copy-sequence next-role-ids))))))
|
|
(cl-loop for fragment in fragments for index from 0
|
|
do (plist-put fragment :key (cons 'ebox/fragment index))
|
|
do (cl-remf fragment :previous-role-ids)
|
|
collect fragment)))
|
|
|
|
(defun ebox-surface--incremental-patched-fragments
|
|
(output old-fragments patches)
|
|
"Rebase OLD-FRAGMENTS through exact text PATCHES into OUTPUT.
|
|
Return nil unless every patch is aligned to retained fragment boundaries and
|
|
preserves the ordered role topology inside its replaced range. On success,
|
|
only replacement slices are scanned; unchanged fragment metadata is copied
|
|
and shifted without inspecting its text properties."
|
|
(when (and (stringp output) old-fragments patches)
|
|
(catch 'miss
|
|
(let ((remaining old-fragments)
|
|
(old-cursor 0)
|
|
(new-cursor 0)
|
|
(line-shift 0)
|
|
result new-origin-ranges)
|
|
(dolist (patch patches)
|
|
(let ((old-start (plist-get patch :old-start))
|
|
(old-end (plist-get patch :old-end))
|
|
(new-start (plist-get patch :new-start))
|
|
(new-end (plist-get patch :new-end)))
|
|
(unless (and (integerp old-start) (integerp old-end)
|
|
(integerp new-start) (integerp new-end)
|
|
(<= old-cursor old-start old-end)
|
|
(<= new-cursor new-start new-end)
|
|
(= (- new-start new-cursor)
|
|
(- old-start old-cursor))
|
|
(<= new-end (length output)))
|
|
(throw 'miss nil))
|
|
(while (and remaining
|
|
(<= (plist-get (car remaining) :end) old-start))
|
|
(let ((copy (copy-sequence (pop remaining))))
|
|
(unless (= (plist-get copy :start) old-cursor)
|
|
(throw 'miss nil))
|
|
(let ((length (- (plist-get copy :end)
|
|
(plist-get copy :start))))
|
|
(plist-put copy :start new-cursor)
|
|
(plist-put copy :end (+ new-cursor length))
|
|
(plist-put copy :line
|
|
(+ line-shift (plist-get copy :line)))
|
|
(plist-put copy :text output)
|
|
(plist-put copy :text-source-p t)
|
|
(push copy result)
|
|
(setq old-cursor (+ old-cursor length)
|
|
new-cursor (+ new-cursor length)))))
|
|
(unless (= old-cursor old-start) (throw 'miss nil))
|
|
(let (old-window)
|
|
(while (and remaining
|
|
(< (plist-get (car remaining) :start) old-end))
|
|
(let ((fragment (pop remaining)))
|
|
(unless (and (= (plist-get fragment :start) old-cursor)
|
|
(<= (plist-get fragment :end) old-end))
|
|
(throw 'miss nil))
|
|
(push fragment old-window)
|
|
(setq old-cursor (plist-get fragment :end))))
|
|
(unless (= old-cursor old-end) (throw 'miss nil))
|
|
(setq old-window (nreverse old-window))
|
|
(let* ((slice (substring output new-start new-end))
|
|
(new-window (ebox-surface--rendered-fragments slice)))
|
|
(unless (and (= (length old-window) (length new-window))
|
|
(cl-every
|
|
(lambda (pair)
|
|
(and (equal
|
|
(plist-get (car pair) :paint-role-ids)
|
|
(plist-get (cdr pair) :paint-role-ids))
|
|
(equal
|
|
(plist-get (car pair) :role-ids)
|
|
(plist-get (cdr pair) :role-ids))))
|
|
(cl-mapcar #'cons old-window new-window)))
|
|
(throw 'miss nil))
|
|
(let ((old-first-line
|
|
(or (plist-get (car old-window) :line) 0))
|
|
(new-first-line
|
|
(or (plist-get (car new-window) :line) 0))
|
|
(old-last-line
|
|
(or (plist-get (car (last old-window)) :line) 0))
|
|
(new-last-line
|
|
(or (plist-get (car (last new-window)) :line) 0)))
|
|
;; Span-patch proofs retain the same line topology. A
|
|
;; variable-line context uses the full fragment scanner.
|
|
(unless (= (- old-last-line old-first-line)
|
|
(- new-last-line new-first-line))
|
|
(throw 'miss nil))
|
|
(cl-mapc
|
|
(lambda (old new)
|
|
(let ((copy (copy-sequence new)))
|
|
(plist-put copy :start
|
|
(+ new-start (plist-get new :start)))
|
|
(plist-put copy :end
|
|
(+ new-start (plist-get new :end)))
|
|
(plist-put copy :line
|
|
(+ line-shift old-first-line
|
|
(- (plist-get new :line)
|
|
new-first-line)))
|
|
(plist-put copy :key (plist-get old :key))
|
|
(plist-put copy :paint-address
|
|
(copy-tree
|
|
(plist-get old :paint-address)))
|
|
(when-let* ((chain (plist-get old :paint-node-chain)))
|
|
(plist-put copy :paint-node-chain
|
|
(copy-sequence chain)))
|
|
(plist-put copy :text output)
|
|
(plist-put copy :text-source-p t)
|
|
(push copy result)))
|
|
old-window new-window)
|
|
(push (cons new-start new-end) new-origin-ranges)))
|
|
(setq old-cursor old-end
|
|
new-cursor new-end))))
|
|
(while remaining
|
|
(let ((copy (copy-sequence (pop remaining))))
|
|
(unless (= (plist-get copy :start) old-cursor)
|
|
(throw 'miss nil))
|
|
(let ((length (- (plist-get copy :end)
|
|
(plist-get copy :start))))
|
|
(plist-put copy :start new-cursor)
|
|
(plist-put copy :end (+ new-cursor length))
|
|
(plist-put copy :line (+ line-shift (plist-get copy :line)))
|
|
(plist-put copy :text output)
|
|
(plist-put copy :text-source-p t)
|
|
(push copy result)
|
|
(setq old-cursor (+ old-cursor length)
|
|
new-cursor (+ new-cursor length)))))
|
|
(unless (= new-cursor (length output)) (throw 'miss nil))
|
|
(dolist (range new-origin-ranges)
|
|
(remove-text-properties
|
|
(car range) (cdr range)
|
|
(list ebox--paint-origin-property nil) output))
|
|
(nreverse result)))))
|
|
|
|
(defun ebox-surface--rebase-coordinate (position patches)
|
|
"Return POSITION rebased through PATCHES, or nil inside a replacement."
|
|
(let ((delta 0))
|
|
(catch 'done
|
|
(dolist (patch patches)
|
|
(let ((old-start (plist-get patch :old-start))
|
|
(old-end (plist-get patch :old-end))
|
|
(new-start (plist-get patch :new-start))
|
|
(new-end (plist-get patch :new-end)))
|
|
(unless (= new-start (+ old-start delta))
|
|
(throw 'done nil))
|
|
(cond
|
|
((< position old-start) (throw 'done (list (+ position delta))))
|
|
((= position old-start) (throw 'done (list new-start)))
|
|
((< position old-end) (throw 'done nil))
|
|
((= position old-end) (throw 'done (list new-end))))
|
|
(setq delta (+ delta (- new-end new-start)
|
|
(- old-start old-end)))))
|
|
(list (+ position delta)))))
|
|
|
|
(defun ebox-surface--rebase-owned-ranges (ranges patches output-length)
|
|
"Return fresh candidate RANGES rebased through PATCHES.
|
|
Any range boundary inside replaced text rejects reuse so ownership never
|
|
widens heuristically. The returned cons distinguishes an exact empty result
|
|
from a failed proof."
|
|
(catch 'miss
|
|
(let (result)
|
|
(dolist (range ranges)
|
|
(let ((start (ebox-surface--rebase-coordinate
|
|
(plist-get range :start) patches))
|
|
(end (ebox-surface--rebase-coordinate
|
|
(plist-get range :end) patches)))
|
|
(unless (and start end (< (car start) (car end))
|
|
(<= (car end) output-length))
|
|
(throw 'miss nil))
|
|
(push (list :object (plist-get range :object)
|
|
:start (car start) :end (car end)
|
|
:tags (copy-tree (plist-get range :tags)))
|
|
result)))
|
|
(cons t (nreverse result)))))
|
|
|
|
(defun ebox-surface--snapshot-owned-ranges (ranges)
|
|
"Return an immutable client-state snapshot of candidate RANGES."
|
|
(mapcar (lambda (range)
|
|
(list :object (plist-get range :object)
|
|
:start (plist-get range :start)
|
|
:end (plist-get range :end)
|
|
:tags (copy-tree (plist-get range :tags))))
|
|
ranges))
|
|
|
|
(defun ebox-surface--fragment-metadata (fragments &optional state)
|
|
"Return FRAGMENTS as offsets into the TP-owned rendered text.
|
|
The mutable propertized text is intentionally not retained in Ebox client
|
|
state; paint projection reads a defensive snapshot from the published
|
|
buffer only when it needs the old text. STATE additionally retains each
|
|
fragment's complete paint-owner ancestor chain."
|
|
(let ((offset 0)
|
|
(ebox-surface--paint-node-depth-cache
|
|
(and state (make-hash-table :test #'eql)))
|
|
(ebox-surface--paint-node-chain-cache
|
|
(and state (make-hash-table :test #'equal)))
|
|
metadata)
|
|
(dolist (fragment fragments (nreverse metadata))
|
|
(let* ((source-p (plist-get fragment :text-source-p))
|
|
(text (plist-get fragment :text))
|
|
(length (if source-p
|
|
(- (plist-get fragment :end)
|
|
(plist-get fragment :start))
|
|
(length text)))
|
|
(copy
|
|
(cl-loop for (key value) on fragment by #'cddr
|
|
unless (eq key :text)
|
|
append (list key value))))
|
|
(unless source-p
|
|
(plist-put copy :start offset)
|
|
(plist-put copy :end (+ offset length)))
|
|
(when (and state (plist-get copy :paint-role-ids)
|
|
(not (plist-get copy :paint-node-chain)))
|
|
(plist-put copy :paint-node-chain
|
|
(copy-sequence
|
|
(ebox-surface--paint-node-chain
|
|
state (plist-get copy :paint-role-ids)))))
|
|
(plist-put copy :text-source-p t)
|
|
(push copy metadata)
|
|
(setq offset (+ offset length))))))
|
|
|
|
(defun ebox-surface--owned-ranges
|
|
(context leaf fragments state node-objects region-objects
|
|
&optional attach-p)
|
|
"Attach merged owner ranges for FRAGMENTS to candidate LEAF.
|
|
Adjacent ranges merge only when both their owner and opaque tags match."
|
|
(let ((active (make-hash-table :test #'eq))
|
|
(owner-cache (make-hash-table :test #'equal))
|
|
(offset 0)
|
|
ranges)
|
|
(dolist (fragment fragments)
|
|
(let* ((role-ids (plist-get fragment :role-ids))
|
|
(owners (gethash role-ids owner-cache 'ebox/no-owners))
|
|
(source-p (plist-get fragment :text-source-p))
|
|
(start (if source-p
|
|
(plist-get fragment :start)
|
|
offset))
|
|
(end (if source-p
|
|
(plist-get fragment :end)
|
|
(+ offset (length (plist-get fragment :text))))))
|
|
(when (eq owners 'ebox/no-owners)
|
|
(setq owners
|
|
(ebox-surface--fragment-owners
|
|
role-ids state node-objects region-objects))
|
|
(puthash role-ids owners owner-cache))
|
|
(dolist (owner owners)
|
|
(let* ((object (nth 0 owner))
|
|
(tags (nth 1 owner))
|
|
(tag-ranges (or (gethash object active)
|
|
(let ((table (make-hash-table :test #'equal)))
|
|
(puthash object table active)
|
|
table)))
|
|
(current (gethash tags tag-ranges)))
|
|
(if (and current (= (plist-get current :end) start))
|
|
(plist-put current :end end)
|
|
(let ((range (list :object object :start start :end end
|
|
:tags tags)))
|
|
(push range ranges)
|
|
(puthash tags range tag-ranges)))))
|
|
(setq offset (if source-p end (+ offset (length (plist-get fragment :text)))))))
|
|
(setq ranges (nreverse ranges))
|
|
(when attach-p
|
|
(tp-object-attach-content-ranges-owned context leaf ranges))
|
|
ranges))
|
|
|
|
(defun ebox-surface--native-owned-ranges
|
|
(context leaf template state node-objects region-objects attach-p)
|
|
"Attach owner ranges from compact native fragment TEMPLATE."
|
|
(let ((active (make-hash-table :test #'eq))
|
|
(owner-cache
|
|
(or (plist-get state :native-fragment-owner-cache)
|
|
(let ((cache (make-hash-table :test #'equal)))
|
|
(plist-put state :native-fragment-owner-cache cache)
|
|
cache)))
|
|
ranges)
|
|
(dotimes (index (length template))
|
|
(let* ((record (aref template index))
|
|
(roles (aref record 3))
|
|
(owners (gethash roles owner-cache 'ebox/no-owners))
|
|
(start (aref record 0))
|
|
(end (aref record 1)))
|
|
(when (eq owners 'ebox/no-owners)
|
|
(setq owners
|
|
(ebox-surface--fragment-owners
|
|
roles state node-objects region-objects))
|
|
(puthash roles owners owner-cache))
|
|
(dolist (owner owners)
|
|
(let* ((object (nth 0 owner))
|
|
(tags (nth 1 owner))
|
|
(tag-ranges
|
|
(or (gethash object active)
|
|
(let ((table (make-hash-table :test #'equal)))
|
|
(puthash object table active)
|
|
table)))
|
|
(current (gethash tags tag-ranges)))
|
|
(if (and current (= (plist-get current :end) start))
|
|
(plist-put current :end end)
|
|
(let ((range (list :object object :start start :end end
|
|
:tags tags)))
|
|
(push range ranges)
|
|
(puthash tags range tag-ranges)))))))
|
|
(setq ranges (nreverse ranges))
|
|
(when attach-p
|
|
(tp-object-attach-content-ranges-owned context leaf ranges))
|
|
ranges))
|
|
|
|
(defun ebox-surface--materialized-fragment-ledger (state)
|
|
"Return STATE's paint ledger, expanding a native frame only on demand."
|
|
(let ((ledger (plist-get state :surface-fragments)))
|
|
(if-let* ((frame (and (listp ledger)
|
|
(plist-get ledger :native-frame))))
|
|
(ebox-native-reflow-frame-fragments frame)
|
|
ledger)))
|
|
|
|
(defun ebox-surface--formatting-context-reflow-owned-ranges
|
|
(context leaf ranges state node-objects)
|
|
"Replace inferred owner ranges for the reflow context with one block range.
|
|
Ancestor-output role propagation can otherwise make a variable-line context
|
|
claim the first property run of the following sibling. The proof already
|
|
owns the complete old block, so its candidate scope is the exact new block;
|
|
all descendant ranges remain unchanged."
|
|
(let* ((proof (plist-get state :formatting-context-reflow-proof))
|
|
(owner-id (plist-get proof :owner-id))
|
|
(owner (and owner-id (gethash owner-id node-objects)))
|
|
(node (and owner-id (gethash owner-id (plist-get state :node-table))))
|
|
(region-id (and node (plist-get node :region-id)))
|
|
(block-start
|
|
(max 0
|
|
(1- (car (plist-get proof :old-block-span)))))
|
|
(block-end (+ block-start
|
|
(or (plist-get state
|
|
:formatting-context-reflow-new-length)
|
|
0)))
|
|
(filtered
|
|
(cl-remove-if (lambda (range)
|
|
(eq (plist-get range :object) owner))
|
|
ranges)))
|
|
(when (and owner region-id (integerp block-start) (> block-end block-start))
|
|
(push (list :object owner :start block-start :end block-end
|
|
:tags (list :ebox/region-id region-id
|
|
:ebox/roles '(content-owner content)))
|
|
filtered))
|
|
(setq filtered (nreverse filtered))
|
|
(tp-object-attach-content-ranges-owned context leaf filtered)
|
|
filtered))
|
|
|
|
(defun ebox-surface--surface-plan
|
|
(context surface-root output state node-objects region-objects
|
|
&optional transfer-text-p)
|
|
"Return one shared-text TP plan for OUTPUT and STATE.
|
|
NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
|
|
(let* ((fragment-root
|
|
(tp-object-ensure context surface-root
|
|
ebox-surface--fragments-key 'ebox/fragments))
|
|
(fragment-data
|
|
(or (and transfer-text-p
|
|
(plist-get state :retained-scroll-content-p)
|
|
(plist-get state :scroll-patch-fragment-data))
|
|
(and (eq output (plist-get state :native-render-output))
|
|
(plist-get state :native-render-fragment-template))
|
|
(and (eq (plist-get state :projection-kind)
|
|
'mixed-owner-reflow)
|
|
(plist-get state :mixed-owner-fragment-data))
|
|
(and (memq (plist-get state :projection-kind)
|
|
'(span-patch owner-scoped))
|
|
(plist-get state :span-patch-fragment-data))
|
|
(if (stringp output)
|
|
(ebox-surface--rendered-fragments output)
|
|
output)))
|
|
(rendered
|
|
(if (stringp output)
|
|
output
|
|
(if (and fragment-data
|
|
(plist-get (car fragment-data) :text-source-p))
|
|
(plist-get (car fragment-data) :text)
|
|
(apply #'concat
|
|
(mapcar (lambda (fragment)
|
|
(plist-get fragment :text))
|
|
fragment-data)))))
|
|
(text-leaf
|
|
(tp-object-ensure context fragment-root
|
|
ebox-surface--text-key 'ebox/text)))
|
|
(let* ((attach-p
|
|
(not (and transfer-text-p
|
|
(plist-get state :retained-scroll-content-p))))
|
|
(formatting-reflow-p
|
|
(or (eq (plist-get state :projection-kind)
|
|
'formatting-context-reflow)
|
|
(and (eq (plist-get state :projection-kind)
|
|
'mixed-owner-reflow)
|
|
(eq (plist-get (plist-get state :mixed-owner-proof)
|
|
:geometry-kind)
|
|
'formatting-context-reflow))))
|
|
(native-template-p
|
|
(and (vectorp fragment-data)
|
|
(eq output (plist-get state :native-render-output))))
|
|
(owned-ranges
|
|
(cond
|
|
((and native-template-p
|
|
(plist-get state :native-reuse-ownership-p))
|
|
(let ((ranges
|
|
(plist-get state :native-committed-owned-ranges)))
|
|
(unless ranges
|
|
(error "Native retained frame has no ownership base"))
|
|
(when attach-p
|
|
(tp-object-attach-content-ranges-owned
|
|
context text-leaf ranges))
|
|
ranges))
|
|
(native-template-p
|
|
;; Rust already supplied the exact target role template. Map
|
|
;; it once to TP objects instead of guessing target ownership
|
|
;; by rebasing every old range through every text edit.
|
|
(ebox-surface--native-owned-ranges
|
|
context text-leaf fragment-data state node-objects
|
|
region-objects (and attach-p (not formatting-reflow-p))))
|
|
(t
|
|
(let ((rebased
|
|
(and (memq (plist-get state :projection-kind)
|
|
'(span-patch owner-scoped
|
|
mixed-owner-reflow))
|
|
(not formatting-reflow-p)
|
|
(plist-get state :previous-surface-owned-ranges)
|
|
(plist-get state :content-coordinate-patches)
|
|
(ebox-surface--rebase-owned-ranges
|
|
(plist-get state :previous-surface-owned-ranges)
|
|
(plist-get state :content-coordinate-patches)
|
|
(length rendered)))))
|
|
(if rebased
|
|
(let ((ranges (cdr rebased)))
|
|
(when attach-p
|
|
(tp-object-attach-content-ranges-owned
|
|
context text-leaf ranges))
|
|
ranges)
|
|
(ebox-surface--owned-ranges
|
|
context text-leaf fragment-data state node-objects
|
|
region-objects
|
|
(and attach-p (not formatting-reflow-p)))))))))
|
|
(when formatting-reflow-p
|
|
(setq owned-ranges
|
|
(ebox-surface--formatting-context-reflow-owned-ranges
|
|
context text-leaf owned-ranges state node-objects)))
|
|
(plist-put state :surface-owned-ranges
|
|
(if native-template-p
|
|
owned-ranges
|
|
(ebox-surface--snapshot-owned-ranges owned-ranges)))
|
|
(when (plist-get state :native-render-p)
|
|
(plist-put state :native-committed-rendered rendered)
|
|
(plist-put state :native-committed-owned-ranges owned-ranges)
|
|
(when native-template-p
|
|
(plist-put state :native-committed-fragment-template fragment-data)))
|
|
(cl-remf state :native-reuse-ownership-p)
|
|
(cl-remf state :native-coordinate-patches)
|
|
(cl-remf state :native-render-output)
|
|
(cl-remf state :native-render-fragments)
|
|
(cl-remf state :native-render-fragment-template)
|
|
(cl-remf state :previous-surface-owned-ranges)
|
|
(let* ((plan-text
|
|
(if (or transfer-text-p
|
|
(plist-get state :native-render-p)
|
|
(plist-get state :mixed-owner-content-p)
|
|
(plist-get state :span-patch-content-p))
|
|
;; Scroll output is a fresh renderer-owned string. The TP
|
|
;; owned-result path copies the string spine once while
|
|
;; rendering the plan; recursively snapshotting every
|
|
;; property value here duplicated the hot scroll work.
|
|
rendered
|
|
(ebox-surface--candidate-plan-text
|
|
rendered (plist-get state :render-owned-text-values))))
|
|
(plan
|
|
(tp-surface-plan-create-owned
|
|
:key ebox-surface--root-key :kind 'ebox/surface
|
|
:children
|
|
(list (tp-surface-plan-create-owned
|
|
:key ebox-surface--fragments-key :kind 'ebox/fragments
|
|
:children
|
|
(list (tp-surface-plan-create-owned
|
|
:key ebox-surface--text-key :kind 'ebox/text
|
|
:text plan-text
|
|
:capability 'content))
|
|
:capability 'content))
|
|
:capability 'content)))
|
|
(plist-put state :surface-fragments
|
|
(cond
|
|
((plist-get state :native-render-frame)
|
|
(list :native-frame (plist-get state :native-render-frame)))
|
|
((or (plist-get state :mixed-owner-content-p)
|
|
(plist-get state :span-patch-content-p))
|
|
;; Mixed projection already produced fresh offset-only
|
|
;; fragment plists with retained paint chains.
|
|
fragment-data)
|
|
(t (ebox-surface--fragment-metadata fragment-data state))))
|
|
(cl-remf state :native-render-frame)
|
|
(cl-remf state :mixed-owner-fragment-data)
|
|
(cl-remf state :mixed-owner-content-p)
|
|
(cl-remf state :span-patch-fragment-data)
|
|
(cl-remf state :span-patch-content-p)
|
|
(let ((rendered-length (length rendered)))
|
|
(list plan rendered owned-ranges
|
|
(list (list :object text-leaf :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf t)
|
|
(list :object fragment-root :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf nil)
|
|
(list :object surface-root :start 0 :end rendered-length
|
|
:props nil :tags nil :leaf nil))))))))
|
|
|
|
(defconst ebox-surface--paint-base-roles
|
|
'(content content-owner pt pb pl pr bl br)
|
|
"Rendered roles that identify a box's painted border-box surface.")
|
|
|
|
(defun ebox-surface--node-depth (state node-id)
|
|
"Return NODE-ID depth in Ebox runtime STATE."
|
|
(let ((cached
|
|
(and ebox-surface--paint-node-depth-cache
|
|
(gethash node-id ebox-surface--paint-node-depth-cache
|
|
ebox-surface--paint-node-depth-missing))))
|
|
(if (and cached
|
|
(not (eq cached ebox-surface--paint-node-depth-missing)))
|
|
cached
|
|
(let ((key node-id)
|
|
(parents (plist-get state :parent-table))
|
|
(depth 0))
|
|
(while (setq node-id (and node-id (gethash node-id parents)))
|
|
(cl-incf depth))
|
|
(when ebox-surface--paint-node-depth-cache
|
|
(puthash key depth ebox-surface--paint-node-depth-cache))
|
|
depth))))
|
|
|
|
(defun ebox-surface--paint-node-chain (state role-ids)
|
|
"Return the deepest rendered node and its ancestors for ROLE-IDS."
|
|
(let ((cached
|
|
(and ebox-surface--paint-node-chain-cache
|
|
(gethash role-ids ebox-surface--paint-node-chain-cache
|
|
ebox-surface--paint-node-chain-missing))))
|
|
(if (and cached (not (eq cached ebox-surface--paint-node-chain-missing)))
|
|
cached
|
|
(let ((region-nodes (plist-get state :region-node-table))
|
|
(parents (plist-get state :parent-table)) deepest deepest-depth)
|
|
(dolist (entry role-ids)
|
|
(when-let* ((node-id (gethash (cdr entry) region-nodes)))
|
|
(let ((depth (ebox-surface--node-depth state node-id)))
|
|
(when (or (null deepest-depth) (> depth deepest-depth))
|
|
(setq deepest node-id deepest-depth depth)))))
|
|
(let (chain)
|
|
(while deepest
|
|
(push deepest chain)
|
|
(setq deepest (gethash deepest parents)))
|
|
(setq chain (nreverse chain))
|
|
(when ebox-surface--paint-node-chain-cache
|
|
(puthash role-ids chain ebox-surface--paint-node-chain-cache))
|
|
chain)))))
|
|
|
|
(defun ebox-surface--foreground-face (color)
|
|
"Return the Ebox foreground face for COLOR."
|
|
(if (eq color 'ebox/default-foreground)
|
|
'(:inherit default)
|
|
(list :foreground color)))
|
|
|
|
(defun ebox-surface--box-face-contributions (box)
|
|
"Return BOX typography and color contributions in render order."
|
|
(let (faces)
|
|
(when (ebox-style--text-paint-owner-p box)
|
|
(when-let* ((font (ebox-buffer--font-face box)))
|
|
(push font faces))
|
|
(when-let* ((color (plist-get box :color)))
|
|
(push (ebox-surface--foreground-face color) faces)))
|
|
(when-let* ((background (plist-get box :bgcolor)))
|
|
(push (list :background background) faces))
|
|
(nreverse faces)))
|
|
|
|
(defun ebox-surface--region-face-contributions (box roles ancestor-p)
|
|
"Return BOX face contributions for ROLES.
|
|
ANCESTOR-P means BOX wraps a more specific rendered surface."
|
|
(let (faces)
|
|
(cond
|
|
((memq 'overflow-foreground roles)
|
|
(when-let* ((color (plist-get box :color)))
|
|
(push (ebox-surface--foreground-face color) faces)))
|
|
((memq 'bl roles)
|
|
(push (ebox-buffer-side-border-face
|
|
(plist-get box :border-left-color)) faces))
|
|
((memq 'br roles)
|
|
(push (ebox-buffer-side-border-face
|
|
(plist-get box :border-right-color)) faces))
|
|
((or ancestor-p
|
|
(cl-intersection roles '(content content-owner pt pb pl pr)))
|
|
(setq faces (ebox-surface--box-face-contributions box))))
|
|
(when (and (memq 'bt roles) (plist-get box :border-top-p))
|
|
(setq faces
|
|
(append faces
|
|
(list (list :overline
|
|
(or (plist-get box :border-top-color) t))))))
|
|
(when (and (memq 'bb roles) (plist-get box :border-bottom-p))
|
|
(setq faces
|
|
(append
|
|
faces
|
|
(list
|
|
(list :underline
|
|
(append '(:position t)
|
|
(when-let* ((color
|
|
(plist-get box :border-bottom-color)))
|
|
(list :color color))))))))
|
|
faces))
|
|
|
|
(defconst ebox-surface--node-face-cache-missing
|
|
(make-symbol "ebox-node-face-cache-missing")
|
|
"Sentinel distinguishing a cached nil node face contribution from a miss.")
|
|
|
|
(defun ebox-surface--face-contributions (state role-ids &optional node-cache)
|
|
"Return semantic Ebox face contributions for ROLE-IDS in STATE."
|
|
(let ((nodes (plist-get state :node-table)) result first)
|
|
(setq first t)
|
|
(dolist (node-id (ebox-surface--paint-node-chain state role-ids))
|
|
(when-let* ((node (gethash node-id nodes))
|
|
(box (ebox-fragment-style-source-node node)))
|
|
(let* ((region-id (plist-get box :region-id))
|
|
(roles
|
|
(cl-loop for (role . owner) in role-ids
|
|
when (equal owner region-id) collect role))
|
|
(ancestor-p (not first))
|
|
(key (and node-cache (list node-id ancestor-p roles)))
|
|
(cached
|
|
(and node-cache
|
|
(gethash key node-cache
|
|
ebox-surface--node-face-cache-missing)))
|
|
(faces
|
|
(if (and node-cache
|
|
(not (eq cached
|
|
ebox-surface--node-face-cache-missing)))
|
|
cached
|
|
(let ((computed
|
|
(ebox-surface--region-face-contributions
|
|
box roles ancestor-p)))
|
|
(when node-cache
|
|
(puthash key computed node-cache))
|
|
computed))))
|
|
(dolist (face faces)
|
|
(push face result))
|
|
(setq first nil))))
|
|
(nreverse result)))
|
|
|
|
(defconst ebox-surface--face-cache-missing
|
|
(make-symbol "ebox-face-cache-missing")
|
|
"Sentinel distinguishing a cached nil face contribution from a miss.")
|
|
|
|
(defun ebox-surface--cached-face-contributions
|
|
(cache state role-ids &optional node-cache)
|
|
"Return CACHE's semantic face contribution for STATE and ROLE-IDS."
|
|
(let ((value (gethash role-ids cache ebox-surface--face-cache-missing)))
|
|
(if (eq value ebox-surface--face-cache-missing)
|
|
(let ((computed
|
|
(ebox-surface--face-contributions state role-ids node-cache)))
|
|
(puthash role-ids computed cache)
|
|
computed)
|
|
value)))
|
|
|
|
(defun ebox-surface--face-list (face)
|
|
"Return FACE as an ordered list of face entries."
|
|
(cond ((null face) nil)
|
|
((and (listp face) (keywordp (car-safe face))) (list face))
|
|
((listp face) (copy-sequence face))
|
|
(t (list face))))
|
|
|
|
(defun ebox-surface--face-value (entries)
|
|
"Return canonical face value represented by ENTRIES."
|
|
(pcase entries
|
|
('() nil)
|
|
(`(,entry) entry)
|
|
(_ entries)))
|
|
|
|
(defun ebox-surface--face-baseline (face contributions)
|
|
"Remove trailing Ebox CONTRIBUTIONS from FACE and return its baseline."
|
|
(let* ((entries (ebox-surface--face-list face))
|
|
(count (length contributions))
|
|
(baseline entries))
|
|
;; A prior paint projection may have appended the same semantic Ebox
|
|
;; contribution more than once. Peel every matching suffix layer before
|
|
;; composing the new state; caller-provided face entries remain untouched.
|
|
(while (and (> count 0)
|
|
(>= (length baseline) count)
|
|
(equal (last baseline count) contributions))
|
|
(setq baseline
|
|
(seq-take baseline (- (length baseline) count))))
|
|
(ebox-surface--face-value baseline)))
|
|
|
|
(defun ebox-surface--compose-face (baseline contributions)
|
|
"Append Ebox CONTRIBUTIONS to BASELINE using Emacs face semantics."
|
|
(let ((sample (make-string 1 ?x)))
|
|
(when baseline
|
|
(put-text-property 0 1 'face baseline sample))
|
|
(dolist (face contributions)
|
|
(add-face-text-property 0 1 face t sample))
|
|
(get-text-property 0 'face sample)))
|
|
|
|
(defun ebox-surface--layer-paint-contributions (output fragments state)
|
|
"Return baseline FRAGMENTS and retain ordered paint layers in STATE.
|
|
OUTPUT supplies source-backed fragment text. TP receives the resulting
|
|
relative face contributions and performs the final merge during prepare."
|
|
(let ((face-cache (make-hash-table :test #'equal))
|
|
(node-cache (make-hash-table :test #'equal))
|
|
(offset 0)
|
|
contributions result)
|
|
(dolist (fragment fragments)
|
|
(let* ((copy (copy-sequence fragment))
|
|
(source-p (plist-get fragment :text-source-p))
|
|
(text
|
|
(if source-p
|
|
(substring output
|
|
(plist-get fragment :start)
|
|
(plist-get fragment :end))
|
|
(copy-sequence (plist-get fragment :text))))
|
|
(length (length text))
|
|
(roles (plist-get fragment :paint-role-ids))
|
|
(affected-p (plist-member fragment :old-paint-role-ids))
|
|
(faces
|
|
(and affected-p
|
|
(ebox-surface--cached-face-contributions
|
|
face-cache state roles node-cache)))
|
|
(baseline
|
|
(and affected-p
|
|
(if (plist-get fragment :face-baseline-known-p)
|
|
(copy-tree (plist-get fragment :face-baseline))
|
|
(and (> length 0)
|
|
(ebox-surface--face-baseline
|
|
(get-text-property 0 'face text) faces))))))
|
|
(when (and affected-p (> length 0))
|
|
(if baseline
|
|
(put-text-property 0 length 'face baseline text)
|
|
(remove-text-properties 0 length '(face nil) text))
|
|
(when-let* ((face (ebox-surface--face-value faces)))
|
|
(let ((props (list 'face (copy-tree face))))
|
|
(if (and contributions
|
|
(= (plist-get (car contributions) :end) offset)
|
|
(equal-including-properties
|
|
(plist-get (car contributions) :props) props))
|
|
(plist-put (car contributions) :end (+ offset length))
|
|
(push (list :start offset :end (+ offset length)
|
|
:props props)
|
|
contributions)))))
|
|
(plist-put copy :text text)
|
|
(plist-put copy :text-source-p nil)
|
|
(plist-put copy :start offset)
|
|
(plist-put copy :end (+ offset length))
|
|
(when affected-p
|
|
(plist-put copy :face-baseline (copy-tree baseline))
|
|
(plist-put copy :face-baseline-known-p t))
|
|
(push copy result)
|
|
(setq offset (+ offset length))))
|
|
(plist-put state :paint-property-contributions
|
|
(nreverse contributions))
|
|
(nreverse result)))
|
|
|
|
(defun ebox-surface--fragment-has-region-role-p
|
|
(fragment region-id roles)
|
|
"Return non-nil when FRAGMENT carries REGION-ID under any of ROLES."
|
|
(cl-some (lambda (entry)
|
|
(and (equal (cdr entry) region-id)
|
|
(memq (car entry) roles)))
|
|
(plist-get fragment :paint-role-ids)))
|
|
|
|
(defun ebox-surface--horizontal-border-line (fragments region-id bottom-p)
|
|
"Return REGION-ID top or BOTTOM-P anchor line from FRAGMENTS."
|
|
(let (lines)
|
|
(dolist (fragment fragments)
|
|
(when (ebox-surface--fragment-has-region-role-p
|
|
fragment region-id ebox-surface--paint-base-roles)
|
|
(push (plist-get fragment :line) lines)))
|
|
(when lines (apply (if bottom-p #'max #'min) lines))))
|
|
|
|
(defun ebox-surface--set-horizontal-border-role
|
|
(fragments region-id role enabled)
|
|
"Set REGION-ID horizontal border ROLE to ENABLED in FRAGMENTS."
|
|
(let ((line (ebox-surface--horizontal-border-line
|
|
fragments region-id (eq role 'bb)))
|
|
(property (alist-get role ebox-region-types)))
|
|
(dolist (fragment fragments)
|
|
(let* ((anchor-p
|
|
(and enabled (equal (plist-get fragment :line) line)
|
|
(ebox-surface--fragment-has-region-role-p
|
|
fragment region-id ebox-surface--paint-base-roles)))
|
|
(pair (cons role region-id)))
|
|
(dolist (key '(:paint-role-ids :role-ids))
|
|
(let ((roles (cl-remove pair (plist-get fragment key) :test #'equal)))
|
|
(plist-put fragment key (if anchor-p (append roles (list pair)) roles))))
|
|
(when (> (length (plist-get fragment :text)) 0)
|
|
(if-let* ((owner
|
|
(cdr (cl-find role
|
|
(plist-get fragment :paint-role-ids)
|
|
:key #'car :test #'eq :from-end t))))
|
|
(put-text-property 0 (length (plist-get fragment :text))
|
|
property owner (plist-get fragment :text))
|
|
(remove-text-properties
|
|
0 (length (plist-get fragment :text))
|
|
(list property nil) (plist-get fragment :text)))))))
|
|
fragments)
|
|
|
|
(defun ebox-surface--paint-border-topology (fragments state dirty-set)
|
|
"Return FRAGMENTS with horizontal border roles updated from STATE."
|
|
(let ((nodes (plist-get state :node-table)))
|
|
(dolist (dirty dirty-set fragments)
|
|
(when-let* ((node (gethash (plist-get dirty :node-id) nodes))
|
|
(box (ebox-fragment-style-source-node node))
|
|
(region-id (plist-get box :region-id)))
|
|
(dolist (entry '((:border-top-p . bt) (:border-bottom-p . bb)))
|
|
(when (memq (car entry) (plist-get dirty :changed-keys))
|
|
(ebox-surface--set-horizontal-border-role
|
|
fragments region-id (cdr entry) (plist-get box (car entry)))))))))
|
|
|
|
(defun ebox-surface--repaint-fragment
|
|
(fragment old-state new-state &optional old-face-cache new-face-cache)
|
|
"Return FRAGMENT with Ebox paint recomputed from OLD-STATE to NEW-STATE."
|
|
(let* ((text (copy-sequence (plist-get fragment :text)))
|
|
(old-roles (plist-get fragment :old-paint-role-ids))
|
|
(new-roles (plist-get fragment :paint-role-ids))
|
|
(old-faces
|
|
(if old-face-cache
|
|
(ebox-surface--cached-face-contributions
|
|
old-face-cache old-state old-roles)
|
|
(ebox-surface--face-contributions old-state old-roles)))
|
|
(new-faces
|
|
(if new-face-cache
|
|
(ebox-surface--cached-face-contributions
|
|
new-face-cache new-state new-roles)
|
|
(ebox-surface--face-contributions new-state new-roles)))
|
|
(baseline (and (> (length text) 0)
|
|
(if (plist-get fragment :face-baseline-known-p)
|
|
(copy-tree (plist-get fragment :face-baseline))
|
|
(ebox-surface--face-baseline
|
|
(get-text-property 0 'face text) old-faces))))
|
|
(unchanged (and (equal old-roles new-roles)
|
|
(equal old-faces new-faces)))
|
|
(face (and (not unchanged)
|
|
(ebox-surface--compose-face baseline new-faces))))
|
|
(when (and (not unchanged) (> (length text) 0))
|
|
(if face
|
|
(put-text-property 0 (length text) 'face face text)
|
|
(remove-text-properties 0 (length text) '(face nil) text)))
|
|
(plist-put fragment :text text)
|
|
(cl-remf fragment :old-paint-role-ids)
|
|
fragment))
|
|
|
|
(defun ebox-surface--paint-fragments
|
|
(old-state new-state dirty-set old-text)
|
|
"Return OLD-STATE fragments repainted for NEW-STATE and DIRTY-SET.
|
|
OLD-TEXT is a defensive snapshot of the published TP content."
|
|
(unless (stringp old-text)
|
|
(error "Ebox paint projection has no published TP text"))
|
|
(let ((fragments
|
|
(mapcar
|
|
(lambda (fragment)
|
|
(let* ((copy (copy-tree fragment))
|
|
(text (substring old-text
|
|
(plist-get fragment :start)
|
|
(plist-get fragment :end))))
|
|
(plist-put copy :text text)
|
|
(plist-put copy :start 0)
|
|
(plist-put copy :end (length text))
|
|
(cl-remf copy :text-source-p)
|
|
(plist-put copy :old-paint-role-ids
|
|
(copy-tree (plist-get fragment :paint-role-ids)))
|
|
copy))
|
|
(ebox-surface--materialized-fragment-ledger old-state))))
|
|
(unless fragments
|
|
(error "Ebox paint projection has no published fragment topology"))
|
|
(ebox-surface--paint-border-topology fragments new-state dirty-set)
|
|
(mapcar (lambda (fragment)
|
|
(ebox-surface--repaint-fragment fragment old-state new-state))
|
|
fragments)))
|
|
|
|
(defun ebox-surface--refresh-paint-snapshots (state dirty-set)
|
|
"Refresh paint-significant layout snapshots in STATE for DIRTY-SET."
|
|
(let ((nodes (plist-get state :node-table))
|
|
(snapshots (plist-get state :layout-snapshots)))
|
|
(when (hash-table-p snapshots)
|
|
(dolist (dirty dirty-set)
|
|
(when-let* ((node-id (plist-get dirty :node-id))
|
|
(node (gethash node-id nodes))
|
|
(snapshot (gethash node-id snapshots)))
|
|
(plist-put snapshot :style-signature
|
|
(ebox-fragment-node-style-signature node)))))
|
|
state))
|
|
|
|
(defun ebox-surface--apply-state-overrides (state overrides)
|
|
"Apply plist OVERRIDES to candidate runtime STATE and return STATE."
|
|
(while overrides
|
|
(setq state (plist-put state (pop overrides) (pop overrides))))
|
|
state)
|
|
|
|
(defun ebox-surface--apply-scroll-offsets (root offsets)
|
|
"Apply surface-scoped scroll OFFSETS to matching boxes below ROOT."
|
|
(cl-labels
|
|
((visit (node)
|
|
(when (and (listp node) (not (stringp node)))
|
|
(when (eq (plist-get node :ebox-type) 'box)
|
|
(when-let* ((region-id (plist-get node :region-id))
|
|
(entry (assq region-id offsets)))
|
|
(ebox-put node :scroll-offset (cdr entry))))
|
|
(dolist (child (ebox-tree--children-raw node))
|
|
(visit child)))))
|
|
(visit root))
|
|
root)
|
|
|
|
(defun ebox-surface--context-axes (root)
|
|
"Return ROOT's exact viewport dependency axes without shared caches."
|
|
(let ((ebox--viewport-dependent-node-ids-cache
|
|
(make-hash-table :test 'eq))
|
|
(ebox--viewport-dependent-subtree-cache
|
|
(make-hash-table :test 'eq))
|
|
(ebox--viewport-height-dependent-subtree-cache
|
|
(make-hash-table :test 'eq)))
|
|
(ebox--viewport-dependent-node-id-axes root)))
|
|
|
|
(defun ebox-surface--mixed-projection-preserves-context-axes-p
|
|
(previous-state state-overrides projection-kind)
|
|
"Return non-nil when a mixed projection preserves viewport dependency axes.
|
|
PREVIOUS-STATE must own a completed axis index. STATE-OVERRIDES must carry a
|
|
strict mixed-owner proof whose changes are limited to content, TP surface
|
|
properties, or paint. Those values can change measurement or publication,
|
|
but cannot introduce or remove a viewport expression or node identity."
|
|
(and (eq projection-kind 'mixed-owner-reflow)
|
|
(plist-get previous-state :viewport-dependent-node-ids-ready)
|
|
(plist-member previous-state :viewport-dependent-node-id-axes)
|
|
(when-let* ((proof (plist-get state-overrides :mixed-owner-proof)))
|
|
(cl-every
|
|
(lambda (entry)
|
|
(cl-every
|
|
(lambda (key)
|
|
(or (memq key '(:content :surface-properties))
|
|
(memq key ebox--paint-style-signature-keys)))
|
|
(plist-get entry :changed-keys)))
|
|
(plist-get proof :dirty-set)))))
|
|
|
|
(defun ebox-surface--projection-state
|
|
(root previous-state state-overrides projection-kind
|
|
stylesheet-active-p cascade-required-p axes viewport-width
|
|
viewport-height display-signature scroll-offsets)
|
|
"Build candidate STATE with the mounted context values installed."
|
|
(let ((state
|
|
(ebox-surface--apply-state-overrides
|
|
(if (eq projection-kind 'paint)
|
|
(copy-sequence previous-state)
|
|
(ebox--new-buffer-render-state root))
|
|
(copy-sequence state-overrides))))
|
|
(plist-put state :root-node root)
|
|
(plist-put state :projection-kind projection-kind)
|
|
(plist-put state :cascade-active-p stylesheet-active-p)
|
|
(plist-put state :cascade-required-p cascade-required-p)
|
|
(when (and (memq projection-kind
|
|
'(span-patch owner-scoped mixed-owner-reflow))
|
|
(plist-get previous-state :surface-owned-ranges))
|
|
(plist-put state :previous-surface-owned-ranges
|
|
(plist-get previous-state :surface-owned-ranges)))
|
|
(when axes
|
|
(plist-put state :viewport-width viewport-width)
|
|
(plist-put state :viewport-height viewport-height)
|
|
(plist-put state :display-signature display-signature)
|
|
(plist-put state :viewport-dependent-node-id-axes axes)
|
|
(plist-put state :viewport-dependent-node-ids
|
|
(delete-dups (copy-sequence
|
|
(append (car axes) (cdr axes)))))
|
|
(plist-put state :viewport-dependent-node-ids-ready t)
|
|
(ebox-surface--apply-scroll-offsets root scroll-offsets))
|
|
state))
|
|
|
|
(defun ebox-surface--project
|
|
(context source previous-state preserve-identities-p state-overrides
|
|
signals projection-kind source-isolated-p source-path-copied-p)
|
|
"Project SOURCE in CONTEXT using PREVIOUS-STATE and identity policy.
|
|
PRESERVE-IDENTITIES-P retains existing Ebox node and region identities.
|
|
SIGNALS, when non-nil, supplies the mounted surface's host context.
|
|
PROJECTION-KIND may select a proven non-spatial projection.
|
|
SOURCE-ISOLATED-P means SOURCE is a private candidate owned by the current
|
|
publication attempt; it is safe to clear its transient attachments in place.
|
|
SOURCE-PATH-COPIED-P means SOURCE shares untouched Ebox nodes with the
|
|
published runtime and must be consumed without clearing those shared nodes."
|
|
(if (stringp source)
|
|
(let ((object
|
|
(tp-object-ensure context nil ebox-surface--root-key
|
|
'ebox/string)))
|
|
(ignore object)
|
|
(tp-surface-result-create
|
|
(tp-surface-plan-create
|
|
:key ebox-surface--root-key :kind 'ebox/string
|
|
:text source :capability 'content)))
|
|
(let* ((scroll-patch-p (eq projection-kind 'scroll-patch))
|
|
(initial-native-p
|
|
(and (null previous-state)
|
|
(null projection-kind)
|
|
(require 'ebox-native-reflow nil t)
|
|
(ebox-native-reflow-layout-ready-p)))
|
|
(scroll-fast-p
|
|
(and scroll-patch-p
|
|
(let ((table (plist-get state-overrides
|
|
:scroll-state-table))
|
|
(fast t))
|
|
(if (hash-table-p table)
|
|
(maphash
|
|
(lambda (_region-id scroll-state)
|
|
(unless
|
|
(ebox--scroll-state-retained-window-ready-p
|
|
scroll-state)
|
|
(setq fast nil)))
|
|
table)
|
|
(setq fast nil))
|
|
fast)))
|
|
(stylesheet-active-p
|
|
(if scroll-fast-p
|
|
(plist-get previous-state :cascade-active-p)
|
|
(ebox-style-cascade-active-p)))
|
|
(retained-runtime-source-p
|
|
(and previous-state
|
|
preserve-identities-p
|
|
(eq source (plist-get previous-state :root-node))
|
|
(or (memq projection-kind
|
|
'(viewport-reflow
|
|
viewport-reflow-mixed-scroll))
|
|
(and (eq projection-kind 'native-frame)
|
|
(plist-get state-overrides
|
|
:native-topology-stable-p)))
|
|
(plist-get state-overrides :runtime-index-prepared-p)
|
|
(plist-get state-overrides
|
|
:viewport-dependent-node-ids-ready)
|
|
(plist-member state-overrides
|
|
:viewport-dependent-node-id-axes)))
|
|
(retained-native-source-p
|
|
(and retained-runtime-source-p
|
|
(eq projection-kind 'native-frame)))
|
|
(root (cond
|
|
(source-path-copied-p source)
|
|
(source-isolated-p
|
|
(if (and (eq projection-kind 'native-frame)
|
|
(plist-get state-overrides
|
|
:native-topology-stable-p))
|
|
source
|
|
(ebox-surface--clear-runtime-attachments source)))
|
|
(retained-native-source-p source)
|
|
(t
|
|
(ebox-surface--candidate-root
|
|
source preserve-identities-p
|
|
retained-runtime-source-p))))
|
|
(state-overrides
|
|
(if (and (memq projection-kind
|
|
'(viewport-reflow viewport-reflow-mixed-scroll))
|
|
(not source-isolated-p)
|
|
(not source-path-copied-p))
|
|
(ebox-surface--isolated-viewport-overrides state-overrides)
|
|
state-overrides))
|
|
(inline-inheritance-required-p
|
|
(unless (or scroll-fast-p retained-runtime-source-p)
|
|
(ebox-surface--inline-inheritance-required-p root)))
|
|
(author-style-pending-p
|
|
(> (ebox-tree-author-style-count root) 0))
|
|
(cascade-required-p
|
|
(if (or scroll-fast-p retained-runtime-source-p)
|
|
(plist-get previous-state :cascade-required-p)
|
|
(or stylesheet-active-p
|
|
inline-inheritance-required-p)))
|
|
(style-required-p
|
|
(if scroll-fast-p
|
|
cascade-required-p
|
|
(or cascade-required-p
|
|
author-style-pending-p
|
|
(plist-get previous-state :cascade-active-p)
|
|
(plist-get previous-state :cascade-required-p))))
|
|
(projection
|
|
(ebox-surface--projection-start
|
|
context root style-required-p projection-kind previous-state
|
|
state-overrides)))
|
|
(unless (or source-isolated-p source-path-copied-p
|
|
retained-runtime-source-p)
|
|
(ebox-surface--reconcile-candidate root previous-state))
|
|
(let* ((context-axis-facts
|
|
(and
|
|
signals
|
|
(cond
|
|
((and scroll-fast-p
|
|
(plist-get previous-state
|
|
:viewport-dependent-node-ids-ready)
|
|
(plist-member
|
|
previous-state
|
|
:viewport-dependent-node-id-axes))
|
|
previous-state)
|
|
((and (memq projection-kind
|
|
'(viewport-reflow
|
|
viewport-reflow-mixed-scroll))
|
|
(plist-get
|
|
state-overrides
|
|
:viewport-dependent-node-ids-ready)
|
|
(plist-member
|
|
state-overrides
|
|
:viewport-dependent-node-id-axes))
|
|
;; The viewport planner owns this topology proof and
|
|
;; copies its exact axis partition into the candidate
|
|
;; contract. Rewalking the same immutable tree here
|
|
;; would only derive the identical fact a second time.
|
|
state-overrides)
|
|
((and (eq projection-kind 'native-frame)
|
|
(plist-get state-overrides
|
|
:native-topology-stable-p)
|
|
(plist-get state-overrides
|
|
:viewport-dependent-node-ids-ready)
|
|
(plist-member
|
|
state-overrides
|
|
:viewport-dependent-node-id-axes))
|
|
state-overrides)
|
|
((ebox-surface--mixed-projection-preserves-context-axes-p
|
|
previous-state state-overrides projection-kind)
|
|
previous-state))))
|
|
(reuse-context-axes-p (not (null context-axis-facts)))
|
|
(axes
|
|
(and signals
|
|
(if reuse-context-axes-p
|
|
(plist-get context-axis-facts
|
|
:viewport-dependent-node-id-axes)
|
|
(ebox-surface--context-axes root))))
|
|
(viewport-width
|
|
(and signals
|
|
(funcall
|
|
(if (car axes) #'tp-signal-read #'tp-signal-peek)
|
|
(ebox-surface--signals-viewport-width signals))))
|
|
(viewport-height
|
|
(and signals
|
|
(funcall
|
|
(if (cdr axes) #'tp-signal-read #'tp-signal-peek)
|
|
(ebox-surface--signals-viewport-height signals))))
|
|
(display-signature
|
|
(and signals
|
|
(tp-signal-read
|
|
(ebox-surface--signals-display signals))))
|
|
(scroll-offsets
|
|
(and signals
|
|
(tp-signal-peek
|
|
(ebox-surface--signals-scroll signals))))
|
|
(state
|
|
(ebox-surface--projection-state
|
|
root previous-state state-overrides projection-kind
|
|
stylesheet-active-p cascade-required-p axes viewport-width
|
|
viewport-height display-signature scroll-offsets)))
|
|
(when reuse-context-axes-p
|
|
(plist-put state :viewport-dependent-node-ids
|
|
(plist-get context-axis-facts
|
|
:viewport-dependent-node-ids))
|
|
(plist-put state :viewport-dependent-node-ids-ready t))
|
|
(plist-put state :style-binding-states
|
|
(plist-get projection :style-binding-states))
|
|
(plist-put state :selector-tree-snapshot
|
|
(plist-get projection :selector-tree-snapshot))
|
|
(plist-put state :selector-tree-token
|
|
(plist-get projection :selector-tree-token))
|
|
(plist-put state :stylesheet-signature
|
|
(plist-get projection :stylesheet-signature))
|
|
(plist-put state :scroll-fast-window-p scroll-fast-p)
|
|
(when (memq projection-kind
|
|
'(span-patch owner-scoped scroll-patch
|
|
formatting-context-reflow mixed-owner-reflow))
|
|
(ebox-surface--attach-retained-node-objects state)
|
|
(when (eq projection-kind 'owner-scoped)
|
|
(ebox-surface--apply-retained-owner-styles state)))
|
|
(if (eq projection-kind 'paint)
|
|
(let* ((dirty-set (plist-get state-overrides :paint-dirty-set))
|
|
(buffer (and signals
|
|
(ebox-surface--signals-buffer signals)))
|
|
(old-text
|
|
(and (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(save-restriction
|
|
(widen)
|
|
(buffer-substring (point-min) (point-max)))))))
|
|
(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* ((_initial-native
|
|
(when initial-native-p
|
|
;; Initial mount has no incremental planner. Surface owns
|
|
;; the full candidate after style projection and runtime
|
|
;; indexing, so it may explicitly request one native full
|
|
;; frame; unsupported programs still fall back through
|
|
;; `ebox-native-commit-render' without publishing state.
|
|
(plist-put state :projection-kind 'native-frame)))
|
|
(rendered
|
|
(cond
|
|
((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)
|
|
previous-state 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 :stylesheet-signature
|
|
(plist-get projection
|
|
:stylesheet-signature))
|
|
(plist-put state :region-box-table
|
|
(make-hash-table :test 'equal))
|
|
(ebox-surface--render-candidate state)))
|
|
(t
|
|
(ebox-surface--render-candidate state)))))
|
|
(when (and initial-native-p
|
|
(not (plist-get state :native-render-p)))
|
|
(plist-put state :projection-kind nil))
|
|
(when (and signals
|
|
(hash-table-p (plist-get state :scroll-state-table))
|
|
(> (hash-table-count
|
|
(plist-get state :scroll-state-table))
|
|
0))
|
|
(tp-signal-read (ebox-surface--signals-scroll signals)))
|
|
(setq state (ebox-surface--finish-runtime-state state))
|
|
(when (memq projection-kind
|
|
'(viewport-reflow viewport-reflow-mixed-scroll))
|
|
;; The reflow source is copied at this boundary. Attach the
|
|
;; retained objects only after its candidate indexes exist;
|
|
;; attaching before that point would mutate the published
|
|
;; node table through the old state's indexes.
|
|
(ebox-surface--attach-retained-node-objects state))
|
|
(let ((result
|
|
(ebox-surface--projection-result
|
|
context projection state rendered projection-kind)))
|
|
;; These flags authenticate one producer result only. Leaving
|
|
;; them in the committed client state would make a later
|
|
;; content/geometry update look like a scroll transaction and
|
|
;; bypass its scope validation.
|
|
(plist-put state :retained-scroll-content-p nil)
|
|
(plist-put state :native-scroll-materialize-p nil)
|
|
(cl-remf state :native-touched-node-ids)
|
|
(cl-remf state :native-removed-node-ids)
|
|
(cl-remf state :computed-participation-validated-p)
|
|
(cl-remf state :candidate-subject-table)
|
|
result)))))))
|
|
|
|
(defun ebox-surface-producer
|
|
(source &optional previous-state preserve-identities-p state-overrides
|
|
signals projection-kind source-isolated-p source-path-copied-p)
|
|
"Return a TP producer for Ebox SOURCE and optional PREVIOUS-STATE.
|
|
PRESERVE-IDENTITIES-P retains existing Ebox node and region identities.
|
|
STATE-OVERRIDES augments the candidate Ebox runtime state. SIGNALS carries
|
|
the mounted surface context; one-shot string materialization omits it.
|
|
PROJECTION-KIND may select a proven non-spatial projection.
|
|
SOURCE-ISOLATED-P means SOURCE is already an internally isolated runtime
|
|
candidate and must not be copied or reconciled again. SOURCE-PATH-COPIED-P
|
|
means SOURCE shares untouched Ebox nodes with the published runtime and must
|
|
also bypass candidate copying and reconciliation without clearing those nodes."
|
|
(lambda (context)
|
|
(let ((buffer (and signals (ebox-surface--signals-buffer signals))))
|
|
(if (buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(ebox-surface--project
|
|
context source previous-state preserve-identities-p state-overrides
|
|
signals projection-kind source-isolated-p source-path-copied-p))
|
|
(ebox-surface--project
|
|
context source previous-state preserve-identities-p state-overrides
|
|
signals projection-kind source-isolated-p source-path-copied-p)))))
|
|
|
|
(provide 'ebox-surface)
|
|
|
|
;;; ebox-surface.el ends here
|