diff --git a/tp-layer.el b/tp-layer.el index 45f39f3..5571157 100644 --- a/tp-layer.el +++ b/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' diff --git a/tp-reactive.el b/tp-reactive.el index e81402e..b4e94cf 100644 --- a/tp-reactive.el +++ b/tp-reactive.el @@ -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.") diff --git a/tp-render-tests.el b/tp-render-tests.el index 0889d7c..8a95727 100644 --- a/tp-render-tests.el +++ b/tp-render-tests.el @@ -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 diff --git a/tp-render.el b/tp-render.el index c939c47..e27dc86 100644 --- a/tp-render.el +++ b/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)