From 71154f5f780811cdf07da9c086724f6605d29b5e Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 7 Sep 2026 05:03:36 +0800 Subject: [PATCH] perf: retain mount state across mixed geometry and paint updates --- ebox-surface.el | 272 ++++++++++++++++++------- tests/ebox-child-range-tests.el | 338 ++++++++++++++++++++++++++++++-- 2 files changed, 527 insertions(+), 83 deletions(-) diff --git a/ebox-surface.el b/ebox-surface.el index 63ecb11..c125743 100644 --- a/ebox-surface.el +++ b/ebox-surface.el @@ -1805,6 +1805,13 @@ the projection roots a second time." (ebox-surface--native-full-frame-p state projection-kind))) (previous-owned-ranges (plist-get state :previous-surface-owned-ranges)) + (retained-owned-ranges + (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)) + (plist-get state :span-patch-retained-owned-ranges))) (node-objects (or (and scroll-fast-p (plist-get state :surface-node-object-table)) @@ -1818,6 +1825,7 @@ the projection roots a second time." ;; 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 @@ -1831,11 +1839,12 @@ the projection roots a second time." (or (and native-retained-p (ebox-surface--native-patch-result context projection state output node-objects region-objects)) - (and (null property-contributions) + (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)) + 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))) @@ -1849,9 +1858,15 @@ the projection roots a second time." (or (and (null property-contributions) (memq projection-kind '(span-patch owner-scoped mixed-owner-reflow)) - (ebox-surface--coordinate-commit - context state rendered owned-ranges (nth 3 prepared) - previous-owned-ranges)) + (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)) @@ -1965,13 +1980,68 @@ content projection order; fragment and surface records follow unchanged." (ebox-surface--commit-mount-specs mount-records owned-ranges) :client-state state)))))) -(defun ebox-surface--coordinate-commit - (context state rendered owned-ranges mount-records previous-owned-ranges) - "Return STATE's exact proven-owner coordinate commit, or nil. -PREVIOUS-OWNED-RANGES identify the committed owner intervals. The mixed +(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." +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) @@ -2006,19 +2076,32 @@ batch without asking TP to rediscover the same diff from a full plan." :new-start (plist-get patch :new-start) :new-end (plist-get patch :new-end))) coordinate-patches)) - (dolist (range previous-owned-ranges) - (when (gethash (plist-get range :object) owner-set) - (when-let* ((new-start - (ebox-surface--rebase-coordinate - (plist-get range :start) coordinate-patches)) - (new-end - (ebox-surface--rebase-coordinate - (plist-get range :end) coordinate-patches))) - (push (list :old-start (plist-get range :start) - :old-end (plist-get range :end) - :new-start (car new-start) - :new-end (car new-end)) - intervals)))) + (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) @@ -2077,56 +2160,103 @@ batch without asking TP to rediscover the same diff from a full plan." :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 - (prog1 + (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) - (cl-remf state :content-base-extent)))))))) - -(defun ebox-surface--span-coordinate-result - (context projection state rendered previous-owned-ranges) - "Return a direct span commit from retained coordinate metadata, or nil." - (when-let* ((fragments - (or (plist-get state :mixed-owner-fragment-data) - (plist-get state :span-patch-fragment-data))) - (patches (plist-get state :content-coordinate-patches)) - (rebased - (and previous-owned-ranges - (ebox-surface--rebase-owned-ranges - previous-owned-ranges patches (length rendered)))) - (surface-root (plist-get projection :surface-root)) - (fragment-root - (tp-object-ensure context surface-root - ebox-surface--fragments-key 'ebox/fragments)) - (text-leaf - (tp-object-ensure context fragment-root - ebox-surface--text-key 'ebox/text))) - (let* ((owned-ranges (cdr rebased)) - (rendered-length (length rendered)) - (mount-records - (list (list :object text-leaf :start 0 :end rendered-length - :props nil :tags nil :leaf t) - (list :object fragment-root :start 0 :end rendered-length - :props nil :tags nil :leaf nil) - (list :object surface-root :start 0 :end rendered-length - :props nil :tags nil :leaf nil))) - (result - (ebox-surface--coordinate-commit - context state rendered owned-ranges mount-records - previous-owned-ranges))) - (when result - (plist-put state :surface-owned-ranges - (ebox-surface--snapshot-owned-ranges owned-ranges)) - (plist-put state :surface-fragments fragments) - (cl-remf state :previous-surface-owned-ranges) - (cl-remf state :mixed-owner-fragment-data) - (cl-remf state :mixed-owner-content-p) - (cl-remf state :span-patch-fragment-data) - (cl-remf state :span-patch-content-p) - result)))) + :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." @@ -3926,7 +4056,10 @@ Proof mismatches return nil; unexpected rendering errors propagate." output old-fragments (plist-get state :content-coordinate-patches))))) (plist-put state :span-patch-fragment-data fragments) - (plist-put state :span-patch-content-p t)) + (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 @@ -5617,6 +5750,7 @@ but cannot introduce or remove a viewport expression or node identity." (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 :root-node root) (when (plist-get state :native-sync-confirmed-p) (ebox-native-commit-attach-confirmed-base previous-state state)) diff --git a/tests/ebox-child-range-tests.el b/tests/ebox-child-range-tests.el index e0340b8..6a4d2ce 100644 --- a/tests/ebox-child-range-tests.el +++ b/tests/ebox-child-range-tests.el @@ -948,6 +948,23 @@ (ebox-child-range-test--assert-current-snapshot (current-buffer) ancestor)))))))) +(defun ebox-child-range-test--mixed-followup-candidate (buffer selected &optional title) + "Return BUFFER's title and row-paint candidate for SELECTED, using TITLE." + (let ((candidate (ebox-candidate-begin buffer))) + (ebox-candidate-replace-host-ref + candidate 'title + (ebox-test-text (propertize (or title (format "title-%d" selected)) + 'face '(:weight bold)) + :key 'title :source-identity 'title)) + (dolist (row '(1 2)) + (let ((ref (intern (format "row-%d" row)))) + (ebox-candidate-replace-host-ref + candidate ref + (ebox-test-box :key ref :source-identity ref + :color (if (= row selected) "#123456" "#654321") + (ebox-test-text (format "row-%d" row)))))) + candidate)) + (ert-deftest ebox-child-range-retained-kind-replacement-allows-mixed-followups () "Later title and row paint edits remain local beside disjoint scrolling." (with-temp-buffer @@ -960,6 +977,12 @@ (current-buffer) (ebox-child-range-test--replace-snapshot-detail (current-buffer) t)) (let* ((state (ebox--buffer-render-state (current-buffer))) + (surface ebox-surface--buffer-surface) + (mounts (tp--surface-mounts surface)) + (mount-ids (mapcar #'tp--surface-mount-id mounts)) + (mount-index (tp--surface-mount-index surface)) + (index (tp--surface-index surface)) + (ranges (plist-get state :surface-owned-ranges)) (scroll-id (car (plist-get state :scroll-region-ids))) (scroll (gethash scroll-id ebox--scroll-global-state)) (raw (plist-get scroll :content-lines)) @@ -972,22 +995,12 @@ (should scroll-id) (should (= (length (plist-get state :scroll-region-ids)) 1)) (dolist (selected '(2 1 2)) - (let* ((candidate (ebox-candidate-begin (current-buffer))) + (let* ((candidate + (ebox-child-range-test--mixed-followup-candidate + (current-buffer) selected)) (root-renders 0) (observer (lambda (&rest _arguments) (cl-incf root-renders))) report) - (ebox-candidate-replace-host-ref - candidate 'title - (ebox-test-text (propertize (format "title-%d" selected) - 'face '(:weight bold)) - :key 'title :source-identity 'title)) - (dolist (row '(1 2)) - (let ((ref (intern (format "row-%d" row)))) - (ebox-candidate-replace-host-ref - candidate ref - (ebox-test-box :key ref :source-identity ref - :color (if (= row selected) "#123456" "#654321") - (ebox-test-text (format "row-%d" row)))))) (advice-add 'ebox-surface--render-candidate :before observer) (unwind-protect (setq report (ebox-commit (current-buffer) candidate)) @@ -1001,11 +1014,308 @@ selected root-renders report)) (should (eq (plist-get report :projection-kind) 'mixed-owner-reflow)) (should (zerop root-renders)) - (should-not (plist-get report :tp-full-root))) + (should-not (plist-get report :tp-full-root)) + (should (plist-get (tp-surface-report surface) :commit-batch)) + (should (plist-get (tp-surface-report surface) :retained-mount-state)) + (should (eq mounts (tp--surface-mounts surface))) + (should (equal mount-ids + (mapcar #'tp--surface-mount-id + (tp--surface-mounts surface)))) + (should (eq mount-index (tp--surface-mount-index surface))) + (should (eq index (tp--surface-index surface))) + (should (eq ranges + (plist-get (ebox--buffer-render-state (current-buffer)) + :surface-owned-ranges)))) (let ((next-scroll (gethash scroll-id ebox--scroll-global-state))) (should (eq raw (plist-get next-scroll :content-lines))) (should (eq rendered (plist-get next-scroll :rendered-content-lines))))))))) +(ert-deftest ebox-child-range-mixed-followup-publish-failure-restores-and-retries () + "A failed public mixed commit restores the old generation before retry." + (with-temp-buffer + (ebox-render-to-buffer + (current-buffer) (ebox-child-range-test--snapshot-replacement-root)) + (ebox--ensure-layout-snapshot-details + (current-buffer) + (plist-get (ebox--host-ref-node (current-buffer) 'detail) :node-id)) + (ebox-commit + (current-buffer) + (ebox-child-range-test--replace-snapshot-detail (current-buffer) t)) + (let* ((state (ebox--buffer-render-state (current-buffer))) + (surface ebox-surface--buffer-surface) + (revision (tp-surface-revision surface)) + (previous-report (tp-surface-report surface)) + (before (buffer-string)) + (mounts (tp--surface-mounts surface)) + (mount-ids (mapcar #'tp--surface-mount-id mounts)) + (mount-index (tp--surface-mount-index surface)) + (index (tp--surface-index surface)) + (ranges (plist-get state :surface-owned-ranges)) + (scroll-id (car (plist-get state :scroll-region-ids))) + (scroll (gethash scroll-id ebox--scroll-global-state)) + trace) + (should-error + (ebox-commit + (current-buffer) + (ebox-child-range-test--mixed-followup-candidate (current-buffer) 2) + (lambda (_report) (push 'publish trace) (error "reject mixed publication")) + (lambda (_report) (push 'rollback trace)))) + (should (equal trace '(rollback publish))) + (should (eq state (ebox--buffer-render-state (current-buffer)))) + (should (eq state (tp-surface-client-state surface))) + (should (= revision (tp-surface-revision surface))) + (should (eq ranges (plist-get state :surface-owned-ranges))) + (should (eq mounts (tp--surface-mounts surface))) + (should (equal mount-ids (mapcar #'tp--surface-mount-id mounts))) + (should (eq mount-index (tp--surface-mount-index surface))) + (should (eq index (tp--surface-index surface))) + (should (eq scroll (gethash scroll-id ebox--scroll-global-state))) + (should (equal-including-properties before (buffer-string))) + (should (equal previous-report (tp-surface-report surface))) + (let ((report + (ebox-commit + (current-buffer) + (ebox-child-range-test--mixed-followup-candidate + (current-buffer) 2)))) + (ebox-child-range-test--assert-full-render-equivalent (current-buffer)) + (should (= (1+ revision) (tp-surface-revision surface))) + (should (eq (plist-get report :projection-kind) 'mixed-owner-reflow)) + (should-not (plist-get report :tp-full-root)) + (should (plist-get (tp-surface-report surface) :commit-batch)) + (should (plist-get (tp-surface-report surface) :retained-mount-state)) + (should (eq mounts (tp--surface-mounts surface))) + (should (equal mount-ids (mapcar #'tp--surface-mount-id mounts))) + (should (eq mount-index (tp--surface-mount-index surface))) + (should (eq index (tp--surface-index surface))) + (should (eq (plist-get scroll :content-lines) + (plist-get (gethash scroll-id ebox--scroll-global-state) + :content-lines))))))) + +(ert-deftest ebox-child-range-mixed-followup-removes-face-without-contribution () + "A paint owner with no new face still publishes its baseline-only removal." + (with-temp-buffer + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) + (ebox-test-column :bgcolor "#DDE7EF" + (ebox-test-text (propertize "title-1" 'face '(:weight bold)) + :key 'title :source-identity 'title)) + (ebox-test-box :key 'row-1 :source-identity 'row-1 :color "#123456" + (ebox-test-text (propertize "row-1" 'face '(:slant italic)))))) + (let* ((surface ebox-surface--buffer-surface) + (mounts (tp--surface-mounts surface)) + (mount-index (tp--surface-mount-index surface)) + (candidate (ebox-candidate-begin (current-buffer))) + (observed nil) (contributions 'not-observed) + (observer + (lambda (_context _projection state _output &optional kind) + (when (eq kind 'mixed-owner-reflow) + (setq observed t + contributions (plist-get state :paint-property-contributions))))) + report) + (ebox-candidate-replace-host-ref + candidate 'title + (ebox-test-text (propertize "title-2" 'face '(:weight bold)) + :key 'title :source-identity 'title)) + (ebox-candidate-replace-host-ref + candidate 'row-1 + (ebox-test-box :key 'row-1 :source-identity 'row-1 + (ebox-test-text (propertize "row-1" 'face '(:slant italic))))) + (advice-add 'ebox-surface--projection-result :before observer) + (unwind-protect + (setq report (ebox-commit (current-buffer) candidate)) + (advice-remove 'ebox-surface--projection-result observer)) + (ebox-child-range-test--assert-full-render-equivalent (current-buffer)) + (should observed) + (should-not contributions) + (should (eq (plist-get report :projection-kind) 'mixed-owner-reflow)) + (should (equal (get-text-property (string-match "row-1" (buffer-string)) + 'face (buffer-string)) + '(:slant italic))) + (should (plist-get (tp-surface-report surface) :commit-batch)) + (should (plist-get (tp-surface-report surface) :retained-mount-state)) + (should (eq mounts (tp--surface-mounts surface))) + (should (eq mount-index (tp--surface-mount-index surface)))))) + +(ert-deftest ebox-child-range-mixed-followup-coordinate-change-keeps-fallback () + "A longer title cannot claim the stable-coordinate mount-reuse proof." + (with-temp-buffer + (ebox-render-to-buffer + (current-buffer) (ebox-child-range-test--snapshot-replacement-root)) + (ebox-commit + (current-buffer) + (ebox-child-range-test--replace-snapshot-detail (current-buffer) t)) + (let ((extent (buffer-size))) + (ebox-commit + (current-buffer) + (ebox-child-range-test--mixed-followup-candidate + (current-buffer) 2 "title-2 with a longer extent")) + (should-not (= extent (buffer-size)))) + (ebox-child-range-test--assert-full-render-equivalent (current-buffer)) + (should-not (plist-get (tp-surface-report ebox-surface--buffer-surface) + :retained-mount-state)))) + +(ert-deftest ebox-child-range-mixed-followup-patch-layers-require-complete-coverage () + "Ordered paint may cross adjacent patches, but cannot disappear into a gap." + (let* ((baseline (propertize "abcdefgh" 'face 'bold 'help-echo "base")) + (patches + (mapcar (lambda (range) + (list :old-start (car range) :old-end (cdr range) + :new-start (car range) :new-end (cdr range) + :replacement (substring baseline (car range) (cdr range)))) + '((0 . 2) (2 . 4) (6 . 8)))) + (before (copy-tree patches)) + (layers '((:start 0 :end 4 :props (face italic)) + (:start 1 :end 3 :props (face nil help-echo nil)) + (:start 6 :end 8 :props (face (:foreground "red"))))) + (mapped (ebox-surface--patch-property-contributions patches layers 8)) + (batch (tp-commit-batch-create + :base-revision 1 :target-revision 2 :base-extent 8 :target-extent 8 + :patches mapped)) + (stored (tp-commit-batch-patches batch)) + (actual (concat (plist-get (nth 0 stored) :replacement) + (plist-get (nth 1 stored) :replacement) + (substring baseline 4 6) + (plist-get (nth 2 stored) :replacement)))) + (should (equal-including-properties + actual (tp--compose-relative-property-contributions baseline layers))) + (should (equal-including-properties before patches)) + (should-not (eq (car patches) (car mapped))) + (should-not + (ebox-surface--patch-property-contributions + patches '((:start 1 :end 7 :props (face italic))) 8)) + (dolist (invalid '((:start -1 :end 1 :props (face bold)) + (:start 0 :end 9 :props (face bold)) + (:start 0 :end 1 :props (face)))) + (should-not + (ebox-surface--patch-property-contributions patches (list invalid) 8))) + (should + (ebox-surface--patch-property-contributions + patches '((:start 5 :end 5 :props (face bold))) 8)))) + +(ert-deftest ebox-child-range-mixed-followup-proof-misses-preserve-fallback () + "Missing ownership or paint coverage returns to exact retained-content work." + (dolist (miss '(ownership coverage)) + (with-temp-buffer + (ebox-render-to-buffer + (current-buffer) (ebox-child-range-test--snapshot-replacement-root)) + (ebox-commit + (current-buffer) + (ebox-child-range-test--replace-snapshot-detail (current-buffer) t)) + (let* ((function (if (eq miss 'ownership) + 'ebox-surface--span-patch-output + 'ebox-surface--patch-property-contributions)) + observed + (observer + (lambda (original &rest arguments) + (setq observed t) + (when (eq miss 'ownership) + (prog1 (apply original arguments) + (cl-remf (nth 2 arguments) :span-patch-retained-owned-ranges)))))) + (advice-add function :around observer) + (unwind-protect + (ebox-commit + (current-buffer) + (ebox-child-range-test--mixed-followup-candidate (current-buffer) 2)) + (advice-remove function observer)) + (should observed) + (ebox-child-range-test--assert-full-render-equivalent (current-buffer)) + (should-not (plist-get (tp-surface-report ebox-surface--buffer-surface) + :retained-mount-state)))))) + +(ert-deftest ebox-child-range-mixed-followup-merger-errors-escape-proof-fallback () + "Even a constructor-like merger error propagates once and preserves state." + (with-temp-buffer + (ebox-render-to-buffer + (current-buffer) (ebox-child-range-test--snapshot-replacement-root)) + (ebox-commit + (current-buffer) + (ebox-child-range-test--replace-snapshot-detail (current-buffer) t)) + (let* ((surface ebox-surface--buffer-surface) + (state (ebox--buffer-render-state (current-buffer))) + (revision (tp-surface-revision surface)) + (mounts (tp--surface-mounts surface)) + (index (tp--surface-mount-index surface)) + (before (buffer-string)) + (merge-calls 0) (contributed-batches 0) contributed-face + (observer + (lambda (original &rest arguments) + (let* ((patches (mapcar #'copy-sequence (plist-get arguments :patches))) + (patch (cl-find-if + (lambda (entry) (plist-get entry :property-contributions)) + patches))) + (when patch + ;; Exception-boundary fixture: TP merges only over a present + ;; baseline property. Keep Ebox's actual generated layers, + ;; adding a baseline only to a detached constructor argument. + ;; Inline row faces would change the fixture's geometry proof. + (let* ((layer (car (plist-get patch :property-contributions))) + (start (plist-get layer :start)) + (replacement (copy-sequence (plist-get patch :replacement)))) + (should (< start (plist-get layer :end))) + (setq contributed-face (plist-get (plist-get layer :props) 'face)) + (should contributed-face) + (put-text-property start (1+ start) 'face '(:slant italic) replacement) + (plist-put patch :replacement replacement) + (setq arguments (plist-put (copy-sequence arguments) :patches patches)) + (cl-incf contributed-batches))) + (apply original arguments))))) + (let ((tp--property-policies (copy-hash-table tp--property-policies)) + (tp--property-policy-order (copy-sequence tp--property-policy-order))) + (tp-define-property-policy + (tp-text-property-id 'face) + :projector (tp-property-policy-projector + (tp-property-policy (tp-text-property-id 'face))) + :merge (lambda (old new) + (should (equal old '(:slant italic))) + (should (equal new contributed-face)) + (cl-incf merge-calls) + (signal 'tp-surface-error '(:commit-patch merger-failure)))) + (advice-add 'tp-commit-batch-create :around observer) + (unwind-protect + (let ((condition + (should-error + (ebox-commit + (current-buffer) + (ebox-child-range-test--mixed-followup-candidate + (current-buffer) 2)) + :type 'tp-surface-error))) + (should (equal (seq-take condition 3) + '(tp-surface-error :commit-patch merger-failure)))) + (advice-remove 'tp-commit-batch-create observer))) + (should (= contributed-batches 1)) + (should (= merge-calls 1)) + (should (= revision (tp-surface-revision surface))) + (should (eq state (tp-surface-client-state surface))) + (should (eq state (ebox--buffer-render-state (current-buffer)))) + (should (eq mounts (tp--surface-mounts surface))) + (should (eq index (tp--surface-mount-index surface))) + (should (equal-including-properties before (buffer-string))) + (ebox-commit + (current-buffer) + (ebox-child-range-test--mixed-followup-candidate (current-buffer) 2)) + (ebox-child-range-test--assert-full-render-equivalent (current-buffer)) + (should (plist-get (tp-surface-report surface) :retained-mount-state))))) + +(ert-deftest ebox-child-range-mixed-followup-role-change-keeps-fallback () + "Replacing text with a new box role cannot reuse the old mount topology." + (with-temp-buffer + (ebox-render-to-buffer + (current-buffer) (ebox-child-range-test--snapshot-replacement-root)) + (ebox-commit + (current-buffer) + (ebox-child-range-test--replace-snapshot-detail (current-buffer) t)) + (let ((candidate + (ebox-child-range-test--mixed-followup-candidate (current-buffer) 2))) + (ebox-candidate-replace-host-ref + candidate 'title + (ebox-test-box :key 'title :source-identity 'title + (ebox-test-text (propertize "title-2" 'face '(:weight bold))))) + (ebox-commit (current-buffer) candidate)) + (ebox-child-range-test--assert-full-render-equivalent (current-buffer)) + (should-not (plist-get (tp-surface-report ebox-surface--buffer-surface) + :retained-mount-state)))) + (ert-deftest ebox-child-range-does-not-reuse-disappeared-key-positionally () "A new keyed item must not inherit a removed peer's runtime identity." (let ((buffer (generate-new-buffer " *ebox-range-key-reentry*")))