6295d5ccbc
tp--flush-batch-updates existed to re-render buffers, which is tp-render's whole job - but it lived down in tp-reactive and reached the renderer through the tp--reactive-flush-function inversion, complete with a guard that silently DROPPED queued re-renders when no hook was installed. A partial load could thus discard updates without a trace. Move tp--flush-batch-updates and the public tp-with-batch-updates macro (same name, same behavior - only the home file changes) into tp-render.el, next to tp--reactive-flush-entry, which the flush now calls directly. Delete the tp--reactive-flush-function defvar, its silent-drop guard, and the install line. The queue state (tp--batch-update-pending, tp--batch-update-active, tp--reactive-updating) and tp--queue-batch-update stay in tp-reactive; the relocated macro let-binds them downward, which is legal. Together with the tp-text handler move this takes the sanctioned upward hooks from four to two - only the genuine lower-layer event sources remain (tp--reactive-update-function in tp-reactive, tp--layer-refresh-function in tp-layer) - and a degraded partial load now fails honestly with a void-function error instead of silently discarding queued re-renders. The ARCH-4 unwind-protect around the flush tail in tp--reactive-apply-update is untouched. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
557 lines
28 KiB
EmacsLisp
557 lines
28 KiB
EmacsLisp
;;; tp-render.el --- Reactive re-rendering engine for tp -*- 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:
|
|
|
|
;; The reactive update engine: when a reactive variable changes, this
|
|
;; module recomputes layer definitions and re-renders every affected
|
|
;; buffer region, including live `tp-text' text replacement. It also
|
|
;; owns the batching flush and the public `tp-with-batch-updates'
|
|
;; macro (the queue state lives in tp-reactive.el). It installs
|
|
;; itself into tp-reactive.el (update hook) and tp-layer.el (layer
|
|
;; refresh hook), and calls down into tp-ops.el for the `tp-text'
|
|
;; helper chain.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'tp-core)
|
|
(require 'tp-reactive)
|
|
(require 'tp-layer)
|
|
(require 'tp-ops)
|
|
(require 'tp-search)
|
|
|
|
(defun tp--layer-reactive-props (layer-name)
|
|
"Collect LAYER-NAME's unresolved reactive props from `tp-reactive-deps'.
|
|
Each dependency entry stores only the portions of the layer's props
|
|
that reference one variable; this merges the fragments back into a
|
|
single plist with the `$var' markers intact. Returns nil when the
|
|
layer has no reactive props (data-only dependencies store nil)."
|
|
(let ((all nil))
|
|
(dolist (dep tp-reactive-deps)
|
|
(let ((layer-entry (assoc layer-name (cdr dep))))
|
|
(when (and layer-entry (cdr layer-entry))
|
|
(setq all (if all
|
|
(tp--deep-merge-plist all (cdr layer-entry))
|
|
(copy-sequence (cdr layer-entry)))))))
|
|
all))
|
|
|
|
(defun tp--layer-render-props (layer-name override-alist)
|
|
"Return LAYER-NAME's props for re-rendering in the current buffer.
|
|
Starts from the stored layer definition and deep-merges the layer's
|
|
reactive props re-resolved against the current variable values, so
|
|
buffer-local values are honored when the target buffer is current.
|
|
OVERRIDE-ALIST maps variables to not-yet-visible new values (the
|
|
variable watcher runs before the variable is actually set) and takes
|
|
precedence over `symbol-value'. Returns nil when the layer has no
|
|
usable definition."
|
|
(let ((base (tp-layer-props layer-name t))) ; include tp-name for tracking
|
|
(when base
|
|
(let ((reactive (tp--layer-reactive-props layer-name)))
|
|
(if reactive
|
|
(tp--deep-merge-plist
|
|
base (tp--resolve-reactive-symbols reactive override-alist))
|
|
base)))))
|
|
|
|
(defun tp--update-layer-computed (layer-name override-alist)
|
|
"Update computed reactive variables for LAYER-NAME with OVERRIDE-ALIST.
|
|
Evaluates compute functions and updates the reactive variable values.
|
|
A compute function returning nil is a legitimate result and is
|
|
propagated; only computes that signal an error are skipped (see
|
|
`tp--compute-error').
|
|
Returns an updated override-alist with the new computed values."
|
|
(when-let ((computed (cdr (assoc layer-name tp-layer-computed))))
|
|
(dolist (comp computed)
|
|
(let* ((var-sym (car comp))
|
|
(compute-fn (cdr comp))
|
|
;; Temporarily bind variables to their new values from override-alist
|
|
;; before calling the compute function
|
|
(computed-val
|
|
(condition-case err
|
|
(cl-progv
|
|
(mapcar #'car override-alist)
|
|
(mapcar #'cdr override-alist)
|
|
(funcall compute-fn))
|
|
(error
|
|
(message "tp: compute error for %s.%s: %s"
|
|
layer-name var-sym err)
|
|
tp--compute-error))))
|
|
(unless (eq computed-val tp--compute-error)
|
|
;; Update the global variable
|
|
(set var-sym computed-val)
|
|
;; Add to override-alist for property resolution
|
|
(push (cons var-sym computed-val) override-alist)
|
|
;; Also update the layer properties if the computed var is used in props
|
|
(let ((current-props (cdr (assoc layer-name tp-layer-alist))))
|
|
(when current-props
|
|
(when-let ((all-reactive-props (tp--layer-reactive-props layer-name)))
|
|
(let ((resolved-props (tp--resolve-reactive-symbols
|
|
all-reactive-props override-alist)))
|
|
(when resolved-props
|
|
;; Deep-merge the resolved props into the current layer
|
|
;; props so sibling static attributes nested in plists
|
|
;; (e.g. a :background next to a reactive :foreground)
|
|
;; survive the update.
|
|
(tp--set-layer-props
|
|
layer-name
|
|
(tp--deep-merge-plist current-props resolved-props)))))))))))
|
|
override-alist)
|
|
|
|
(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
|
|
reactive update walk; tests may advise it to count buffer visits."
|
|
(when (buffer-live-p buffer)
|
|
(tp-with-current-buffer buffer
|
|
(funcall fn))))
|
|
|
|
(defun tp--map-layer-buffers (layer-name where fn)
|
|
"Run FN in each buffer that may show LAYER-NAME's regions.
|
|
A non-nil WHERE (a live buffer, the `setq-local' case) restricts the
|
|
walk to that buffer. Otherwise the walk consults the buffer registry
|
|
via `tp-reactive-layer-buffers' and visits only registered live
|
|
buffers. When the registry answers `unknown', the walk falls back to
|
|
a full `buffer-list' scan, registering every buffer that actually
|
|
contains a region of LAYER-NAME; once at least one buffer is
|
|
registered the layer is known and later updates skip the full scan.
|
|
A layer found in no buffer at all deliberately stays `unknown', so a
|
|
later application through a path that does not register buffers is
|
|
still picked up by the next update's full scan."
|
|
(if (and where (bufferp where) (buffer-live-p where))
|
|
(tp--render-visit-buffer where fn)
|
|
(let ((registered (tp-reactive-layer-buffers layer-name)))
|
|
(if (not (eq registered 'unknown))
|
|
(dolist (buf registered)
|
|
(tp--render-visit-buffer buf fn))
|
|
;; Learning fallback: behave exactly like the historical full
|
|
;; scan, but record which buffers actually carry the layer.
|
|
(dolist (buf (buffer-list))
|
|
(when (buffer-live-p buf)
|
|
(when (tp--buffer-has-layer-region-p layer-name buf)
|
|
(tp-reactive--register-layer-buffer layer-name buf))
|
|
(tp--render-visit-buffer buf fn)))))))
|
|
|
|
(defun tp--merge-props-into-stack-entry (entry props)
|
|
"Return stack-storage plist ENTRY with its keys updated from PROPS.
|
|
Every key of PROPS except `tp-name' and `tp-layers' replaces ENTRY's
|
|
value for that key (or extends ENTRY when the key is new), so ENTRY's
|
|
`tp-hidden' flag and identity survive the update. Returns a fresh
|
|
plist; ENTRY itself is not modified."
|
|
(let ((new-entry (copy-sequence entry)))
|
|
(cl-loop for (key val) on props by #'cddr
|
|
unless (memq key '(tp-name tp-layers))
|
|
do (setq new-entry (plist-put new-entry key val)))
|
|
new-entry))
|
|
|
|
(defun tp--write-layer-through-stack-storage (layer-name props)
|
|
"Write PROPS through to LAYER-NAME's entries in `tp-layers' storage.
|
|
A reactive re-render rewrites a layer's direct (rendered) properties,
|
|
but the same layer can also sit inside the `tp-layers' stack-storage
|
|
property of a run: buried below another layer, or hidden (see
|
|
`tp-hide-layer'), in which case the direct properties are only a
|
|
render cache and the stored entry is what the next stack operation
|
|
rebuilds from. For every run of the current buffer whose `tp-layers'
|
|
holds an entry whose `tp-name' equals LAYER-NAME, replace the layer's
|
|
own keys in that entry with their values from PROPS - preserving the
|
|
entry's `tp-hidden' flag and stack position - and rewrite the run via
|
|
`tp--stack-props-to-list' / `tp--stack-build-props', which also
|
|
refreshes the topmost-visible render cache in full-stack storage
|
|
mode. Runs already storing the current values are left untouched, so
|
|
an update that changes nothing does not mark the buffer as modified."
|
|
(let ((pos (point-min))
|
|
(max (point-max)))
|
|
(while (< pos max)
|
|
(let ((next (or (next-property-change pos nil max) max))
|
|
(stored (get-text-property pos 'tp-layers)))
|
|
(when (and stored
|
|
(cl-some (lambda (entry)
|
|
(equal (plist-get entry 'tp-name) layer-name))
|
|
stored))
|
|
(let* ((stack (tp--stack-props-to-list (text-properties-at pos)))
|
|
(new-stack
|
|
(mapcar (lambda (entry)
|
|
(if (equal (plist-get entry 'tp-name) layer-name)
|
|
(tp--merge-props-into-stack-entry entry props)
|
|
entry))
|
|
stack)))
|
|
(unless (equal new-stack stack)
|
|
(set-text-properties pos next
|
|
(tp--stack-build-props new-stack)))))
|
|
(setq pos next)))))
|
|
|
|
(defun tp--update-layer-regions (layer-name &optional where override-alist)
|
|
"Update text regions that have LAYER-NAME applied.
|
|
Re-applies the layer's current properties to every region tagged with
|
|
the layer's `tp-name'. The layer's OWN property keys are replaced
|
|
with their current values (so refresh is idempotent: a face variable
|
|
changing from bold to italic yields italic, not (italic bold)), while
|
|
properties contributed by other sources are left untouched.
|
|
|
|
The update also writes through to `tp-layers' stack storage (see
|
|
`tp--write-layer-through-stack-storage'): copies of the layer that
|
|
are hidden or buried below another layer are refreshed in place, so a
|
|
later stack operation or `tp-show-layer' renders current values
|
|
instead of a stale snapshot.
|
|
|
|
WHERE specifies which buffers to update:
|
|
- If WHERE is a buffer, only update that buffer (setq-local case).
|
|
- If WHERE is nil, update the buffers registered for the layer in
|
|
the reactive buffer registry, falling back to one full
|
|
`buffer-list' scan when the registry has no knowledge of the
|
|
layer (see `tp--map-layer-buffers').
|
|
|
|
OVERRIDE-ALIST maps reactive variables to their new values when the
|
|
watcher fires before the variables are set; layer props are
|
|
re-resolved against it in each target buffer, so buffer-local
|
|
variable values are honored."
|
|
(let ((update-buffer
|
|
(lambda ()
|
|
(let ((props (tp--layer-render-props layer-name override-alist)))
|
|
(when props
|
|
(save-excursion
|
|
;; Callback for tp-search-map: replaces the layer's own
|
|
;; property keys on the matched region. Returns nil to
|
|
;; prevent tp-search-map from replacing the text.
|
|
(tp-search-map
|
|
(lambda (_text start end)
|
|
(cl-loop for (key val) on props by #'cddr
|
|
do (put-text-property start end key val))
|
|
nil)
|
|
'tp-name layer-name)
|
|
;; Write through to stack storage so hidden or buried
|
|
;; copies of the layer do not go stale (HID-1).
|
|
(tp--write-layer-through-stack-storage layer-name
|
|
props)))))))
|
|
(tp--map-layer-buffers layer-name where update-buffer)))
|
|
|
|
(defun tp--update-reactive-text (layer-name &optional where override-alist)
|
|
"Update text regions that have tp-text property with LAYER-NAME applied.
|
|
This is called when a reactive variable bound to tp-text changes.
|
|
|
|
WHERE specifies which buffers to update:
|
|
- If WHERE is a buffer, only update that buffer (setq-local case).
|
|
- If WHERE is nil, update the buffers registered for the layer in
|
|
the reactive buffer registry, falling back to one full
|
|
`buffer-list' scan when the registry has no knowledge of the
|
|
layer (see `tp--map-layer-buffers').
|
|
|
|
OVERRIDE-ALIST maps reactive variables to their new values when the
|
|
watcher fires before the variables are set; the layer's props are
|
|
re-resolved against it in each target buffer.
|
|
|
|
If a transform function is registered for LAYER-NAME via `:transform',
|
|
it will be applied to the text before updating."
|
|
(let ((update-buffer
|
|
(lambda ()
|
|
(let ((props (tp--layer-render-props layer-name override-alist)))
|
|
(when props
|
|
(let* ((raw-text (plist-get props 'tp-text))
|
|
;; Apply transformation if registered
|
|
(new-text (if (stringp raw-text)
|
|
(tp--tp-text-transform layer-name raw-text)
|
|
raw-text)))
|
|
(when (and new-text (stringp new-text))
|
|
;; No save-excursion here: the replace function
|
|
;; owns point restoration (its clamping semantics
|
|
;; would be overridden by save-excursion's own
|
|
;; drifting marker).
|
|
(tp--replace-reactive-text-in-buffer
|
|
layer-name new-text props))))))))
|
|
(tp--map-layer-buffers layer-name where update-buffer)))
|
|
|
|
(defun tp--edit-region-minimal-diff (m-start m-end plain-text skip-props)
|
|
"Make [M-START, M-END) of the current buffer read PLAIN-TEXT.
|
|
Only the differing span of the region is edited: the common prefix
|
|
and suffix of the old and new text are left untouched. The
|
|
replacement is inserted BEFORE the old span is deleted, so markers
|
|
sitting in unchanged text keep tracking their characters - including
|
|
a marker at the first character of the preserved suffix, which the
|
|
old delete-then-insert order collapsed onto the edit start (TXT-1).
|
|
Markers whose characters were deleted end up at the end of the edit.
|
|
Does nothing when the region already reads PLAIN-TEXT, so an
|
|
identical-text update does not mark the buffer as modified.
|
|
Properties present at M-START whose keys the plist SKIP-PROPS does
|
|
not contain are re-applied over the edited span (a nil SKIP-PROPS
|
|
carries every existing property); the untouched prefix and suffix
|
|
keep their own properties as is.
|
|
Returns the cons (EDIT-START . EDIT-END) of the replaced span in
|
|
PRE-edit coordinates - the caller uses it to clamp a remembered
|
|
point that sat inside the edit - or nil when nothing was edited."
|
|
(let ((old-text (buffer-substring-no-properties m-start m-end)))
|
|
(unless (equal old-text plain-text)
|
|
;; Text content differs: trim the common prefix and suffix and
|
|
;; edit only the span that actually differs, so point and
|
|
;; markers in the unchanged parts survive the update.
|
|
(let* ((old-len (length old-text))
|
|
(new-len (length plain-text))
|
|
(min-len (min old-len new-len))
|
|
(prefix 0)
|
|
(suffix 0))
|
|
(while (and (< prefix min-len)
|
|
(eq (aref old-text prefix) (aref plain-text prefix)))
|
|
(setq prefix (1+ prefix)))
|
|
(while (and (< suffix (- min-len prefix))
|
|
(eq (aref old-text (- old-len suffix 1))
|
|
(aref plain-text (- new-len suffix 1))))
|
|
(setq suffix (1+ suffix)))
|
|
(let ((edit-start (+ m-start prefix))
|
|
(edit-end (- m-end suffix))
|
|
(insert-text (substring plain-text prefix (- new-len suffix)))
|
|
(existing-props (text-properties-at m-start)))
|
|
;; Insert first, then delete the (shifted) old span: an
|
|
;; insertion-type-nil marker at the start of the preserved
|
|
;; suffix sits strictly after EDIT-START, so the insertion
|
|
;; shifts it right with its character, and the deletion of
|
|
;; the old span just before it shifts it back into place.
|
|
(goto-char edit-start)
|
|
(insert insert-text)
|
|
(delete-region (point) (+ (point) (- edit-end edit-start)))
|
|
;; Carry over existing properties whose keys SKIP-PROPS does
|
|
;; not name onto the newly inserted span; the untouched
|
|
;; prefix and suffix keep their own properties as is.
|
|
(let ((mid-end (+ edit-start (length insert-text))))
|
|
(cl-loop for (key val) on existing-props by #'cddr
|
|
do (unless (plist-member skip-props key)
|
|
(put-text-property edit-start mid-end key
|
|
val))))
|
|
(cons edit-start edit-end))))))
|
|
|
|
(defun tp--pos-holds-layer-in-storage-only-p (pos layer-name)
|
|
"Return non-nil when POS holds LAYER-NAME only inside `tp-layers'.
|
|
True when the `tp-layers' stack-storage property at POS has an entry
|
|
whose `tp-name' equals LAYER-NAME while the direct `tp-name' at POS
|
|
is a different layer or absent (a hidden layer in all-hidden storage,
|
|
or a layer buried below another rendered layer)."
|
|
(and (not (equal (get-text-property pos 'tp-name) layer-name))
|
|
(cl-some (lambda (entry)
|
|
(equal (plist-get entry 'tp-name) layer-name))
|
|
(get-text-property pos 'tp-layers))
|
|
t))
|
|
|
|
(defun tp--replace-reactive-text-in-buffer (layer-name new-text props)
|
|
"Replace text in current buffer for reactive text with LAYER-NAME.
|
|
NEW-TEXT is the new text to replace with.
|
|
PROPS are the properties to apply to the new text.
|
|
Only the differing span of each region is edited: the common prefix
|
|
and suffix of the old and new text are left untouched, so point and
|
|
markers sitting in unchanged text keep their positions (point inside
|
|
the edited span ends up at the start of the edit). An identical-text
|
|
update touches no buffer text at all and does not mark the buffer as
|
|
modified.
|
|
Text properties embedded in NEW-TEXT are merged with PROPS per
|
|
embedded interval, so a multi-interval propertized reactive string
|
|
keeps its per-character styling. Existing text properties whose keys
|
|
are set neither by PROPS nor by NEW-TEXT's embedded props are
|
|
preserved, so one layer's text update does not erase other layers'
|
|
contributions on the same region.
|
|
Regions where the layer sits only inside `tp-layers' stack storage -
|
|
hidden (see `tp-hide-layer') or buried below another rendered layer -
|
|
are updated as well: text content is physical (hide/show toggles
|
|
properties, never text), so the model value still replaces the text
|
|
there, but the layer's props are not applied directly; instead its
|
|
stored stack entry, including the refreshed `tp-text', is written
|
|
through, so `tp-show-layer' or a reveal by a later stack operation
|
|
renders current values.
|
|
This function owns point restoration (callers must not wrap it in
|
|
`save-excursion', whose own marker would drift): point outside the
|
|
edits keeps tracking its character, and point inside an edited span
|
|
is clamped to the start of that edit."
|
|
(let ((plain-text (substring-no-properties new-text))
|
|
;; Remember where the user's point was; the marker tracks all
|
|
;; edits, and edits that swallow point clamp it explicitly.
|
|
(orig-point (copy-marker (point))))
|
|
(unwind-protect
|
|
(cl-flet ((edit-tracking-point (m-start m-end skip-props)
|
|
;; Run the minimal-diff edit; when the remembered
|
|
;; point sat inside the replaced span, clamp it to
|
|
;; the start of the edit (the documented
|
|
;; behavior).
|
|
(let* ((was (marker-position orig-point))
|
|
(span (tp--edit-region-minimal-diff
|
|
m-start m-end plain-text skip-props)))
|
|
(when (and span
|
|
(>= was (car span))
|
|
(< was (cdr span)))
|
|
(set-marker orig-point (car span))))))
|
|
(goto-char (point-min))
|
|
;; Pass 1: regions where the layer is the rendered top layer
|
|
;; (direct `tp-name').
|
|
(let ((match (text-property-search-forward 'tp-name
|
|
layer-name t)))
|
|
(while match
|
|
(let* ((m-start (prop-match-beginning match))
|
|
(m-end (prop-match-end match)))
|
|
(edit-tracking-point m-start m-end props)
|
|
;; Apply the layer's props, merged per embedded interval
|
|
;; of NEW-TEXT. Keys are replaced (not accumulated);
|
|
;; unrelated keys are untouched.
|
|
(tp--apply-reactive-text-props new-text props m-start)
|
|
;; Continue searching after the fully updated region: a
|
|
;; preserved suffix still carries the layer's `tp-name',
|
|
;; and restarting the search inside it would re-match
|
|
;; this region.
|
|
(goto-char (+ m-start (length plain-text))))
|
|
(setq match (text-property-search-forward 'tp-name
|
|
layer-name t))))
|
|
;; Pass 2: regions where the layer sits only inside stack
|
|
;; storage. Replace their text too, carrying ALL existing
|
|
;; properties (the visible top layer's render cache and the
|
|
;; `tp-layers' storage) over the edited span; the
|
|
;; hidden/buried layer's own props are not applied directly.
|
|
(let ((pos (point-min)))
|
|
(while (< pos (point-max))
|
|
(if (tp--pos-holds-layer-in-storage-only-p pos layer-name)
|
|
(let ((region-end pos))
|
|
(while (and (< region-end (point-max))
|
|
(tp--pos-holds-layer-in-storage-only-p
|
|
region-end layer-name))
|
|
(setq region-end (or (next-property-change
|
|
region-end)
|
|
(point-max))))
|
|
(edit-tracking-point pos region-end nil)
|
|
(setq pos (+ pos (length plain-text))))
|
|
(setq pos (or (next-property-change pos) (point-max))))))
|
|
;; Write the updated props - including the refreshed
|
|
;; `tp-text' - through to the layer's entries in stack
|
|
;; storage (HID-1).
|
|
(tp--write-layer-through-stack-storage layer-name props))
|
|
(goto-char orig-point)
|
|
(set-marker orig-point nil))))
|
|
|
|
(defun tp--reactive-apply-update (layer-name reactive-props symbol newval
|
|
where override-alist)
|
|
"Recompute LAYER-NAME's definition and re-render affected regions.
|
|
REACTIVE-PROPS are the layer's props that reference the changed
|
|
variable SYMBOL; NEWVAL is its new value. WHERE is the buffer for
|
|
`setq-local' changes, nil for global ones. OVERRIDE-ALIST maps SYMBOL
|
|
to NEWVAL (the watcher runs before the variable is actually set).
|
|
|
|
Buffer-local changes (WHERE a buffer) re-render only that buffer,
|
|
resolving the layer's props against the buffer-local values, and do
|
|
NOT touch the global layer definition, so `setq-local' cannot leak a
|
|
buffer's value into other buffers.
|
|
|
|
When `tp--batch-update-active' is non-nil the buffer update is queued
|
|
in `tp--batch-update-pending' instead of applied immediately. When
|
|
this function is re-entered from a nested variable write issued
|
|
inside an update (a computed variable being set, or the tp-text
|
|
two-way sync), the nested re-render is queued the same way and
|
|
flushed once the outermost update completes, instead of recursing.
|
|
|
|
This is the engine behind `tp--reactive-variable-watcher'; it is
|
|
installed as `tp--reactive-update-function'."
|
|
(ignore newval)
|
|
(let ((tp-text-affected (and (plist-member reactive-props 'tp-text) t)))
|
|
(if tp--reactive-updating
|
|
;; Nested change fired from within an update: queue, don't recurse.
|
|
(tp--queue-batch-update layer-name symbol where tp-text-affected)
|
|
(unwind-protect
|
|
(let ((tp--reactive-updating t))
|
|
;; Update computed properties for this layer
|
|
(let ((updated-override
|
|
(tp--update-layer-computed layer-name override-alist)))
|
|
;; Update only the reactive properties in the layer definition.
|
|
;; Buffer-local changes must not leak into the global definition;
|
|
;; the buffer re-render below resolves against the buffer-local
|
|
;; values instead.
|
|
(when (and reactive-props (not (bufferp where)))
|
|
(let ((resolved-props (tp--resolve-reactive-symbols
|
|
reactive-props updated-override))
|
|
(current-props (cdr (assoc layer-name tp-layer-alist))))
|
|
(when current-props
|
|
;; Deep merge the resolved reactive props into the current
|
|
;; layer props to preserve nested plist values (like face)
|
|
(tp--set-layer-props
|
|
layer-name
|
|
(tp--deep-merge-plist current-props resolved-props)))))
|
|
;; Update text regions with this layer (or defer if batching)
|
|
(if tp--batch-update-active
|
|
;; Batching: defer the buffer update
|
|
(progn
|
|
(tp-debug-log " Deferring buffer update for %s (batch mode)"
|
|
layer-name)
|
|
(tp--queue-batch-update layer-name symbol where
|
|
tp-text-affected))
|
|
;; Normal: update immediately
|
|
(tp-debug-log " Updating layer %s (tp-text affected: %s)"
|
|
layer-name (if tp-text-affected "yes" "no"))
|
|
(if tp-text-affected
|
|
(tp--update-reactive-text layer-name where updated-override)
|
|
(tp--update-layer-regions layer-name where updated-override)))))
|
|
;; Re-renders queued by nested variable writes during this update
|
|
;; are flushed now that the outermost update has finished. The
|
|
;; flush runs under unwind-protect so an error escaping the
|
|
;; re-render (for example from a modification hook) cannot strand
|
|
;; queued entries in the global queue (ARCH-4); the reentrancy
|
|
;; guard has been unbound by now, so the flush re-renders
|
|
;; normally.
|
|
(unless tp--batch-update-active
|
|
(when tp--batch-update-pending
|
|
(tp--flush-batch-updates)))))))
|
|
|
|
(defun tp--reactive-flush-entry (layer-name where tp-text-affected)
|
|
"Re-render LAYER-NAME's regions in WHERE (or all buffers when nil).
|
|
TP-TEXT-AFFECTED non-nil means the layer's `tp-text' changed and the
|
|
text itself must be replaced. Runs after the changed variables have
|
|
actually been set, so layer props re-resolve against current
|
|
\(buffer-local aware) values. This is the per-entry worker of
|
|
`tp--flush-batch-updates'."
|
|
(if tp-text-affected
|
|
(tp--update-reactive-text layer-name where)
|
|
(tp--update-layer-regions layer-name where)))
|
|
|
|
(defun tp--flush-batch-updates ()
|
|
"Flush all pending batch updates.
|
|
This processes all updates collected during a `tp-with-batch-updates' form."
|
|
(tp-debug-log "Flushing %d pending batch updates" (length tp--batch-update-pending))
|
|
(let ((processed-layers nil))
|
|
;; Process each pending update, avoiding duplicate layer updates
|
|
(dolist (pending (nreverse tp--batch-update-pending))
|
|
(let ((layer-name (car pending))
|
|
(where (caddr pending))
|
|
(tp-text-affected (cadddr pending)))
|
|
(unless (memq layer-name processed-layers)
|
|
(push layer-name processed-layers)
|
|
(tp-debug-log " Batch updating layer %s (tp-text: %s)"
|
|
layer-name (if tp-text-affected "yes" "no"))
|
|
(tp--reactive-flush-entry layer-name where tp-text-affected)))))
|
|
(setq tp--batch-update-pending nil))
|
|
|
|
(defmacro tp-with-batch-updates (&rest body)
|
|
"Execute BODY with reactive updates batched.
|
|
Multiple variable changes within BODY are collected and applied
|
|
together at the end, avoiding redundant buffer modifications.
|
|
|
|
This is useful when changing multiple reactive variables simultaneously:
|
|
|
|
(tp-with-batch-updates
|
|
(setq my-color \"red\")
|
|
(setq my-size 14)
|
|
(setq my-text \"Hello\"))
|
|
|
|
Without batching, each `setq' would trigger a separate buffer update.
|
|
With batching, all updates are consolidated and applied once at the end."
|
|
(declare (indent 0) (debug t))
|
|
`(let ((tp--batch-update-active t)
|
|
(tp--batch-update-pending nil))
|
|
(tp-debug-log "Starting batch updates")
|
|
(unwind-protect
|
|
(progn ,@body)
|
|
(tp-debug-log "Ending batch updates")
|
|
(tp--flush-batch-updates))))
|
|
|
|
;; Install the engine into the lower modules.
|
|
(setq tp--reactive-update-function #'tp--reactive-apply-update)
|
|
(setq tp--layer-refresh-function #'tp--update-layer-regions)
|
|
|
|
(provide 'tp-render)
|
|
;;; tp-render.el ends here
|