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