Make GC liveness and track-buffer scans stack-aware; GC moves to tp-layer
tp--buffer-has-layer-region-p tested liveness with a direct tp-name property search, which only sees the rendered top layer of each run. A layer buried below a pushed top, or hidden via tp-hide-layer, keeps its tp-name inside the tp-layers storage property, so: - tp-gc-anonymous-layers undefined layers a live buffer still held, destroying their definitions and reactive deps; pop/show later resurfaced text whose reactivity was permanently dead; - tp-reactive-track-buffer (the documented remedy for the string-insertion registration gap) never registered buried or hidden layers either, so the gap-closer itself had the gap. Fix: - tp-reactive.el gains the shared stack-aware scan tp-reactive--buffer-layer-names: a tp--map-intervals walk that collects the direct tp-name of each run plus the tp-name of every plist inside the run's tp-layers value (read as a plain list of plists, so tp-reactive needs nothing from the stack module). tp-reactive-track-buffer is rewritten on it. - tp--buffer-has-layer-region-p is rewritten on the same scan and moves - together with tp-gc-anonymous-layers (autoload kept) - from tp-render.el into tp-layer.el beside tp--anonymous-layer-registry, so the whole anonymous-layer lifecycle (mint, intern, undefine, collect) lives in one module and tp-render sheds its only non-rendering responsibility. tp-render's tp--map-layer-buffers keeps calling the predicate downward. Regression tests port the review's gc1/xm02 probes: buried-under-push kept alive with reactivity surviving a later pop; hidden layer kept alive with show+setq re-rendering; track-buffer registering buried and all-hidden layers from inserted strings. Existing tests cover the visible-kept and killed-buffer-collected control cases. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
parent
cd31652c6e
commit
b49e2740e8
49
tp-layer.el
49
tp-layer.el
@ -69,6 +69,55 @@ and record it in `tp--anonymous-layer-registry'."
|
|||||||
(push (cons (copy-tree props) name) tp--anonymous-layer-registry)
|
(push (cons (copy-tree props) name) tp--anonymous-layer-registry)
|
||||||
name)))
|
name)))
|
||||||
|
|
||||||
|
(defun tp--buffer-has-layer-region-p (layer-name &optional buffer)
|
||||||
|
"Return non-nil when BUFFER has a region carrying LAYER-NAME.
|
||||||
|
BUFFER defaults to the current buffer; a dead BUFFER yields nil.
|
||||||
|
Stack-aware: the layer counts as present when it is the rendered top
|
||||||
|
layer (direct `tp-name' text property) or sits anywhere inside the
|
||||||
|
`tp-layers' stack-storage property - buried below another layer, or
|
||||||
|
hidden (see `tp-hide-layer') - so liveness checks never miss a layer
|
||||||
|
a live buffer still holds. Built on the shared scan
|
||||||
|
`tp-reactive--buffer-layer-names'."
|
||||||
|
(and (member layer-name (tp-reactive--buffer-layer-names buffer)) t))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun tp-gc-anonymous-layers ()
|
||||||
|
"Collect anonymous layers that no live buffer displays anymore.
|
||||||
|
Walk `tp--anonymous-layer-registry' and, for every interned anonymous
|
||||||
|
layer whose buffer registry has real knowledge (see
|
||||||
|
`tp-reactive-layer-buffers'), check whether any registered live
|
||||||
|
buffer still contains a region carrying the layer - as the rendered
|
||||||
|
top layer or anywhere inside `tp-layers' stack storage, so buried and
|
||||||
|
hidden layers count as alive (see `tp--buffer-has-layer-region-p').
|
||||||
|
Layers displayed nowhere are undefined via `tp-undefine-layer', which
|
||||||
|
also drops their reactive dependencies, transforms and registry
|
||||||
|
entries.
|
||||||
|
|
||||||
|
Layers whose registry state is `unknown' are conservatively kept:
|
||||||
|
they were never seen in any buffer through the registering paths,
|
||||||
|
and detached strings may still reference them. A layer becomes
|
||||||
|
collectable only after it was registered for at least one buffer and
|
||||||
|
none of the registered buffers still shows it (for example after the
|
||||||
|
buffers were killed); call `tp-reactive-track-buffer' after
|
||||||
|
inserting propertized strings so their buffers are registered too.
|
||||||
|
|
||||||
|
Return the list of collected layer names."
|
||||||
|
(interactive)
|
||||||
|
(let ((collected nil))
|
||||||
|
;; Snapshot the names first: `tp-undefine-layer' mutates the
|
||||||
|
;; anonymous-layer registry while we iterate.
|
||||||
|
(dolist (name (mapcar #'cdr tp--anonymous-layer-registry))
|
||||||
|
(let ((bufs (tp-reactive-layer-buffers name)))
|
||||||
|
(when (and (not (eq bufs 'unknown))
|
||||||
|
(not (cl-some (lambda (buf)
|
||||||
|
(tp--buffer-has-layer-region-p name buf))
|
||||||
|
bufs)))
|
||||||
|
(tp-undefine-layer name)
|
||||||
|
(push name collected))))
|
||||||
|
(when (called-interactively-p 'interactive)
|
||||||
|
(message "tp: collected %d anonymous layer(s)" (length collected)))
|
||||||
|
(nreverse collected)))
|
||||||
|
|
||||||
(defvar tp--layer-expansion-stack nil
|
(defvar tp--layer-expansion-stack nil
|
||||||
"Layer names currently being expanded, innermost first.
|
"Layer names currently being expanded, innermost first.
|
||||||
Dynamically bound during `tp-layer-props' / `tp-layer-props-with-arg'
|
Dynamically bound during `tp-layer-props' / `tp-layer-props-with-arg'
|
||||||
|
|||||||
@ -101,12 +101,41 @@ finds it or `tp-reactive-track-buffer' is called on it."
|
|||||||
(puthash layer-name live tp--layer-buffers))
|
(puthash layer-name live tp--layer-buffers))
|
||||||
live))))
|
live))))
|
||||||
|
|
||||||
|
(defun tp-reactive--buffer-layer-names (&optional buffer)
|
||||||
|
"Return the layer names present in BUFFER, in buffer order.
|
||||||
|
BUFFER defaults to the current buffer; a dead BUFFER yields nil.
|
||||||
|
Stack-aware: a layer counts as present when its name is the direct
|
||||||
|
`tp-name' text property of a run (the rendered top layer) or the
|
||||||
|
`tp-name' of any layer plist inside the run's `tp-layers'
|
||||||
|
stack-storage property (layers buried below the top, or hidden - see
|
||||||
|
tp-stack.el). The `tp-layers' value is read as a plain list of
|
||||||
|
plists, so this helper stays below the stack module. Names are
|
||||||
|
deduplicated with `equal'. This is the shared scan behind
|
||||||
|
`tp-reactive-track-buffer' and the anonymous-layer GC's liveness
|
||||||
|
test `tp--buffer-has-layer-region-p'."
|
||||||
|
(let ((buf (or buffer (current-buffer)))
|
||||||
|
(found nil))
|
||||||
|
(when (buffer-live-p buf)
|
||||||
|
(tp--map-intervals
|
||||||
|
buf nil nil
|
||||||
|
(lambda (_start _end props)
|
||||||
|
(let ((direct (plist-get props 'tp-name)))
|
||||||
|
(when (and direct (not (member direct found)))
|
||||||
|
(push direct found)))
|
||||||
|
(dolist (layer (plist-get props 'tp-layers))
|
||||||
|
(let ((name (plist-get layer 'tp-name)))
|
||||||
|
(when (and name (not (member name found)))
|
||||||
|
(push name found)))))))
|
||||||
|
(nreverse found)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun tp-reactive-track-buffer (&optional buffer)
|
(defun tp-reactive-track-buffer (&optional buffer)
|
||||||
"Scan BUFFER for layer regions and register it in the buffer registry.
|
"Scan BUFFER for layer regions and register it in the buffer registry.
|
||||||
BUFFER defaults to the current buffer. Walk BUFFER's `tp-name' text
|
BUFFER defaults to the current buffer. Walk BUFFER's text-property
|
||||||
property intervals and register BUFFER for every layer name found, so
|
runs and register BUFFER for every layer name found - rendered top
|
||||||
reactive updates visit it without a full `buffer-list' scan.
|
layers (direct `tp-name') as well as layers inside `tp-layers' stack
|
||||||
|
storage (buried below another layer, or hidden) - so reactive updates
|
||||||
|
visit it without a full `buffer-list' scan.
|
||||||
|
|
||||||
Call this after inserting an already-propertized string into a
|
Call this after inserting an already-propertized string into a
|
||||||
buffer: string application bypasses the buffer operations that
|
buffer: string application bypasses the buffer operations that
|
||||||
@ -114,24 +143,14 @@ register buffers (see `tp-reactive-layer-buffers'), and this command
|
|||||||
closes that gap. Return the list of layer names registered, in
|
closes that gap. Return the list of layer names registered, in
|
||||||
buffer order."
|
buffer order."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((buf (or buffer (current-buffer)))
|
(let* ((buf (or buffer (current-buffer)))
|
||||||
(found nil))
|
(found (tp-reactive--buffer-layer-names buf)))
|
||||||
(with-current-buffer buf
|
(dolist (name found)
|
||||||
(save-excursion
|
(tp-reactive--register-layer-buffer name buf))
|
||||||
(let ((pos (point-min))
|
|
||||||
(max (point-max)))
|
|
||||||
(while (< pos max)
|
|
||||||
(let ((name (get-text-property pos 'tp-name))
|
|
||||||
(next (or (next-single-property-change pos 'tp-name nil max)
|
|
||||||
max)))
|
|
||||||
(when (and name (not (member name found)))
|
|
||||||
(tp-reactive--register-layer-buffer name buf)
|
|
||||||
(push name found))
|
|
||||||
(setq pos next))))))
|
|
||||||
(when (called-interactively-p 'interactive)
|
(when (called-interactively-p 'interactive)
|
||||||
(message "tp: tracking %d layer(s) in %s"
|
(message "tp: tracking %d layer(s) in %s"
|
||||||
(length found) (buffer-name buf)))
|
(length found) (buffer-name buf)))
|
||||||
(nreverse found)))
|
found))
|
||||||
|
|
||||||
(defvar tp--batch-update-active nil
|
(defvar tp--batch-update-active nil
|
||||||
"When non-nil, we are inside a `tp-with-batch-updates' form.")
|
"When non-nil, we are inside a `tp-with-batch-updates' form.")
|
||||||
|
|||||||
@ -641,5 +641,116 @@
|
|||||||
(tp-undefine-layer name))
|
(tp-undefine-layer name))
|
||||||
(setq tp-rt-r3c-color nil))))
|
(setq tp-rt-r3c-color nil))))
|
||||||
|
|
||||||
|
;;; GC-1: buried and hidden layers are ALIVE for GC and track-buffer
|
||||||
|
|
||||||
|
(defvar tp-rt-gc1-color nil)
|
||||||
|
(defvar tp-rt-gc1b-color nil)
|
||||||
|
(defvar tp-rt-gc1c-color nil)
|
||||||
|
|
||||||
|
(ert-deftest tp-render-test-gc-keeps-layer-buried-under-push ()
|
||||||
|
"GC keeps an anonymous layer buried below a pushed top layer.
|
||||||
|
The buried layer's tp-name lives inside `tp-layers' storage, not as a
|
||||||
|
direct property; the stack-aware liveness scan must still see it, and
|
||||||
|
reactivity must survive a later pop (GC-1)."
|
||||||
|
(setq tp-rt-gc1-color "blue")
|
||||||
|
(let ((buf (generate-new-buffer " tp-rt-gc1"))
|
||||||
|
(name nil))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(define-tp tp-rt-gc1-top () '(face bold))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(insert "0123456789")
|
||||||
|
(tp-set 1 6 '(face (:foreground $tp-rt-gc1-color)))
|
||||||
|
(setq name (get-text-property 1 'tp-name))
|
||||||
|
(should name)
|
||||||
|
(tp-push-layer 1 6 'tp-rt-gc1-top)
|
||||||
|
;; Now buried: direct tp-name is the pushed top's.
|
||||||
|
(should (eq (get-text-property 1 'tp-name) 'tp-rt-gc1-top))
|
||||||
|
;; The buffer is live and still holds the layer: GC must
|
||||||
|
;; keep it.
|
||||||
|
(should-not (memq name (tp-gc-anonymous-layers)))
|
||||||
|
(should (assoc name tp-layer-alist))
|
||||||
|
;; Reactivity survives: pop and update.
|
||||||
|
(tp-pop-layer 1 6)
|
||||||
|
(setq tp-rt-gc1-color "red")
|
||||||
|
(should (equal (get-text-property 1 'face)
|
||||||
|
'(:foreground "red")))))
|
||||||
|
(kill-buffer buf)
|
||||||
|
(when (and name (assoc name tp-layer-alist))
|
||||||
|
(tp-undefine-layer name))
|
||||||
|
(tp-undefine-layer 'tp-rt-gc1-top)
|
||||||
|
(setq tp-rt-gc1-color nil))))
|
||||||
|
|
||||||
|
(ert-deftest tp-render-test-gc-keeps-hidden-layer ()
|
||||||
|
"GC keeps an anonymous layer hidden via tp-hide-layer.
|
||||||
|
An all-hidden run carries no direct tp-name at all; the layer lives
|
||||||
|
only inside `tp-layers' storage yet is queryable and re-showable, so
|
||||||
|
GC must not collect it and show+setq must still re-render (GC-1,
|
||||||
|
XM-02)."
|
||||||
|
(setq tp-rt-gc1b-color "green")
|
||||||
|
(let ((buf (generate-new-buffer " tp-rt-gc1b"))
|
||||||
|
(name nil))
|
||||||
|
(unwind-protect
|
||||||
|
(with-current-buffer buf
|
||||||
|
(insert "abcdefghij")
|
||||||
|
(tp-set 1 6 '(face (:foreground $tp-rt-gc1b-color)))
|
||||||
|
(setq name (get-text-property 1 'tp-name))
|
||||||
|
(should name)
|
||||||
|
(tp-hide-layer 1 6 name)
|
||||||
|
(should-not (get-text-property 1 'tp-name))
|
||||||
|
;; Live buffer still holds the hidden layer: keep it.
|
||||||
|
(should-not (memq name (tp-gc-anonymous-layers)))
|
||||||
|
(should (assoc name tp-layer-alist))
|
||||||
|
;; Show and update: reactivity must be intact.
|
||||||
|
(tp-show-layer 1 6 name)
|
||||||
|
(setq tp-rt-gc1b-color "purple")
|
||||||
|
(should (equal (get-text-property 1 'face)
|
||||||
|
'(:foreground "purple"))))
|
||||||
|
(kill-buffer buf)
|
||||||
|
(when (and name (assoc name tp-layer-alist))
|
||||||
|
(tp-undefine-layer name))
|
||||||
|
(setq tp-rt-gc1b-color nil))))
|
||||||
|
|
||||||
|
(ert-deftest tp-render-test-track-buffer-finds-buried-and-hidden-layers ()
|
||||||
|
"tp-reactive-track-buffer registers layers buried or hidden in storage.
|
||||||
|
A propertized string carrying a stacked (buried) layer and an
|
||||||
|
all-hidden string are inserted into a fresh buffer; the track scan
|
||||||
|
must register every layer name, not just the rendered top ones
|
||||||
|
\(GC-1, XM-04)."
|
||||||
|
(setq tp-rt-gc1c-color "gold")
|
||||||
|
(let ((buf (generate-new-buffer " tp-rt-gc1c"))
|
||||||
|
(name nil))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(define-tp tp-rt-gc1c-top () '(face bold))
|
||||||
|
(define-tp tp-rt-gc1c-hidden () '(face italic))
|
||||||
|
(let ((s (with-temp-buffer
|
||||||
|
(insert "trackme")
|
||||||
|
(tp-set 1 6 '(face (:foreground $tp-rt-gc1c-color)))
|
||||||
|
(setq name (get-text-property 1 'tp-name))
|
||||||
|
(tp-push-layer 1 6 'tp-rt-gc1c-top)
|
||||||
|
(buffer-string)))
|
||||||
|
(h (let ((h (copy-sequence " hideme")))
|
||||||
|
(tp-push-layer h 'tp-rt-gc1c-hidden)
|
||||||
|
(tp-hide-layer h 'tp-rt-gc1c-hidden)
|
||||||
|
h)))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(insert s)
|
||||||
|
(insert h)
|
||||||
|
(let ((found (tp-reactive-track-buffer)))
|
||||||
|
;; Rendered top, buried layer, and all-hidden layer.
|
||||||
|
(should (memq 'tp-rt-gc1c-top found))
|
||||||
|
(should (memq name found))
|
||||||
|
(should (memq 'tp-rt-gc1c-hidden found)))
|
||||||
|
(should (memq buf (tp-reactive-layer-buffers name)))
|
||||||
|
(should (memq buf (tp-reactive-layer-buffers
|
||||||
|
'tp-rt-gc1c-hidden))))))
|
||||||
|
(kill-buffer buf)
|
||||||
|
(when (and name (assoc name tp-layer-alist))
|
||||||
|
(tp-undefine-layer name))
|
||||||
|
(tp-undefine-layer 'tp-rt-gc1c-top)
|
||||||
|
(tp-undefine-layer 'tp-rt-gc1c-hidden)
|
||||||
|
(setq tp-rt-gc1c-color nil))))
|
||||||
|
|
||||||
(provide 'tp-render-tests)
|
(provide 'tp-render-tests)
|
||||||
;;; tp-render-tests.el ends here
|
;;; tp-render-tests.el ends here
|
||||||
|
|||||||
47
tp-render.el
47
tp-render.el
@ -102,17 +102,6 @@ Returns an updated override-alist with the new computed values."
|
|||||||
(tp--deep-merge-plist current-props resolved-props)))))))))))
|
(tp--deep-merge-plist current-props resolved-props)))))))))))
|
||||||
override-alist)
|
override-alist)
|
||||||
|
|
||||||
(defun tp--buffer-has-layer-region-p (layer-name &optional buffer)
|
|
||||||
"Return non-nil when BUFFER has a region tagged with LAYER-NAME.
|
|
||||||
BUFFER defaults to the current buffer; a dead BUFFER yields nil.
|
|
||||||
Checks the `tp-name' text property."
|
|
||||||
(let ((buf (or buffer (current-buffer))))
|
|
||||||
(when (buffer-live-p buf)
|
|
||||||
(with-current-buffer buf
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (point-min))
|
|
||||||
(and (text-property-search-forward 'tp-name layer-name t) t))))))
|
|
||||||
|
|
||||||
(defun tp--render-visit-buffer (buffer fn)
|
(defun tp--render-visit-buffer (buffer fn)
|
||||||
"Call FN with BUFFER current and `inhibit-read-only' bound to t.
|
"Call FN with BUFFER current and `inhibit-read-only' bound to t.
|
||||||
Dead buffers are skipped. This is the per-buffer seam of the
|
Dead buffers are skipped. This is the per-buffer seam of the
|
||||||
@ -687,42 +676,6 @@ actually been set, so layer props re-resolve against current
|
|||||||
(tp--update-reactive-text layer-name where)
|
(tp--update-reactive-text layer-name where)
|
||||||
(tp--update-layer-regions layer-name where)))
|
(tp--update-layer-regions layer-name where)))
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun tp-gc-anonymous-layers ()
|
|
||||||
"Collect anonymous layers that no live buffer displays anymore.
|
|
||||||
Walk `tp--anonymous-layer-registry' and, for every interned anonymous
|
|
||||||
layer whose buffer registry has real knowledge (see
|
|
||||||
`tp-reactive-layer-buffers'), check whether any registered live
|
|
||||||
buffer still contains a region tagged with the layer's `tp-name'.
|
|
||||||
Layers displayed nowhere are undefined via `tp-undefine-layer', which
|
|
||||||
also drops their reactive dependencies, transforms and registry
|
|
||||||
entries.
|
|
||||||
|
|
||||||
Layers whose registry state is `unknown' are conservatively kept:
|
|
||||||
they were never seen in any buffer through the registering paths,
|
|
||||||
and detached strings may still reference them. A layer becomes
|
|
||||||
collectable only after it was registered for at least one buffer and
|
|
||||||
none of the registered buffers still shows it (for example after the
|
|
||||||
buffers were killed); call `tp-reactive-track-buffer' after
|
|
||||||
inserting propertized strings so their buffers are registered too.
|
|
||||||
|
|
||||||
Return the list of collected layer names."
|
|
||||||
(interactive)
|
|
||||||
(let ((collected nil))
|
|
||||||
;; Snapshot the names first: `tp-undefine-layer' mutates the
|
|
||||||
;; anonymous-layer registry while we iterate.
|
|
||||||
(dolist (name (mapcar #'cdr tp--anonymous-layer-registry))
|
|
||||||
(let ((bufs (tp-reactive-layer-buffers name)))
|
|
||||||
(when (and (not (eq bufs 'unknown))
|
|
||||||
(not (cl-some (lambda (buf)
|
|
||||||
(tp--buffer-has-layer-region-p name buf))
|
|
||||||
bufs)))
|
|
||||||
(tp-undefine-layer name)
|
|
||||||
(push name collected))))
|
|
||||||
(when (called-interactively-p 'interactive)
|
|
||||||
(message "tp: collected %d anonymous layer(s)" (length collected)))
|
|
||||||
(nreverse collected)))
|
|
||||||
|
|
||||||
;; Install the engine into the lower modules.
|
;; Install the engine into the lower modules.
|
||||||
(setq tp--reactive-update-function #'tp--reactive-apply-update)
|
(setq tp--reactive-update-function #'tp--reactive-apply-update)
|
||||||
(setq tp--reactive-flush-function #'tp--reactive-flush-entry)
|
(setq tp--reactive-flush-function #'tp--reactive-flush-entry)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user