tp/tp-reactive.el
Kinneyzhang 8d108403ad feat(tp): add rollback-capable transaction participants
Publish client-owned side state after retained surfaces and roll it back in reverse order on any transaction failure.\n\nVerified: 715 ERT tests, 92 doctests, WERROR compile-all, checkdoc, git diff --check.
2026-08-06 03:40:40 +08:00

1247 lines
54 KiB
EmacsLisp

;;; tp-reactive.el --- Exact signals and binding scheduler -*- lexical-binding: t -*-
;; Copyright (C) 2024-2026 Geekinney
;; Author: Geekinney (kinneyzhang666@gmail.com)
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3 of
;; the License, or (at your option) any later version.
;;; Commentary:
;; TP 1.0's exact signal-to-binding dependency graph, transaction-local
;; scheduler, scoped variable adapters, and rollback state. The lower legacy
;; section remains temporarily available to the 0.3 layer/render facade during
;; the staged cutover; new graph execution never calls its scan renderer.
;;; Code:
(require 'cl-lib)
(require 'tp-core)
(define-error 'tp-reactive-error "TP reactive runtime error")
(define-error 'tp-invalid-signal-scope "Invalid TP signal scope"
'tp-reactive-error)
(define-error 'tp-disposed-signal "TP signal is disposed" 'tp-reactive-error)
(define-error 'tp-disposed-binding "TP binding is disposed" 'tp-reactive-error)
(define-error 'tp-binding-cycle "TP binding dependency cycle"
'tp-reactive-error)
(cl-defstruct (tp-signal (:constructor tp--make-signal))
"Reactive source with a committed value and exact subscribers."
id committed-value equality subscribers scope adapter-key disposed revision)
(cl-defstruct (tp-binding (:constructor tp--make-binding))
"Memoized computation installed on one owner and namespaced key."
id owner key compute equality last-value initialized-p dependencies
subscribers dirty state revision lifecycle disposed)
(cl-defstruct (tp--binding-snapshot
(:constructor tp--make-binding-snapshot))
compute equality last-value initialized-p dependencies dirty state
revision lifecycle disposed)
(cl-defstruct (tp--transaction-participant
(:constructor tp--make-transaction-participant))
"One rollback-capable side-state participant in a TP transaction."
key publish rollback)
(defconst tp--reactive-absent (make-symbol "tp-reactive-absent"))
(defvar tp--signal-id-counter 0)
(defvar tp--binding-id-counter 0)
(defvar tp--signals nil)
(defvar tp--bindings nil)
(defvar tp--owner-bindings (make-hash-table :test #'eq))
(defvar tp--variable-signals (make-hash-table :test #'equal))
(defvar tp--variable-signal-watched nil)
(defvar-local tp--buffer-signals nil)
(defvar tp--reactive-counters
(list :invalidated 0 :recomputed 0 :skipped 0
:subscription-added 0 :subscription-removed 0))
(defvar tp--transaction-active nil)
(defvar tp--transaction-signal-values nil)
(defvar tp--transaction-signals nil)
(defvar tp--transaction-dirty-set nil)
(defvar tp--transaction-dirty-queue nil)
(defvar tp--transaction-binding-snapshots nil)
(defvar tp--transaction-created-bindings nil)
(defvar tp--transaction-recompute-counts nil)
(defvar tp--transaction-extensions nil)
(defvar tp--transaction-counter-start nil)
(defvar tp--transaction-after-commit-callbacks nil)
(defvar tp--transaction-participants nil)
(defvar tp--transaction-participant-keys nil)
(defvar tp--transaction-published-participants nil)
(defvar tp--current-binding nil)
(defvar tp--binding-compute-stack nil)
(defvar tp--collected-dependency-set nil)
(defvar tp--collected-dependencies nil)
(defvar tp--binding-touch-function nil)
(defvar tp--binding-changed-functions nil)
(defvar tp--transaction-publish-functions nil)
(defvar tp--transaction-rollback-functions nil)
(defvar tp--transaction-rollback-final-functions nil)
(defvar tp--transaction-committed-functions nil)
(defun tp--counter-increment (key)
"Increment reactive counter KEY."
(setq tp--reactive-counters
(plist-put tp--reactive-counters key
(1+ (plist-get tp--reactive-counters key)))))
(defun tp-reactive-counters ()
"Return public signal and binding scheduler counters."
(copy-sequence tp--reactive-counters))
(defun tp-reactive-reset-counters ()
"Reset public signal and binding scheduler counters."
(setq tp--reactive-counters
(list :invalidated 0 :recomputed 0 :skipped 0
:subscription-added 0 :subscription-removed 0)))
(defun tp--dependency-subscribers (dependency)
"Return the subscriber table owned by DEPENDENCY."
(cond ((tp-signal-p dependency) (tp-signal-subscribers dependency))
((tp-binding-p dependency) (tp-binding-subscribers dependency))
(t (signal 'wrong-type-argument
(list '(or tp-signal-p tp-binding-p) dependency)))))
(defun tp--subscription-add (dependency binding)
"Subscribe BINDING to DEPENDENCY."
(let ((subscribers (tp--dependency-subscribers dependency)))
(unless (gethash binding subscribers)
(puthash binding t subscribers)
(tp--counter-increment :subscription-added))))
(defun tp--subscription-remove (dependency binding)
"Unsubscribe BINDING from DEPENDENCY."
(let ((subscribers (tp--dependency-subscribers dependency)))
(when (gethash binding subscribers)
(remhash binding subscribers)
(tp--counter-increment :subscription-removed))))
(defun tp--sorted-subscribers (dependency)
"Return DEPENDENCY subscribers ordered by stable binding id."
(let (bindings)
(maphash (lambda (binding _present) (push binding bindings))
(tp--dependency-subscribers dependency))
(sort bindings (lambda (left right)
(< (tp-binding-id left) (tp-binding-id right))))))
(defun tp--binding-snapshot (binding)
"Return a rollback snapshot of BINDING."
(tp--make-binding-snapshot
:compute (tp-binding-compute binding)
:equality (tp-binding-equality binding)
:last-value (tp-binding-last-value binding)
:initialized-p (tp-binding-initialized-p binding)
:dependencies (copy-sequence (tp-binding-dependencies binding))
:dirty (tp-binding-dirty binding)
:state (tp-binding-state binding)
:revision (tp-binding-revision binding)
:lifecycle (tp-binding-lifecycle binding)
:disposed (tp-binding-disposed binding)))
(defun tp--snapshot-binding (binding)
"Save BINDING once for the active transaction."
(when (and tp--transaction-active
(not (memq binding tp--transaction-created-bindings))
(not (gethash binding tp--transaction-binding-snapshots)))
(puthash binding (tp--binding-snapshot binding)
tp--transaction-binding-snapshots)))
(defun tp--owner-binding-table (owner &optional create)
"Return OWNER's binding table, creating it when CREATE is non-nil."
(or (gethash owner tp--owner-bindings)
(when create
(let ((table (make-hash-table :test #'equal)))
(puthash owner table tp--owner-bindings)
table))))
(defun tp--register-binding (binding)
"Register BINDING under its owner and key."
(puthash (tp-binding-key binding) binding
(tp--owner-binding-table (tp-binding-owner binding) t))
(cl-pushnew binding tp--bindings :test #'eq))
(defun tp--unregister-binding (binding)
"Remove BINDING from owner and global registries."
(when-let ((table (tp--owner-binding-table (tp-binding-owner binding))))
(remhash (tp-binding-key binding) table)
(when (zerop (hash-table-count table))
(remhash (tp-binding-owner binding) tp--owner-bindings)))
(setq tp--bindings (delq binding tp--bindings)))
(defun tp--enqueue-binding (binding)
"Add dirty BINDING to the current transaction queue once."
(unless (gethash binding tp--transaction-dirty-set)
(puthash binding t tp--transaction-dirty-set)
(push binding tp--transaction-dirty-queue)))
(defun tp--mark-binding-dirty (binding)
"Mark live BINDING dirty in the current transaction."
(when (and (tp-binding-p binding) (not (tp-binding-disposed binding)))
(tp--snapshot-binding binding)
(unless (tp-binding-dirty binding)
(setf (tp-binding-dirty binding) t)
(tp--counter-increment :invalidated))
(tp--enqueue-binding binding)))
(defun tp--invalidate-subscribers (dependency &optional skip)
"Dirty DEPENDENCY subscribers except SKIP."
(dolist (binding (tp--sorted-subscribers dependency))
(unless (eq binding skip)
(tp--mark-binding-dirty binding))))
(defun tp--record-dependency (dependency)
"Record DEPENDENCY for the binding currently being computed."
(when tp--current-binding
(unless (gethash dependency tp--collected-dependency-set)
(puthash dependency t tp--collected-dependency-set)
(push dependency tp--collected-dependencies))))
(defun tp--signal-value-in-transaction (signal)
"Return SIGNAL's candidate or committed value."
(if tp--transaction-active
(let ((candidate (gethash signal tp--transaction-signal-values
tp--reactive-absent)))
(if (eq candidate tp--reactive-absent)
(tp-signal-committed-value signal)
candidate))
(tp-signal-committed-value signal)))
(defun tp--validate-live-signal (signal)
"Signal an error unless SIGNAL is live."
(unless (tp-signal-p signal)
(signal 'wrong-type-argument (list 'tp-signal-p signal)))
(when (tp-signal-disposed signal)
(signal 'tp-disposed-signal (list (tp-signal-id signal)))))
(defun tp-signal-live-p (signal)
"Return non-nil when SIGNAL is a live TP signal."
(and (tp-signal-p signal) (not (tp-signal-disposed signal))))
(defun tp--buffer-signal-kill ()
"Dispose signals scoped to the buffer being killed."
(let ((signals tp--buffer-signals))
(setq tp--buffer-signals nil)
(dolist (signal signals)
(tp--dispose-signal signal))))
(cl-defun tp-signal-create (initial-value &key (equality #'equal) (scope 'global))
"Create a signal holding INITIAL-VALUE.
EQUALITY compares writes. SCOPE is `global' or a live buffer."
(unless (functionp equality)
(signal 'wrong-type-argument (list 'functionp equality)))
(unless (or (eq scope 'global) (buffer-live-p scope))
(signal 'tp-invalid-signal-scope (list scope)))
(let ((signal (tp--make-signal
:id (cl-incf tp--signal-id-counter)
:committed-value initial-value :equality equality
:subscribers (make-hash-table :test #'eq)
:scope scope :revision 0)))
(push signal tp--signals)
(when (bufferp scope)
(with-current-buffer scope
(push signal tp--buffer-signals)
(add-hook 'kill-buffer-hook #'tp--buffer-signal-kill nil t)))
signal))
(defun tp-signal-peek (signal)
"Return SIGNAL's effective value without collecting a dependency."
(tp--validate-live-signal signal)
(tp--signal-value-in-transaction signal))
(defun tp-signal-read (signal)
"Read SIGNAL and register the current binding as a subscriber."
(tp--validate-live-signal signal)
(tp--record-dependency signal)
(tp--signal-value-in-transaction signal))
(defun tp--set-signal-candidate (signal value)
"Set candidate VALUE for SIGNAL in the active transaction."
(let ((old (tp--signal-value-in-transaction signal)))
(unless (funcall (tp-signal-equality signal) old value)
(when (eq (gethash signal tp--transaction-signal-values
tp--reactive-absent)
tp--reactive-absent)
(push signal tp--transaction-signals))
(puthash signal value tp--transaction-signal-values)
(tp--invalidate-subscribers signal)
(when (and tp--current-binding
(gethash signal tp--collected-dependency-set))
(tp--mark-binding-dirty tp--current-binding))))
value)
(defun tp-signal-set (signal value)
"Set SIGNAL to VALUE transactionally and return VALUE."
(tp--validate-live-signal signal)
(if tp--transaction-active
(tp--set-signal-candidate signal value)
(tp--call-with-transaction
(lambda () (tp--set-signal-candidate signal value)))))
(defun tp-signal-subscriber-count (signal)
"Return the number of subscribers attached to SIGNAL.
Disposed signals return zero."
(unless (tp-signal-p signal)
(signal 'wrong-type-argument (list 'tp-signal-p signal)))
(hash-table-count (tp-signal-subscribers signal)))
(defun tp--binding-dependency-path (start target visited)
"Return a binding path from START to TARGET, avoiding VISITED."
(cond
((eq start target) (list target))
((memq start visited) nil)
(t
(cl-loop for dependency in (tp-binding-dependencies start)
when (tp-binding-p dependency)
for path = (tp--binding-dependency-path
dependency target (cons start visited))
when path return (cons start path)))))
(defun tp--stack-cycle-path (target)
"Return the active compute-stack cycle ending at TARGET."
(let ((path (reverse tp--binding-compute-stack)))
(while (and path (not (eq (car path) target)))
(setq path (cdr path)))
(append path (list target))))
(defun tp--signal-binding-cycle (path)
"Signal a binding-cycle error for binding PATH."
(signal 'tp-binding-cycle
(list (mapcar (lambda (binding)
(copy-tree (tp-binding-key binding)))
path))))
(defun tp--validate-binding-read (binding &optional computing-only)
"Validate reading BINDING from the current computation.
When COMPUTING-ONLY is non-nil, defer old-graph traversal until after a
dirty target has recomputed."
(when tp--current-binding
(when (eq (tp-binding-state binding) 'computing)
(tp--signal-binding-cycle (tp--stack-cycle-path binding)))
(unless computing-only
(when-let ((path (tp--binding-dependency-path
binding tp--current-binding nil)))
(tp--signal-binding-cycle (cons tp--current-binding path))))))
(defun tp--replace-binding-dependencies (binding dependencies)
"Replace BINDING dependencies with DEPENDENCIES."
(let ((old (tp-binding-dependencies binding)))
(dolist (dependency old)
(unless (memq dependency dependencies)
(tp--subscription-remove dependency binding)))
(dolist (dependency dependencies)
(unless (memq dependency old)
(tp--subscription-add dependency binding)))
(setf (tp-binding-dependencies binding) dependencies)))
(defun tp--note-binding-recompute (binding)
"Record one recomputation of BINDING and reject runaway feedback."
(let ((count (1+ (gethash binding tp--transaction-recompute-counts 0))))
(puthash binding count tp--transaction-recompute-counts)
(when (> count 100)
(tp--signal-binding-cycle (list binding binding)))))
(defun tp--binding-recompute (binding)
"Recompute dirty BINDING inside the active transaction."
(tp--snapshot-binding binding)
(tp--note-binding-recompute binding)
(let ((requester tp--current-binding)
(old (tp-binding-last-value binding))
(initialized (tp-binding-initialized-p binding))
(tp--current-binding binding)
(tp--binding-compute-stack (cons binding tp--binding-compute-stack))
(tp--collected-dependency-set (make-hash-table :test #'eq))
(tp--collected-dependencies nil))
(setf (tp-binding-state binding) 'computing
(tp-binding-dirty binding) nil)
(let* ((value (funcall (tp-binding-compute binding)))
(dependencies (nreverse tp--collected-dependencies))
(changed (or (not initialized)
(not (funcall (tp-binding-equality binding)
old value)))))
(tp--replace-binding-dependencies binding dependencies)
(setf (tp-binding-state binding) 'clean)
(tp--counter-increment :recomputed)
(if changed
(progn
(setf (tp-binding-last-value binding) value
(tp-binding-initialized-p binding) t
(tp-binding-revision binding)
(1+ (tp-binding-revision binding)))
(run-hook-with-args 'tp--binding-changed-functions
binding old value)
(tp--invalidate-subscribers binding requester))
(tp--counter-increment :skipped))
value)))
(defun tp--validate-live-binding (binding)
"Signal an error unless BINDING is live."
(unless (tp-binding-p binding)
(signal 'wrong-type-argument (list 'tp-binding-p binding)))
(when (tp-binding-disposed binding)
(signal 'tp-disposed-binding (list (tp-binding-id binding)))))
(defun tp-binding-live-p (binding)
"Return non-nil when BINDING is a live TP binding."
(and (tp-binding-p binding) (not (tp-binding-disposed binding))))
(defun tp-binding-read (binding)
"Read BINDING's memoized value and collect a dependency."
(tp--validate-live-binding binding)
(tp--validate-binding-read binding t)
(when (tp-binding-dirty binding)
(if tp--transaction-active
(tp--binding-recompute binding)
(tp--call-with-transaction (lambda () (tp--binding-recompute binding)))))
(tp--validate-binding-read binding)
(tp--record-dependency binding)
(tp-binding-last-value binding))
(defun tp-binding-subscriber-count (binding)
"Return the number of bindings depending directly on BINDING.
Disposed bindings return zero."
(unless (tp-binding-p binding)
(signal 'wrong-type-argument (list 'tp-binding-p binding)))
(hash-table-count (tp-binding-subscribers binding)))
(defun tp-binding-dependency-count (binding)
"Return BINDING's current direct dependency count.
Disposed bindings return zero."
(unless (tp-binding-p binding)
(signal 'wrong-type-argument (list 'tp-binding-p binding)))
(length (tp-binding-dependencies binding)))
(defun tp--validate-binding-options (compute equality lifecycle)
"Validate binding COMPUTE, EQUALITY, and LIFECYCLE."
(unless (functionp compute)
(signal 'wrong-type-argument (list 'functionp compute)))
(unless (functionp equality)
(signal 'wrong-type-argument (list 'functionp equality)))
(unless (memq lifecycle '(delete retain))
(signal 'tp-reactive-error (list :lifecycle lifecycle))))
(defun tp--bind-in-transaction (owner key compute equality lifecycle)
"Install COMPUTE for OWNER and KEY in the active transaction.
EQUALITY compares values and LIFECYCLE controls retention."
(let* ((table (tp--owner-binding-table owner t))
(binding (gethash key table)))
(if binding
(unless (and (eq compute (tp-binding-compute binding))
(eq equality (tp-binding-equality binding))
(eq lifecycle (tp-binding-lifecycle binding)))
(tp--snapshot-binding binding)
(setf (tp-binding-compute binding) compute
(tp-binding-equality binding) equality
(tp-binding-lifecycle binding) lifecycle)
(tp--mark-binding-dirty binding))
(setq binding
(tp--make-binding
:id (cl-incf tp--binding-id-counter)
:owner owner :key (copy-tree key) :compute compute
:equality equality :subscribers (make-hash-table :test #'eq)
:dirty t :state 'clean :revision 0 :lifecycle lifecycle))
(tp--register-binding binding)
(push binding tp--transaction-created-bindings)
(tp--enqueue-binding binding))
(when tp--binding-touch-function
(funcall tp--binding-touch-function binding))
binding))
(cl-defun tp-bind (owner key compute &key (equality #'equal) (lifecycle 'delete))
"Idempotently install COMPUTE on OWNER under namespaced KEY.
EQUALITY suppresses unchanged downstream updates. LIFECYCLE is `delete'
or `retain'."
(when (null owner)
(signal 'tp-reactive-error (list :owner owner)))
(when (null key)
(signal 'tp-reactive-error (list :binding-key key)))
(tp--validate-binding-options compute equality lifecycle)
(if tp--transaction-active
(tp--bind-in-transaction owner key compute equality lifecycle)
(tp--call-with-transaction
(lambda () (tp--bind-in-transaction
owner key compute equality lifecycle)))))
(defun tp--detach-binding-dependencies (binding)
"Remove BINDING from all dependency subscriber tables."
(dolist (dependency (tp-binding-dependencies binding))
(tp--subscription-remove dependency binding))
(setf (tp-binding-dependencies binding) nil))
(defun tp--detach-binding-subscribers (binding)
"Detach every direct subscriber from BINDING."
(dolist (subscriber (tp--sorted-subscribers binding))
(tp--snapshot-binding subscriber)
(setf (tp-binding-dependencies subscriber)
(delq binding (tp-binding-dependencies subscriber))
(tp-binding-dirty subscriber) t)
(tp--subscription-remove binding subscriber)))
(defun tp--dispose-binding (binding)
"Dispose live BINDING without starting a transaction."
(unless (tp-binding-disposed binding)
(tp--snapshot-binding binding)
(tp--detach-binding-dependencies binding)
(tp--detach-binding-subscribers binding)
(tp--unregister-binding binding)
(setf (tp-binding-disposed binding) t
(tp-binding-dirty binding) nil
(tp-binding-state binding) 'disposed)))
(defun tp-binding-dispose-owner (owner)
"Dispose every binding installed on OWNER and return the count."
(let ((bindings (when-let ((table (tp--owner-binding-table owner)))
(let (items)
(maphash (lambda (_key binding) (push binding items)) table)
(sort items (lambda (left right)
(< (tp-binding-id left)
(tp-binding-id right))))))))
(if tp--transaction-active
(dolist (binding bindings) (tp--dispose-binding binding))
(tp--call-with-transaction
(lambda () (dolist (binding bindings) (tp--dispose-binding binding)))))
(length bindings)))
(defun tp-binding-owner-bindings (owner)
"Return OWNER's live bindings ordered by stable binding id."
(when-let ((table (tp--owner-binding-table owner)))
(let (bindings)
(maphash (lambda (_key binding) (push binding bindings)) table)
(sort bindings (lambda (left right)
(< (tp-binding-id left) (tp-binding-id right)))))))
(defun tp-binding-dispose (binding)
"Dispose BINDING and detach all of its graph edges."
(tp--validate-live-binding binding)
(if tp--transaction-active
(tp--dispose-binding binding)
(tp--call-with-transaction (lambda () (tp--dispose-binding binding))))
nil)
(defun tp--transaction-extension (key &optional create)
"Return transaction extension state for KEY.
When CREATE is non-nil, install and return a fresh hash table when absent."
(unless tp--transaction-active
(signal 'tp-reactive-error (list :outside-transaction key)))
(or (gethash key tp--transaction-extensions)
(when create
(let ((state (make-hash-table :test #'eq)))
(puthash key state tp--transaction-extensions)
state))))
(defun tp--transaction-counter-delta (key)
"Return active transaction counter delta for KEY."
(if tp--transaction-counter-start
(- (plist-get tp--reactive-counters key)
(plist-get tp--transaction-counter-start key))
0))
(defun tp--enqueue-after-commit (function)
"Run FUNCTION after the active outer transaction has exited."
(unless tp--transaction-active
(signal 'tp-reactive-error (list :outside-transaction function)))
(push function tp--transaction-after-commit-callbacks))
;;;###autoload
(defun tp-transaction-participate (key publish rollback)
"Register rollback-capable PUBLISH work under transaction-local KEY.
PUBLISH runs after every affected surface has published its candidate buffer
and side state, but before the transaction commits its source values. If this
or any later publication step fails, ROLLBACK runs in reverse publication
order. Both functions take no arguments. KEY must be unique in the outer
transaction."
(unless tp--transaction-active
(signal 'tp-reactive-error (list :participant-outside-transaction key)))
(unless key
(signal 'tp-reactive-error (list :participant-key key)))
(unless (functionp publish)
(signal 'wrong-type-argument (list 'functionp publish)))
(unless (functionp rollback)
(signal 'wrong-type-argument (list 'functionp rollback)))
(when (member key tp--transaction-participant-keys)
(signal 'tp-reactive-error (list :duplicate-participant-key key)))
(push (copy-tree key) tp--transaction-participant-keys)
(push (tp--make-transaction-participant
:key (copy-tree key) :publish publish :rollback rollback)
tp--transaction-participants)
key)
(defun tp--publish-transaction-participants ()
"Publish registered transaction participants in declaration order."
(dolist (participant (nreverse tp--transaction-participants))
(push participant tp--transaction-published-participants)
(funcall (tp--transaction-participant-publish participant))))
(defun tp--rollback-transaction-participants ()
"Rollback published participants and return any failures."
(let (failures)
(dolist (participant tp--transaction-published-participants)
(condition-case failure
(funcall (tp--transaction-participant-rollback participant))
(error
(push (list :key (tp--transaction-participant-key participant)
:error failure)
failures))))
(nreverse failures)))
(defun tp--dequeue-dirty-binding ()
"Return and remove the next queued dirty binding."
(let (binding)
(while (and tp--transaction-dirty-queue (null binding))
(let ((candidate (pop tp--transaction-dirty-queue)))
(when (gethash candidate tp--transaction-dirty-set)
(remhash candidate tp--transaction-dirty-set)
(setq binding candidate))))
binding))
(defun tp--flush-dirty-bindings ()
"Recompute the transaction's exact dirty closure."
(let (binding)
(while (setq binding (tp--dequeue-dirty-binding))
(when (and (tp-binding-live-p binding) (tp-binding-dirty binding))
(tp--binding-recompute binding)))))
(defun tp--restore-binding (binding snapshot)
"Restore BINDING fields from SNAPSHOT."
(setf (tp-binding-compute binding) (tp--binding-snapshot-compute snapshot)
(tp-binding-equality binding) (tp--binding-snapshot-equality snapshot)
(tp-binding-last-value binding) (tp--binding-snapshot-last-value snapshot)
(tp-binding-initialized-p binding)
(tp--binding-snapshot-initialized-p snapshot)
(tp-binding-dependencies binding)
(copy-sequence (tp--binding-snapshot-dependencies snapshot))
(tp-binding-dirty binding) (tp--binding-snapshot-dirty snapshot)
(tp-binding-state binding) (tp--binding-snapshot-state snapshot)
(tp-binding-revision binding) (tp--binding-snapshot-revision snapshot)
(tp-binding-lifecycle binding) (tp--binding-snapshot-lifecycle snapshot)
(tp-binding-disposed binding) (tp--binding-snapshot-disposed snapshot)))
(defun tp--rollback-bindings ()
"Restore all bindings touched by the active transaction."
(let (snapshots)
(maphash (lambda (binding snapshot)
(push (cons binding snapshot) snapshots))
tp--transaction-binding-snapshots)
(dolist (binding (append tp--transaction-created-bindings
(mapcar #'car snapshots)))
(tp--detach-binding-dependencies binding))
(dolist (binding tp--transaction-created-bindings)
(tp--unregister-binding binding)
(setf (tp-binding-disposed binding) t
(tp-binding-state binding) 'disposed))
(dolist (entry snapshots)
(pcase-let ((`(,binding . ,snapshot) entry))
(tp--restore-binding binding snapshot)
(unless (tp-binding-disposed binding)
(tp--register-binding binding)
(dolist (dependency (tp-binding-dependencies binding))
(tp--subscription-add dependency binding)))))))
(defun tp--commit-signal-values ()
"Commit candidate signal values after a successful flush."
(dolist (signal (nreverse tp--transaction-signals))
(setf (tp-signal-committed-value signal)
(gethash signal tp--transaction-signal-values)
(tp-signal-revision signal) (1+ (tp-signal-revision signal)))))
(defun tp--call-with-transaction (function)
"Call FUNCTION in one atomic signal and binding transaction."
(if tp--transaction-active
(funcall function)
(let (after-commit result)
(setq result
(let ((tp--transaction-active t)
(tp--transaction-signal-values
(make-hash-table :test #'eq))
(tp--transaction-signals nil)
(tp--transaction-dirty-set (make-hash-table :test #'eq))
(tp--transaction-dirty-queue nil)
(tp--transaction-binding-snapshots
(make-hash-table :test #'eq))
(tp--transaction-created-bindings nil)
(tp--transaction-recompute-counts
(make-hash-table :test #'eq))
(tp--transaction-extensions (make-hash-table :test #'eq))
(tp--transaction-after-commit-callbacks nil)
(tp--transaction-participants nil)
(tp--transaction-participant-keys nil)
(tp--transaction-published-participants nil)
(counter-snapshot (copy-sequence tp--reactive-counters))
(tp--transaction-counter-start nil)
success transaction-result rollback-failures)
(setq tp--transaction-counter-start counter-snapshot)
(unwind-protect
(progn
(setq transaction-result (funcall function))
(tp--flush-dirty-bindings)
(run-hooks 'tp--transaction-publish-functions)
(tp--publish-transaction-participants)
(tp--commit-signal-values)
(setq success t)
transaction-result)
(unless success
(let ((inhibit-quit t))
(setq rollback-failures
(tp--rollback-transaction-participants))
(run-hooks 'tp--transaction-rollback-functions)
(tp--rollback-bindings)
(setq tp--reactive-counters counter-snapshot)
(run-hooks 'tp--transaction-rollback-final-functions)
(when rollback-failures
(signal 'tp-reactive-error
(list :participant-rollback-failed
rollback-failures))))))
(when success
(run-hooks 'tp--transaction-committed-functions)
(setq after-commit
(nreverse tp--transaction-after-commit-callbacks)))
transaction-result))
(dolist (callback after-commit) (funcall callback))
result)))
;;;###autoload
(defmacro tp-with-transaction (&rest body)
"Evaluate BODY in one atomic signal and binding transaction."
(declare (indent 0) (debug t))
`(tp--call-with-transaction (lambda () ,@body)))
(defun tp--variable-signal-key (symbol scope)
"Return the adapter key for SYMBOL and SCOPE."
(cons symbol scope))
(defun tp--variable-signal-watcher (symbol new-value operation where)
"Forward SYMBOL's NEW-VALUE write into its exact signal adapter.
OPERATION and WHERE follow the standard variable watcher protocol."
(when (eq operation 'set)
(when-let ((signal (gethash (tp--variable-signal-key
symbol (or where 'global))
tp--variable-signals)))
(when (tp-signal-live-p signal)
(tp-signal-set signal new-value)))))
(defun tp--variable-signal-initial-value (symbol scope)
"Return SYMBOL's initial adapter value in SCOPE."
(if (eq scope 'global)
(if (default-boundp symbol) (default-value symbol) nil)
(with-current-buffer scope
(if (boundp symbol) (symbol-value symbol) nil))))
(defun tp-variable-signal (symbol &optional buffer)
"Return the signal adapting SYMBOL globally or in BUFFER."
(unless (symbolp symbol)
(signal 'wrong-type-argument (list 'symbolp symbol)))
(when (and buffer (not (buffer-live-p buffer)))
(signal 'tp-invalid-signal-scope (list buffer)))
(let* ((scope (or buffer 'global))
(key (tp--variable-signal-key symbol scope)))
(or (gethash key tp--variable-signals)
(let ((signal (tp-signal-create
(tp--variable-signal-initial-value symbol scope)
:scope scope)))
(setf (tp-signal-adapter-key signal) key)
(puthash key signal tp--variable-signals)
(unless (memq symbol tp--variable-signal-watched)
(add-variable-watcher symbol #'tp--variable-signal-watcher)
(push symbol tp--variable-signal-watched))
signal))))
(defun tp--symbol-has-variable-signal-p (symbol)
"Return non-nil when SYMBOL still owns an adapter signal."
(let ((found nil))
(maphash (lambda (key _signal)
(when (eq (car key) symbol) (setq found t)))
tp--variable-signals)
found))
(defun tp--dispose-signal (signal)
"Dispose SIGNAL and detach its graph and adapter state."
(unless (tp-signal-disposed signal)
(dolist (binding (tp--sorted-subscribers signal))
(setf (tp-binding-dependencies binding)
(delq signal (tp-binding-dependencies binding))
(tp-binding-dirty binding) t))
(clrhash (tp-signal-subscribers signal))
(when-let ((key (tp-signal-adapter-key signal)))
(remhash key tp--variable-signals)
(let ((symbol (car key)))
(unless (tp--symbol-has-variable-signal-p symbol)
(remove-variable-watcher symbol #'tp--variable-signal-watcher)
(setq tp--variable-signal-watched
(delq symbol tp--variable-signal-watched)))))
(when-let ((scope (and (bufferp (tp-signal-scope signal))
(tp-signal-scope signal))))
(when (buffer-live-p scope)
(with-current-buffer scope
(setq tp--buffer-signals (delq signal tp--buffer-signals)))))
(setf (tp-signal-disposed signal) t)
(setq tp--signals (delq signal tp--signals))))
(defun tp-signal-dispose (signal)
"Dispose SIGNAL, detach its subscriptions, and return nil."
(unless (tp-signal-p signal)
(signal 'wrong-type-argument (list 'tp-signal-p signal)))
(when tp--transaction-active
(signal 'tp-reactive-error (list :dispose-during-transaction)))
(tp--dispose-signal signal)
nil)
(defun tp--reactive-graph-reset ()
"Clear all signal, binding, adapter, and scheduler state."
(when tp--transaction-active
(signal 'tp-reactive-error (list :reset-during-transaction)))
(dolist (binding tp--bindings)
(tp--detach-binding-dependencies binding)
(clrhash (tp-binding-subscribers binding))
(setf (tp-binding-disposed binding) t
(tp-binding-state binding) 'disposed))
(dolist (signal (copy-sequence tp--signals))
(tp--dispose-signal signal))
(clrhash tp--owner-bindings)
(clrhash tp--variable-signals)
(setq tp--bindings nil
tp--signals nil
tp--variable-signal-watched nil)
(tp-reactive-reset-counters))
(defvar tp-reactive-deps nil
"Alist mapping reactive variables to dependent layers.
Each element: (VAR-SYMBOL . ((LAYER-NAME . REACTIVE-PROPS) ...)).")
(defvar tp-layer-watchers nil
"Alist of layer watchers: (LAYER-NAME . ((VAR-SYMBOL . CALLBACK) ...)).")
(defvar tp-reactive-observer-errors nil
"Structured observer failures, newest first.
Each entry is a plist containing `:kind', `:layer', `:symbol',
`:condition', `:new-value', and `:old-value'. Watcher failures are
recorded here and reported, but do not block the managed update.")
(defvar tp-layer-computed nil
"Alist of computed properties: (LAYER-NAME . ((VAR-SYMBOL . COMPUTE-FN) ...)).")
(defvar tp-layer-data nil
"Alist of data variables: (LAYER-NAME . (VAR-SYMBOL ...)).")
(defvar tp--batch-update-pending nil
"Queue of deferred reactive buffer re-renders.
Each entry is a list (LAYER-NAME CHANGED-SYMBOLS WHERE TP-TEXT-AFFECTED).
Entries are created and widened by `tp--queue-batch-update'.")
(defvar tp--layer-buffers (make-hash-table :test 'equal)
"Hash table mapping layer names to buffers showing their regions.
Keys are layer names; values are lists of buffers registered via
`tp-reactive--register-layer-buffer'. Reactive updates walk only
these buffers instead of scanning `buffer-list' (see
`tp-reactive-layer-buffers'). A key holding an empty list means
\"known: no buffer shows this layer\", which is distinct from an
absent key (`unknown').")
(defvar tp--layer-buffers-hook-installed nil
"Non-nil once the registry's `kill-buffer-hook' pruner is installed.")
(defun tp-reactive--install-kill-buffer-hook ()
"Install the global `kill-buffer-hook' pruning the buffer registry.
Idempotent; guarded by `tp--layer-buffers-hook-installed'."
(unless tp--layer-buffers-hook-installed
(add-hook 'kill-buffer-hook #'tp-reactive--prune-killed-buffer)
(setq tp--layer-buffers-hook-installed t)))
(defun tp-reactive--prune-killed-buffer ()
"Drop the buffer being killed from `tp--layer-buffers'.
Runs on `kill-buffer-hook' with the dying buffer current. The layer
entries themselves are kept: an entry left with an empty list means
\"known: no buffer shows this layer\", not `unknown'."
(let ((buf (current-buffer)))
(maphash (lambda (layer bufs)
(when (memq buf bufs)
(puthash layer (delq buf bufs) tp--layer-buffers)))
tp--layer-buffers)))
(defun tp-reactive--register-layer-buffer (layer-name buffer)
"Register BUFFER as showing regions of layer LAYER-NAME.
Idempotent: registering the same live BUFFER again keeps a single
entry. Dead buffers and a nil LAYER-NAME are ignored. Installs the
`kill-buffer-hook' pruner on first use. See
`tp-reactive-layer-buffers' for the consumer side of the registry."
(when (and layer-name (buffer-live-p buffer))
(tp-reactive--install-kill-buffer-hook)
(let ((bufs (gethash layer-name tp--layer-buffers)))
(unless (memq buffer bufs)
(puthash layer-name (cons buffer bufs) tp--layer-buffers)))))
(defun tp-reactive--unregister-layer-buffer (layer-name buffer)
"Remove BUFFER from LAYER-NAME's registry entry when it is known."
(let ((buffers (gethash layer-name tp--layer-buffers 'unknown)))
(unless (eq buffers 'unknown)
(puthash layer-name (delq buffer buffers) tp--layer-buffers))))
(defun tp-reactive-layer-buffers (layer-name)
"Return the live buffers registered as showing layer LAYER-NAME.
Return a list of live buffers - possibly empty, meaning \"known: no
buffer shows this layer\" - or the symbol `unknown' when LAYER-NAME
has no registry entry at all. Killed buffers still recorded in the
registry are dropped lazily by this accessor.
KNOWN GAP: inserting an already-propertized STRING into a buffer
bypasses the buffer operations that register buffers, so such a
buffer is missing here until a reactive update's full-scan fallback
finds it or `tp-reactive-track-buffer' is called on it."
(let ((bufs (gethash layer-name tp--layer-buffers 'unknown)))
(if (eq bufs 'unknown)
'unknown
(let ((live (cl-remove-if-not #'buffer-live-p bufs)))
(unless (= (length live) (length bufs))
(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 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
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 (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)))
found))
(defvar tp--batch-update-active nil
"When non-nil, we are inside a `tp-with-batch-updates' form.")
(defvar tp--reactive-updating nil
"Non-nil while a reactive update is being applied.
Used as a reentrancy guard: when a variable is set from within an
update (a computed variable being written, or the tp-text two-way
sync), the nested change still updates the variable, but its
re-render is queued in `tp--batch-update-pending' and flushed after
the outermost update completes instead of recursing.")
(defun tp--queue-batch-update (layer-name symbol where tp-text-affected)
"Queue a deferred re-render of LAYER-NAME in `tp--batch-update-pending'.
SYMBOL is the changed variable, WHERE the buffer for buffer-local
changes (nil for global ones), TP-TEXT-AFFECTED non-nil when the
change touches the layer's `tp-text'. When the layer already has a
pending entry, the entry is widened to the union of both changes:
SYMBOL is added, TP-TEXT-AFFECTED is sticky (once set it stays set)
and WHERE widens to nil (all buffers) as soon as two changes disagree
on it."
(let ((existing (assoc layer-name tp--batch-update-pending)))
(if existing
(progn
(unless (memq symbol (nth 1 existing))
(setf (nth 1 existing) (cons symbol (nth 1 existing))))
(unless (eq (nth 2 existing) where)
(setf (nth 2 existing) nil))
(when tp-text-affected
(setf (nth 3 existing) t)))
(push (list layer-name (list symbol) where (and tp-text-affected t))
tp--batch-update-pending))))
(defun tp--register-reactive-deps (layer-name reactive-symbols props)
"Register REACTIVE-SYMBOLS as dependencies for LAYER-NAME.
PROPS is the original property specification with reactive symbols.
Only the reactive portions of the properties are stored for each variable."
;; Register each reactive symbol's dependency with only its relevant properties
(dolist (rsym reactive-symbols)
(let* ((var-sym (tp--reactive-var-symbol rsym))
;; Extract only the properties that use this specific reactive variable
(reactive-props (tp--extract-reactive-props props rsym))
(existing (assoc var-sym tp-reactive-deps)))
(if existing
;; Update or add this layer to existing dependencies
(let ((layer-entry (assoc layer-name (cdr existing))))
(if layer-entry
;; Update existing entry with new reactive-props
(setf (cdr layer-entry) reactive-props)
;; Add new layer entry
(push (cons layer-name reactive-props) (cdr existing))))
;; Create new dependency entry and add watcher
(push (cons var-sym (list (cons layer-name reactive-props))) tp-reactive-deps)
;; Add variable watcher for this variable
(unless (boundp var-sym) (set var-sym nil))
(add-variable-watcher var-sym #'tp--reactive-variable-watcher)))))
(defun tp--unregister-reactive-deps (layer-name)
"Unregister all reactive dependencies for LAYER-NAME."
;; Collect variables that need watcher removal
(let ((vars-to-clean nil))
;; First pass: remove layer from dependencies and collect empty vars
(dolist (dep tp-reactive-deps)
(let ((var-sym (car dep)))
(setf (cdr dep) (assq-delete-all layer-name (cdr dep)))
;; If no more dependencies, mark for watcher removal
(when (null (cdr dep))
(push var-sym vars-to-clean))))
;; Remove watchers for variables with no dependencies
(dolist (var-sym vars-to-clean)
(remove-variable-watcher var-sym #'tp--reactive-variable-watcher)))
;; Clean up empty dependency entries
(setq tp-reactive-deps
(cl-remove-if (lambda (dep) (null (cdr dep))) tp-reactive-deps))
;; Also clean up layer watchers, computed properties, and data
(tp--unregister-layer-watchers layer-name)
(tp--unregister-layer-computed layer-name)
(tp--unregister-layer-data layer-name)
;; Drop the layer's buffer-registry entry: an undefined (or about to
;; be redefined) layer must not linger as stale "known" state; the
;; next update or refresh falls back to a learning full scan.
(remhash layer-name tp--layer-buffers))
(defun tp--layer-has-reactive-deps-p (layer-name)
"Return non-nil if LAYER-NAME has reactive dependencies registered.
Layers with reactive deps need tp-name for reactive tracking."
(cl-some (lambda (dep)
(assoc layer-name (cdr dep)))
tp-reactive-deps))
(defvar tp--reactive-update-function nil
"Function applying a reactive update to layer definitions and buffers.
Installed by tp-render.el. Called with (LAYER-NAME REACTIVE-PROPS
SYMBOL NEWVAL WHERE OVERRIDE-ALIST) after the user watch callbacks
have run. When nil, variable changes only invoke watch callbacks and
no re-rendering happens.")
(defun tp--reactive-variable-watcher (symbol newval operation where)
"Watcher function called when a reactive variable changes.
SYMBOL is the variable that changed.
NEWVAL is the new value being set.
OPERATION is the type of operation (set, let, unlet, makunbound, defvaralias).
WHERE indicates where the variable was set:
- nil for global `setq' or `set'
- a buffer for `setq-local'
Updates all layers that depend on this variable.
Only `set' operations trigger updates because:
- `let'/`unlet': Temporary bindings that will be restored, no need to update UI
- `makunbound': Variable is being undefined, not a value change
- `defvaralias': Aliasing, the actual value change will trigger a separate `set'
When `tp--batch-update-active' is non-nil, buffer updates are deferred until
the batch completes. Layer definitions are still updated immediately.
Uses `tp--equal-including-string-properties' for comparison to properly detect
changes in text properties when the text content is the same.
The actual recomputation and buffer re-rendering is delegated to
`tp--reactive-update-function', installed by tp-render.el."
(when (and (not (tp--equal-including-string-properties
(when (boundp symbol)
(symbol-value symbol))
newval))
(eq operation 'set))
(tp-debug-log "Variable %s changed: %S -> %S (where: %s)"
symbol (when (boundp symbol) (symbol-value symbol)) newval
(if where (buffer-name where) "global"))
(let ((deps (cdr (assoc symbol tp-reactive-deps)))
(oldval (when (boundp symbol) (symbol-value symbol)))
;; Create override alist with the new value
;; (watcher is called before the variable is actually updated)
(override-alist (list (cons symbol newval))))
(dolist (dep deps)
(let ((layer-name (car dep))
;; Get the reactive props stored directly in the dependency
(reactive-props (cdr dep)))
;; Call user-defined watch callbacks for this layer
(tp--invoke-layer-watchers layer-name symbol newval oldval)
;; Delegate recomputation and re-rendering to the update engine
(when tp--reactive-update-function
(funcall tp--reactive-update-function
layer-name reactive-props symbol newval
where override-alist)))))))
(defun tp--invoke-layer-watchers (layer-name symbol newval oldval)
"Invoke all registered watcher callbacks for LAYER-NAME watching SYMBOL.
NEWVAL is the new value, OLDVAL is the old value."
(when-let ((watchers (cdr (assoc layer-name tp-layer-watchers))))
(dolist (watcher watchers)
(let ((watch-sym (car watcher))
(callback (cdr watcher)))
(when (eq watch-sym symbol)
(tp-debug-log " Invoking watcher for %s on %s" watch-sym layer-name)
(condition-case err
(funcall callback newval oldval layer-name)
(error
(push (list :kind 'watcher
:layer layer-name
:symbol watch-sym
:condition err
:new-value newval
:old-value oldval)
tp-reactive-observer-errors)
(message "tp: watcher error for %s watching %s: %s"
layer-name watch-sym err))))))))
(defun tp--register-layer-watchers (layer-name watchers)
"Register WATCHERS for LAYER-NAME.
WATCHERS is a list of (VAR-SYMBOL CALLBACK) pairs."
(when watchers
(let ((watcher-pairs
(mapcar (lambda (watcher)
(cons (car watcher) (cadr watcher)))
watchers)))
(if (assoc layer-name tp-layer-watchers)
(setf (cdr (assoc layer-name tp-layer-watchers)) watcher-pairs)
(push (cons layer-name watcher-pairs) tp-layer-watchers)))))
(defun tp--register-layer-computed (layer-name computed)
"Register COMPUTED variable definitions for LAYER-NAME.
COMPUTED is a list of (VAR-SYMBOL COMPUTE-FN) pairs."
(when computed
(let ((computed-pairs
(mapcar (lambda (comp)
(cons (car comp) (cadr comp)))
computed)))
(if (assoc layer-name tp-layer-computed)
(setf (cdr (assoc layer-name tp-layer-computed)) computed-pairs)
(push (cons layer-name computed-pairs) tp-layer-computed)))))
(defun tp--unregister-layer-watchers (layer-name)
"Unregister all watchers for LAYER-NAME."
(setq tp-layer-watchers (assq-delete-all layer-name tp-layer-watchers)))
(defun tp--unregister-layer-computed (layer-name)
"Unregister all computed properties for LAYER-NAME."
(setq tp-layer-computed (assq-delete-all layer-name tp-layer-computed)))
(defun tp--apply-initial-computed (compute)
"Apply initial computed values using COMPUTE definitions.
COMPUTE is a list of (VAR-SYMBOL COMPUTE-FN) pairs.
Sets the global variables to their computed values.
A compute function returning nil is a legitimate result. Compute
errors propagate because a skipped value would leave stale state."
(dolist (comp compute)
(let* ((var-sym (car comp))
(compute-fn (cadr comp))
(val (funcall compute-fn)))
(set var-sym val))))
(defun tp--data-var-symbol (data-entry)
"Extract the variable symbol from DATA-ENTRY.
DATA-ENTRY can be a symbol or a cons cell (SYMBOL . INITIAL-VALUE)."
(if (consp data-entry)
(car data-entry)
data-entry))
(defun tp--register-layer-data (layer-name data-vars)
"Register DATA-VARS for LAYER-NAME.
DATA-VARS is a list of variable symbols or cons cells (SYMBOL . INITIAL-VALUE).
Also adds variable watchers so changes to data vars trigger computed updates."
(when data-vars
;; Extract just the symbols for storage
(let ((var-symbols (mapcar #'tp--data-var-symbol data-vars)))
(if (assoc layer-name tp-layer-data)
(setf (cdr (assoc layer-name tp-layer-data)) var-symbols)
(push (cons layer-name var-symbols) tp-layer-data))
;; Add watchers for data variables
(dolist (var-sym var-symbols)
(let ((existing (assoc var-sym tp-reactive-deps)))
(if existing
;; Add this layer to existing dependencies
;; (with nil props since data vars don't have direct props)
(let ((layer-entry (assoc layer-name (cdr existing))))
(unless layer-entry
(push (cons layer-name nil) (cdr existing))))
;; Create new dependency entry and add watcher
(push (cons var-sym (list (cons layer-name nil))) tp-reactive-deps)
(unless (boundp var-sym) (set var-sym nil))
(add-variable-watcher var-sym #'tp--reactive-variable-watcher)))))))
(defun tp--unregister-layer-data (layer-name)
"Unregister data variables for LAYER-NAME."
(setq tp-layer-data (assq-delete-all layer-name tp-layer-data)))
(defun tp--ensure-reactive-variables (var-symbols)
"Ensure all VAR-SYMBOLS are defined as global variables.
VAR-SYMBOLS can be a list of symbols or cons cells (SYMBOL . INITIAL-VALUE).
If a variable is not bound, define it with the initial value (nil if
not specified).
If a variable has an explicit initial value (cons cell), always update
it to allow re-definition to change initial values."
(dolist (sym var-symbols)
(let* ((is-cons (and (consp sym) (not (tp--reactive-symbol-p sym))))
(var-sym (cond
(is-cons (car sym))
((tp--reactive-symbol-p sym)
(tp--reactive-var-symbol sym))
(t sym)))
(initial-val (if is-cons (cdr sym) nil)))
(if is-cons
;; For explicit initial values, always update (allows re-definition)
(set var-sym initial-val)
;; For implicit initial values, only set if not already bound
(unless (boundp var-sym)
(set var-sym initial-val))))))
;;;###autoload
(defun tp-reactive-reset ()
"Reset all reactive text property watchers and dependencies."
(interactive)
(tp--reactive-graph-reset)
;; Remove all variable watchers
(dolist (dep tp-reactive-deps)
(let ((var-sym (car dep)))
(remove-variable-watcher var-sym #'tp--reactive-variable-watcher)))
;; Clear all registries
(setq tp-reactive-deps nil)
(setq tp-layer-watchers nil)
(setq tp-reactive-observer-errors nil)
(setq tp-layer-computed nil)
(setq tp-layer-data nil)
;; Drop queued re-renders too: entries stranded by an error escaping
;; an update would otherwise survive the reset and replay against
;; freshly (re)defined layers on the next flush (ARCH-4).
(setq tp--batch-update-pending nil)
(clrhash tp--layer-buffers))
(provide 'tp-reactive)
;;; tp-reactive.el ends here