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)
|
||||
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
|
||||
"Layer names currently being expanded, innermost first.
|
||||
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))
|
||||
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
|
||||
(defun tp-reactive-track-buffer (&optional buffer)
|
||||
"Scan BUFFER for layer regions and register it in the buffer registry.
|
||||
BUFFER defaults to the current buffer. Walk BUFFER's `tp-name' text
|
||||
property intervals and register BUFFER for every layer name found, so
|
||||
reactive updates visit it without a full `buffer-list' scan.
|
||||
BUFFER defaults to the current buffer. Walk BUFFER's text-property
|
||||
runs and register BUFFER for every layer name found - rendered top
|
||||
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
|
||||
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
|
||||
buffer order."
|
||||
(interactive)
|
||||
(let ((buf (or buffer (current-buffer)))
|
||||
(found nil))
|
||||
(with-current-buffer buf
|
||||
(save-excursion
|
||||
(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))))))
|
||||
(let* ((buf (or buffer (current-buffer)))
|
||||
(found (tp-reactive--buffer-layer-names buf)))
|
||||
(dolist (name found)
|
||||
(tp-reactive--register-layer-buffer name buf))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "tp: tracking %d layer(s) in %s"
|
||||
(length found) (buffer-name buf)))
|
||||
(nreverse found)))
|
||||
found))
|
||||
|
||||
(defvar tp--batch-update-active nil
|
||||
"When non-nil, we are inside a `tp-with-batch-updates' form.")
|
||||
|
||||
@ -641,5 +641,116 @@
|
||||
(tp-undefine-layer name))
|
||||
(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)
|
||||
;;; 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)))))))))))
|
||||
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)
|
||||
"Call FN with BUFFER current and `inhibit-read-only' bound to t.
|
||||
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-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.
|
||||
(setq tp--reactive-update-function #'tp--reactive-apply-update)
|
||||
(setq tp--reactive-flush-function #'tp--reactive-flush-entry)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user