972b6d4e4c
Add canonical query semantics, managed metadata and transactions, overlay-aware lookup, reproducible benchmarks, and synchronized API documentation.
669 lines
32 KiB
EmacsLisp
669 lines
32 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--store-computed-value
|
|
(layer-name var-sym computed-val override-alist)
|
|
"Store LAYER-NAME's computed VAR-SYM and return updated OVERRIDE-ALIST."
|
|
(set var-sym computed-val)
|
|
(push (cons var-sym computed-val) override-alist)
|
|
(let ((current-props (cdr (assoc layer-name tp-layer-alist)))
|
|
(reactive-props (tp--layer-reactive-props layer-name)))
|
|
(when (and current-props reactive-props)
|
|
(let ((resolved
|
|
(tp--resolve-reactive-symbols reactive-props override-alist)))
|
|
(when resolved
|
|
(tp--set-layer-props
|
|
layer-name
|
|
(tp--deep-merge-plist current-props resolved))))))
|
|
override-alist)
|
|
|
|
(defun tp--update-layer-computed (layer-name override-alist)
|
|
"Compute LAYER-NAME values and return an updated OVERRIDE-ALIST.
|
|
Compute errors propagate; returning nil remains a legitimate value."
|
|
(dolist (comp (cdr (assoc layer-name tp-layer-computed)))
|
|
(let* ((var-sym (car comp))
|
|
(compute-fn (cdr comp))
|
|
(computed-val
|
|
(cl-progv
|
|
(mapcar #'car override-alist)
|
|
(mapcar #'cdr override-alist)
|
|
(funcall compute-fn))))
|
|
(setq override-alist
|
|
(tp--store-computed-value
|
|
layer-name var-sym computed-val override-alist))))
|
|
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--reconcile-layer-props
|
|
(current old-props new-props &optional include-meta)
|
|
"Replace one layer's OLD-PROPS in CURRENT with NEW-PROPS.
|
|
Keys owned by OLD-PROPS are removed when CURRENT still carries the old
|
|
value, then NEW-PROPS are written in full. A differing current value
|
|
is preserved when the new definition no longer owns that key, because
|
|
it may be an explicit post-application edit. Stack metadata
|
|
`tp-layers' and `tp-hidden' is never owned by a layer definition.
|
|
`tp-meta' is rendered only when INCLUDE-META is non-nil.
|
|
Return a fresh plist."
|
|
(let ((result (copy-sequence current)))
|
|
(cl-loop for (key val) on old-props by #'cddr
|
|
unless (memq key '(tp-name tp-layers tp-hidden tp-meta))
|
|
when (and (plist-member result key)
|
|
(equal (plist-get result key) val))
|
|
do (cl-remf result key))
|
|
(cl-loop for (key val) on new-props by #'cddr
|
|
unless (or (memq key '(tp-layers tp-hidden))
|
|
(and (eq key 'tp-meta) (not include-meta)))
|
|
do (setq result (plist-put result key val)))
|
|
result))
|
|
|
|
(defun tp--reconcile-layer-region (start end old-props new-props)
|
|
"Reconcile OLD-PROPS and NEW-PROPS on every property run in START..END."
|
|
(let ((pos start))
|
|
(while (< pos end)
|
|
(let* ((next (or (next-property-change pos nil end) end))
|
|
(current (text-properties-at pos))
|
|
(updated (tp--reconcile-layer-props
|
|
current old-props new-props)))
|
|
(unless (equal updated current)
|
|
(set-text-properties pos next updated))
|
|
(setq pos next)))))
|
|
|
|
(defun tp--replace-stack-entry-props (entry old-props new-props)
|
|
"Return ENTRY with OLD-PROPS replaced by NEW-PROPS."
|
|
(tp--refresh-entry-meta-version
|
|
(tp--reconcile-layer-props entry old-props new-props t)))
|
|
|
|
(defun tp--refresh-entry-meta-version (entry)
|
|
"Return ENTRY with refreshed metadata version fields when present."
|
|
(if-let ((meta (plist-get entry 'tp-meta))
|
|
(name (plist-get entry 'tp-name)))
|
|
(let ((updated (copy-tree meta)))
|
|
(setq updated
|
|
(plist-put updated :definition-version
|
|
(tp--layer-definition-version name)))
|
|
(setq updated
|
|
(plist-put updated :entry-version
|
|
(1+ (or (plist-get meta :entry-version) 0))))
|
|
(when (boundp 'tp-theme-generation)
|
|
(setq updated
|
|
(plist-put updated :palette-generation
|
|
tp-theme-generation)))
|
|
(plist-put entry 'tp-meta updated))
|
|
entry))
|
|
|
|
(defun tp--entry-parameterized-refresh (entry layer-name)
|
|
"Return refreshed ENTRY for parameterized LAYER-NAME, or ENTRY."
|
|
(let ((meta (plist-get entry 'tp-meta)))
|
|
(if (and meta
|
|
(eq (plist-get entry 'tp-name) layer-name)
|
|
(not (plist-get meta :legacy-no-args))
|
|
(plist-member meta :args)
|
|
(tp-layer-parameterized-p layer-name))
|
|
(tp--entry-from-parameterized-meta entry layer-name meta)
|
|
entry)))
|
|
|
|
(defun tp--entry-from-parameterized-meta (entry layer-name meta)
|
|
"Build a refreshed managed ENTRY for LAYER-NAME from META."
|
|
(let* ((args (plist-get meta :args))
|
|
(props (tp-layer-props-with-args layer-name args t))
|
|
(hidden (tp--stack-hidden-p entry))
|
|
(updated (tp--refresh-entry-meta-version
|
|
(plist-put props 'tp-meta (copy-tree meta)))))
|
|
(if hidden
|
|
(plist-put updated 'tp-hidden t)
|
|
updated)))
|
|
|
|
(defun tp--refresh-parameterized-stack (stack layer-name)
|
|
"Refresh parameterized LAYER-NAME entries in STACK."
|
|
(mapcar (lambda (entry)
|
|
(tp--entry-parameterized-refresh entry layer-name))
|
|
stack))
|
|
|
|
(defun tp--refresh-parameterized-layer-regions (layer-name)
|
|
"Refresh mounted parameterized entries for LAYER-NAME in current buffer."
|
|
(let ((pos (point-min))
|
|
(max (point-max)))
|
|
(while (< pos max)
|
|
(let* ((next (or (next-property-change pos nil max) max))
|
|
(stack (tp--stack-props-to-list (text-properties-at pos)))
|
|
(new-stack (tp--refresh-parameterized-stack stack layer-name)))
|
|
(unless (equal new-stack stack)
|
|
(set-text-properties pos next
|
|
(tp--stack-build-props new-stack)))
|
|
(setq pos next)))))
|
|
|
|
(defun tp--managed-stack-with-direct-edits (props stored)
|
|
"Return authoritative STORED after absorbing visible edits from PROPS.
|
|
In managed full-stack storage, direct properties are the render
|
|
projection of the first visible entry. A caller may legitimately
|
|
edit that projection with native text-property primitives. Preserve
|
|
those edits on the visible entry before refreshing definitions, while
|
|
keeping managed identity and metadata authoritative."
|
|
(let ((direct (copy-sequence props)))
|
|
(cl-remf direct 'tp-layers)
|
|
(let ((visible (seq-find (lambda (entry)
|
|
(not (tp--stack-hidden-p entry)))
|
|
stored)))
|
|
(cond
|
|
((null visible)
|
|
(if direct
|
|
(signal 'tp-layer-conflict
|
|
(list "Properties appeared while all layers were hidden"
|
|
:actual direct))
|
|
stored))
|
|
((not (equal (plist-get direct 'tp-name)
|
|
(plist-get visible 'tp-name)))
|
|
(signal 'tp-layer-conflict
|
|
(list "Managed render identity changed"
|
|
:actual direct :expected visible)))
|
|
(t
|
|
(let ((updated (copy-tree visible)))
|
|
(cl-loop for (key _value)
|
|
on (tp--entry-render-projection visible) by #'cddr
|
|
unless (or (eq key 'tp-name)
|
|
(plist-member direct key))
|
|
do (cl-remf updated key))
|
|
(cl-loop for (key value) on direct by #'cddr
|
|
unless (eq key 'tp-name)
|
|
do (setq updated (plist-put updated key value)))
|
|
(mapcar (lambda (entry)
|
|
(if (eq entry visible) updated entry))
|
|
stored)))))))
|
|
|
|
(defun tp--write-layer-through-stack-storage
|
|
(layer-name props &optional old-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. OLD-PROPS, when non-nil, identifies definition-owned
|
|
keys that disappeared and must be removed.
|
|
|
|
For every run of the current buffer whose `tp-layers' holds an entry
|
|
whose `tp-name' equals LAYER-NAME, reconcile the layer entry and
|
|
rewrite the run via `tp--stack-props-to-list' /
|
|
`tp--stack-build-props'. Runs already storing the current values are
|
|
left untouched."
|
|
(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* ((raw (text-properties-at pos))
|
|
(stack
|
|
(if (tp--entry-authoritative-storage-p stored)
|
|
(tp--managed-stack-with-direct-edits raw stored)
|
|
(tp--stack-props-to-list raw)))
|
|
(new-stack
|
|
(mapcar (lambda (entry)
|
|
(if (equal (plist-get entry 'tp-name) layer-name)
|
|
(tp--replace-stack-entry-props
|
|
entry old-props 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 old-props)
|
|
"Update text regions that have LAYER-NAME applied.
|
|
Reconcile the layer's current properties with OLD-PROPS, when given,
|
|
so redefinition removes keys and nested values the old definition
|
|
owned while preserving unrelated direct properties.
|
|
|
|
The update also writes through to `tp-layers' 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,
|
|
falling back to a full scan when the registry has no knowledge.
|
|
|
|
OVERRIDE-ALIST maps reactive variables to their new values when a
|
|
watcher fires before those variables are set."
|
|
(let ((update-buffer
|
|
(lambda ()
|
|
(let ((props (tp--layer-render-props layer-name override-alist)))
|
|
(save-excursion
|
|
(if props
|
|
(progn
|
|
;; In hidden/full-stack mode storage is authoritative.
|
|
;; Update it first so the render-cache conflict guard
|
|
;; compares old cache with old storage.
|
|
(tp--write-layer-through-stack-storage
|
|
layer-name props old-props)
|
|
(tp-search-map
|
|
(lambda (_text start end)
|
|
(tp--reconcile-layer-region
|
|
start end old-props props)
|
|
nil)
|
|
'tp-name layer-name))
|
|
(tp--refresh-parameterized-layer-regions layer-name)))))))
|
|
(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
|