From b624f4649933e762eaf029d60bf4b510918212cb Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 7 Sep 2026 02:36:22 +0800 Subject: [PATCH] perf: retain published properties for local owner text edits --- ebox-surface.el | 227 ++++++++++++++++++++++-- tests/ebox-commit-tests.el | 344 ++++++++++++++++++++++++++++++++++--- 2 files changed, 531 insertions(+), 40 deletions(-) diff --git a/ebox-surface.el b/ebox-surface.el index d0f89aa..fd81aeb 100644 --- a/ebox-surface.el +++ b/ebox-surface.el @@ -3385,11 +3385,179 @@ properties. Its local renderer cannot prove equivalence for such an owner." (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 (gethash old-id (plist-get previous-state :parent-table)) + new-id (gethash 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 + (gethash old-id (plist-get previous-state :node-table)))) + (new (ebox-fragment-style-source-node + (gethash 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--retained-owner-text + (buffer previous-state state owner-id spans replacement allocated-width + variable-content-p variable-content-max-width) + "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 (gethash owner-id + (plist-get previous-state :node-table))) + (new-node (gethash owner-id (plist-get state :node-table))) + (regions (ebox--node-all-region-ids old-node)) + (root (ebox-surface--candidate-root old-node t)) + (root (if (and variable-content-p allocated-width) + (plist-put root :width allocated-width) + root)) + (probe + (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 (gethash owner-id (plist-get previous-state + :parent-table))) + (parent (gethash parent-id (plist-get previous-state + :node-table)))) + (ebox-tree-display-inner parent)) + (plist-get previous-state :source-index) t))))) + (when (and replacement + (equal regions (ebox--node-all-region-ids new-node)) + (cl-every + (lambda (region) + (let* ((old-id (gethash region (plist-get previous-state + :region-node-table))) + (new-id (gethash region (plist-get state :region-node-table))) + (old (gethash old-id (plist-get previous-state :node-table))) + (new (gethash new-id (plist-get state :node-table)))) + (and (equal old-id new-id) + (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-shaped (ebox-surface--span-patch-lines + buffer spans old-rendered variable-content-p + variable-content-max-width)) + (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) + (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) + retain-external-owner-suffix-p previous-state) "Return validated patch details for OWNER-ID, or nil." (let* ( (old-snapshot @@ -3423,16 +3591,22 @@ properties. Its local renderer cannot prove equivalence for such an owner." (if (and node allocated-width (or variable-content-p role-owned-lines-p)) (plist-put (copy-sequence node) :width allocated-width) - node)))) + node))) + (retain-properties-p + (and (memq (plist-get state :projection-kind) + '(span-patch owner-scoped)) + (ebox-surface--owner-needs-ancestor-paint-p state owner-id)))) (when (and old-snapshot spans node render-node ;; Mixed projection has a separate paint recomposition step. ;; Ordinary spans have only the detached owner's rendered ;; faces; retain the full renderer when enclosing paint would ;; otherwise disappear from changed text. - (or (not (memq (plist-get state :projection-kind) - '(span-patch owner-scoped))) - (not (ebox-surface--owner-needs-ancestor-paint-p - state owner-id)))) + (or (not retain-properties-p) + (and previous-state + (not (or role-owned-lines-p allocation-closure-p + retain-external-owner-suffix-p)) + (ebox-surface--unchanged-enclosing-effects-p + previous-state state owner-id)))) (let* ((rendered (prog1 (ebox-surface--render-candidate-node state render-node) @@ -3480,14 +3654,22 @@ properties. Its local renderer cannot prove equivalence for such an owner." (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) + replacement)) (details (and replacement (ebox-surface--span-patch-details buffer old-snapshot node spans replacement - variable-content-p variable-content-max-width)))) + (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)))))) + :old-spans spans :details details + :retained-properties-p retain-properties-p)))))) (defun ebox-surface--range-patch-candidate (buffer state proof) "Return PROOF's exact equal-line Range replacement candidate, or nil." @@ -3577,14 +3759,24 @@ properties. Its local renderer cannot prove equivalence for such an owner." (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)))) + (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))))) - (when (and candidates (cl-every #'identity candidates)) + 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) @@ -3686,12 +3878,15 @@ properties. Its local renderer cannot prove equivalence for such an owner." (cdr (assq candidate rebased)) shared-generation)) (when-let* ((old-fragments - (ebox-surface--materialized-fragment-ledger - previous-state)) + (or retained-fragments + (ebox-surface--materialized-fragment-ledger + previous-state))) (fragments - (ebox-surface--incremental-patched-fragments - output old-fragments - (plist-get state :content-coordinate-patches)))) + (if retained-properties-p + (ebox-surface--fragment-metadata old-fragments) + (ebox-surface--incremental-patched-fragments + output old-fragments + (plist-get state :content-coordinate-patches))))) (plist-put state :span-patch-fragment-data fragments) (plist-put state :span-patch-content-p t)) output))))))) diff --git a/tests/ebox-commit-tests.el b/tests/ebox-commit-tests.el index 3db53ce..bd018ea 100644 --- a/tests/ebox-commit-tests.el +++ b/tests/ebox-commit-tests.el @@ -20,6 +20,22 @@ (widen) (buffer-substring (point-min) (point-max))))) +(defun ebox-commit-test--count-root-renders (function) + "Return (RESULT . COUNT) for FUNCTION and its full-root render calls." + (let* ((count 0) + (observer (lambda (&rest _arguments) (cl-incf count)))) + (advice-add 'ebox-surface--render-candidate :before observer) + (unwind-protect + (cons (funcall function) count) + (advice-remove 'ebox-surface--render-candidate observer)))) + +(defun ebox-commit-test--assert-full-render-equivalent () + "Assert current buffer exactly matches its committed root's full render." + (let* ((state (ebox--buffer-render-state (current-buffer))) + (expected (ebox--render-node (plist-get state :root-node) + (plist-get state :source-index)))) + (should (equal-including-properties expected (buffer-string))))) + (defun ebox-commit-test--face-value (face key) "Return KEY from FACE whether FACE is one plist or a face stack." (cond @@ -277,23 +293,47 @@ (get-text-property (1- (point)) 'face) :foreground))))) (ert-deftest ebox-commit-content-patch-retains-ancestor-paint () - "Changing text keeps the paint supplied by its containing boxes." + "Local text retains nested paint, caller faces and opaque property values." (with-temp-buffer - (ebox-render-to-buffer - (current-buffer) - (ebox-test-column :width '(200) :bgcolor "#FFFDF8" - (ebox-test-box :bgcolor "#E0E8E0" - (ebox-test-text "10" :key 'counter :source-identity 'counter)) - (ebox-test-text "untouched"))) - (let ((candidate (ebox-candidate-begin (current-buffer)))) - (ebox-candidate-replace-host-ref - candidate 'counter - (ebox-test-text "20" :key 'counter :source-identity 'counter)) - (ebox-commit (current-buffer) candidate)) - (let* ((state (ebox--buffer-render-state (current-buffer))) - (expected (ebox--render-node (plist-get state :root-node) - (plist-get state :source-index)))) - (should (equal-including-properties expected (buffer-string)))))) + (let* ((callback (lambda () 'counter-action)) + (payload (make-hash-table :test #'eq)) + (slot (tp-paint-slot-create '(:background "#E0E8E0"))) + (face '(:weight bold))) + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) :bgcolor "#FFFDF8" + :surface-properties (list 'help-echo callback) + (ebox-test-box :bgcolor slot + (ebox-test-text (propertize "10" 'face face 'custom payload) + :key 'counter :source-identity 'counter)) + (ebox-test-text "untouched"))) + (let* ((candidate (ebox-candidate-begin (current-buffer))) + (before-id (plist-get (ebox--host-ref-node (current-buffer) 'counter) + :node-id))) + (ebox-candidate-replace-host-ref + candidate 'counter + (ebox-test-text (propertize "20" 'face face 'custom payload) + :key 'counter :source-identity 'counter)) + (let* ((result (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) candidate)))) + (report (car result))) + (ebox-commit-test--assert-full-render-equivalent) + (should (= before-id + (plist-get (ebox--host-ref-node (current-buffer) 'counter) + :node-id))) + (dotimes (offset 2) + (let ((position (+ (point-min) offset))) + (should (eq callback (get-text-property position 'help-echo))) + (should (eq payload (get-text-property position 'custom))) + (should (eq 'bold + (ebox-commit-test--face-value + (get-text-property position 'face) :weight))) + (should (memq (tp-paint-slot-face slot) + (flatten-tree (get-text-property position 'face)))))) + (should (zerop (cdr result))) + (should (memq (plist-get report :projection-kind) + '(span-patch owner-scoped))) + (should-not (plist-get report :tp-full-root))))))) (ert-deftest ebox-commit-content-patch-retains-ancestor-surface-properties () "Changing text retains properties supplied by its containing box." @@ -301,17 +341,273 @@ (ebox-render-to-buffer (current-buffer) (ebox-test-column :width '(200) :surface-properties '(help-echo "parent") - (ebox-test-text "10" :key 'counter :source-identity 'counter) + (ebox-test-text "10" :key 'counter :source-identity (list 'counter)) (ebox-test-text "untouched"))) (let ((candidate (ebox-candidate-begin (current-buffer)))) (ebox-candidate-replace-host-ref - candidate 'counter - (ebox-test-text "20" :key 'counter :source-identity 'counter)) - (ebox-commit (current-buffer) candidate)) - (let* ((state (ebox--buffer-render-state (current-buffer))) - (expected (ebox--render-node (plist-get state :root-node) - (plist-get state :source-index)))) - (should (equal-including-properties expected (buffer-string)))))) + candidate (list 'counter) + (ebox-test-text "20" :key 'counter :source-identity (list 'counter))) + (let ((result (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) candidate))))) + (ebox-commit-test--assert-full-render-equivalent) + (should (zerop (cdr result))) + (should-not (plist-get (car result) :tp-full-root)))))) + +(ert-deftest ebox-commit-inherited-box-checkbox-roundtrip-retains-properties () + "A fixed-width Box under Flex retains paint with fresh equal identities." + (with-temp-buffer + (let ((previous-identity (list 'control 'checkbox))) + (cl-labels + ((checkbox (text identity) + (ebox-test-box :key 'checkbox :source-identity identity :width '(24) + (ebox-test-text text :key 'glyph + :source-identity (append identity '(glyph)))))) + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) :bgcolor "#FFFDF8" + (ebox-test-flex :width '(160) :height 1 :bgcolor "#E0E8E0" + :surface-properties '(help-echo "checkbox control") + (checkbox "□" previous-identity)) + (ebox-test-text "untouched"))) + (let ((owner-id + (plist-get (ebox--host-ref-node (current-buffer) previous-identity) + :node-id))) + (dolist (text '("☑" "□" "☑" "□")) + (let ((identity (list 'control 'checkbox)) + (candidate (ebox-candidate-begin (current-buffer)))) + (should (equal previous-identity identity)) + (should-not (eq previous-identity identity)) + (ebox-candidate-replace-host-ref + candidate identity (checkbox text identity)) + (let* ((result (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) candidate)))) + (report (car result))) + (ebox-commit-test--assert-full-render-equivalent) + (should (string-prefix-p text (buffer-string))) + (should (= owner-id + (plist-get (ebox--host-ref-node (current-buffer) identity) + :node-id))) + (should (equal "checkbox control" + (get-text-property (point-min) 'help-echo))) + (should (zerop (cdr result))) + (should (memq (plist-get report :projection-kind) + '(span-patch owner-scoped))) + (should-not (plist-get report :tp-full-root))) + (setq previous-identity identity)))))))) + +(ert-deftest ebox-commit-inherited-text-roundtrip-keeps-paint-provenance () + "Repeated text edits retain the baseline needed to replace/remove paint." + (with-temp-buffer + (let ((face '(:weight bold)) + (callback (lambda () 'counter-action))) + (cl-labels + ((counter (text) + (ebox-test-text (propertize text 'face face 'action callback) + :key 'counter :source-identity 'counter)) + (parent (color) + (apply #'ebox-test-box + (append (list :key 'parent :source-identity 'parent + :surface-properties '(help-echo "parent") + (counter "10")) + (and color (list :bgcolor color)))))) + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) :bgcolor "#FFFDF8" + (parent "#E0E8E0") + (ebox-test-text "untouched"))) + (let* ((initial (ebox--buffer-render-state (current-buffer))) + (fragments (copy-tree (plist-get initial :surface-fragments))) + (root-renders 0) + (counter-id + (plist-get (ebox--host-ref-node (current-buffer) 'counter) + :node-id))) + (dolist (text '("20" "10" "20" "10")) + (let ((candidate (ebox-candidate-begin (current-buffer)))) + (ebox-candidate-replace-host-ref candidate 'counter (counter text)) + (let ((result (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) candidate))))) + (ebox-commit-test--assert-full-render-equivalent) + (should (equal fragments + (plist-get (ebox--buffer-render-state (current-buffer)) + :surface-fragments))) + (cl-incf root-renders (cdr result))))) + (let ((previous "#E0E8E0")) + (dolist (color '("#667788" nil)) + (let ((candidate (ebox-candidate-begin (current-buffer)))) + (should (ebox-candidate-patch-host-paint + candidate 'parent (parent previous) (parent color))) + (let ((report (ebox-commit (current-buffer) candidate))) + (should (eq (plist-get report :projection-kind) 'paint))) + (ebox-commit-test--assert-full-render-equivalent) + (should (eq callback (get-text-property (point-min) 'action))) + (should (eq 'bold + (ebox-commit-test--face-value + (get-text-property (point-min) 'face) :weight))) + (should (equal (or color "#FFFDF8") + (ebox-commit-test--face-value + (get-text-property (point-min) 'face) :background))) + (should (= counter-id + (plist-get (ebox--host-ref-node (current-buffer) 'counter) + :node-id)))) + (setq previous color))) + (should (zerop root-renders))))))) + +(ert-deftest ebox-commit-inherited-text-exclusions-render-current-properties () + "Property, extent, display and identity changes retain the exact fallback." + (dolist (change '(property char-length display identity opaque-callback)) + (ert-info ((format "inherited text exclusion: %S" change)) + (with-temp-buffer + (let* ((make-callback (lambda () + (let ((value (vector t))) (lambda () value)))) + (old-callback (funcall make-callback)) + (new-callback (if (eq change 'opaque-callback) + (funcall make-callback) old-callback)) + (old (propertize "10" 'help-echo "old" 'action old-callback)) + (new (propertize (if (eq change 'char-length) "200" "20") + 'help-echo (if (eq change 'property) "new" "old") + 'action new-callback))) + (when (eq change 'opaque-callback) + (should (equal old-callback new-callback)) + (should-not (eq old-callback new-callback))) + (when (eq change 'display) + (add-text-properties 0 2 '(display (raise 0)) old) + (add-text-properties 0 2 '(display (raise 0)) new)) + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) :bgcolor "#FFFDF8" + (ebox-test-text old :key 'counter :source-identity 'counter) + (ebox-test-text "untouched"))) + (let ((candidate (ebox-candidate-begin (current-buffer)))) + (ebox-candidate-replace-host-ref + candidate 'counter + (ebox-test-text new :key 'counter + :source-identity + (if (eq change 'identity) 'new-counter 'counter))) + (let ((result (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) candidate))))) + (ebox-commit-test--assert-full-render-equivalent) + (should (eq new-callback (get-text-property (point-min) 'action))) + (when (eq change 'identity) + (should-not (ebox--host-ref-node (current-buffer) 'counter)) + (should (ebox--host-ref-node (current-buffer) 'new-counter))) + (should (> (cdr result) 0))))))))) + +(ert-deftest ebox-commit-inherited-text-rolls-back-properties-and-retries () + "Late publication rejection retains text, metadata and one old generation." + (with-temp-buffer + (let ((callback (lambda () 'counter-action)) + (face '(:weight bold))) + (cl-labels + ((counter (text) + (ebox-test-text (propertize text 'face face 'action callback) + :key 'counter :source-identity 'counter)) + (candidate () + (let ((candidate (ebox-candidate-begin (current-buffer)))) + (ebox-candidate-replace-host-ref candidate 'counter (counter "20")) + candidate))) + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) :bgcolor "#FFFDF8" + :surface-properties '(help-echo "parent") + (counter "10") (ebox-test-text "untouched"))) + (let* ((before (buffer-string)) + (state (ebox--buffer-render-state (current-buffer))) + (fragments (copy-tree (plist-get state :surface-fragments))) + (revision (tp-surface-revision ebox-surface--buffer-surface)) + (rejected + (ebox-commit-test--count-root-renders + (lambda () + (cl-letf (((symbol-function 'accept-change-group) + (lambda (_) (error "Reject inherited text")))) + (should-error (ebox-commit (current-buffer) (candidate)))))))) + (should (equal (car rejected) '(error "Reject inherited text"))) + (should (eq state (ebox--buffer-render-state (current-buffer)))) + (should (equal fragments (plist-get state :surface-fragments))) + (should (= revision (tp-surface-revision ebox-surface--buffer-surface))) + (should (equal-including-properties before (buffer-string))) + (should (eq callback (get-text-property (point-min) 'action))) + (let ((retry (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) (candidate)))))) + (ebox-commit-test--assert-full-render-equivalent) + (should (string-prefix-p "20" (buffer-string))) + (should (eq callback (get-text-property (point-min) 'action))) + (should (equal fragments + (plist-get (ebox--buffer-render-state (current-buffer)) + :surface-fragments))) + (should (zerop (cdr rejected))) + (should (zerop (cdr retry))) + (should-not (plist-get (car retry) :tp-full-root)))))))) + +(ert-deftest ebox-commit-inherited-text-probe-error-aborts-before-publication () + "An old-owner probe failure propagates intact and permits a local retry." + (with-temp-buffer + (let ((callback (lambda () 'counter-action))) + (cl-labels + ((counter (text) + (ebox-test-text (propertize text 'action callback 'face '(:weight bold)) + :key 'counter :source-identity 'counter)) + (candidate () + (let ((candidate (ebox-candidate-begin (current-buffer)))) + (ebox-candidate-replace-host-ref candidate 'counter (counter "20")) + candidate))) + (ebox-render-to-buffer + (current-buffer) + (ebox-test-column :width '(200) :bgcolor "#FFFDF8" + :surface-properties '(help-echo "parent") + (counter "10") (ebox-test-text "untouched"))) + (let* ((before (buffer-string)) + (state (ebox--buffer-render-state (current-buffer))) + (fragments (copy-tree (plist-get state :surface-fragments))) + (surface ebox-surface--buffer-surface) + (revision (tp-surface-revision surface)) + (modified-tick (buffer-modified-tick)) + (owner-id (plist-get (ebox--host-ref-node (current-buffer) 'counter) + :node-id)) + (payload (make-symbol "old-owner-probe")) + (failure-data (list "Old-owner probe invariant failed" payload)) + (old-probes 0) + (publications 0) + (injector + (lambda (render-state node) + (when (and (eq node (plist-get render-state :root-node)) + (equal owner-id (plist-get node :node-id)) + (ebox-text-node-p node) + (equal "10" (ebox-text-node-value node))) + (cl-incf old-probes) + (signal 'error failure-data)))) + rejected) + (advice-add 'ebox-surface--render-candidate-node :before injector) + (unwind-protect + (setq rejected + (ebox-commit-test--count-root-renders + (lambda () + (condition-case condition + (ebox-commit (current-buffer) (candidate) + (lambda (_report) (cl-incf publications))) + (error condition))))) + (advice-remove 'ebox-surface--render-candidate-node injector)) + (should (= old-probes 1)) + (should (equal (car rejected) (cons 'error failure-data))) + (should (eq payload (nth 2 (car rejected)))) + (should (zerop publications)) + (should (zerop (cdr rejected))) + (should (eq state (ebox--buffer-render-state (current-buffer)))) + (should (eq surface ebox-surface--buffer-surface)) + (should (= revision (tp-surface-revision surface))) + (should (= modified-tick (buffer-modified-tick))) + (should (equal fragments (plist-get state :surface-fragments))) + (should (equal-including-properties before (buffer-string))) + (should (eq callback (get-text-property (point-min) 'action))) + (let* ((retry (ebox-commit-test--count-root-renders + (lambda () (ebox-commit (current-buffer) (candidate))))) + (report (car retry))) + (ebox-commit-test--assert-full-render-equivalent) + (should (string-prefix-p "20" (buffer-string))) + (should (eq callback (get-text-property (point-min) 'action))) + (should (zerop (cdr retry))) + (should (memq (plist-get report :projection-kind) + '(span-patch owner-scoped))) + (should-not (plist-get report :tp-full-root)))))))) (ert-deftest ebox-commit-range-patch-retains-ancestor-paint () "An equal-line Range replacement retains enclosing paint."