geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

Register every buffer-mutating layer write in the reactive registry

Browse Source 
The 0.3.0 buffer registry made reactive updates walk only registered
buffers, but only tp-set/tp-reset/tp-add registered.  Layer stack
mutators (tp-push-layer, tp-put-layer, hide/show, move/raise/rotate,
merge/flatten, add-to-layers) and the pattern-apply paths
(tp-match-add/-reset, tp-regexp-add/-reset) stamped tp-name via
direct set-text-properties without registering, so the moment a layer
was known from one tp-set anywhere, every buffer reached only through
those paths was silently and permanently skipped by reactive updates
- including the README's own flagship tp-push-layer example.  This
regressed 0.2.0, whose full buffer-list scan reached every buffer.

Fix: every buffer write that stamps tp-name now registers the buffer
via tp-reactive--register-layer-buffer (called directly, so tp-stack
and tp-search gain no tp-ops edge):

- tp-stack.el: new tp--stack-register-layers registers every named
  plist of the freshly written stack - buried and hidden layers
  included, which the stack-aware GC liveness fix builds on - beside
  all eleven set-text-properties sites; requires tp-reactive.
- tp-search.el: tp--deep-merge-apply and tp--reset-apply register the
  target buffer for the applied props' tp-name (and any group
  tp-layers entries); requires tp-reactive.

Regression tests: reactive updates reach a second buffer whose layer
arrived via tp-push-layer / tp-regexp-add / tp-match-reset after a
tp-set registered the layer elsewhere, and stack writes register
buried and hidden layers that arrived via string insertion.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Kinneyzhang 2026-07-27 01:35:05 +08:00
parent 27ad7325c5
commit 28acdae183
4 changed files with 222 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
tp-search-tests.el
View File

@ -610,5 +610,79 @@ value changes when a non-nil predicate is given."
(should (= (tp-forward-do #'upcase 'lvl 2 s) 1))
(should (equal (substring-no-properties s) "abc DEF"))))
;;; REG-1: pattern-apply paths must register buffers in the reactive registry
(defvar tp-search-reg1-color nil)
(defvar tp-search-reg1b-color nil)
(ert-deftest tp-search-test-regexp-add-registers-reactive-buffer ()
"tp-regexp-add in a second buffer keeps reactive updates flowing there.
The deep-merge apply path stamps `tp-name' but never registered the
buffer, so once the layer was known from a `tp-set' elsewhere the
regexp-applied buffer went permanently stale (REG-1)."
(setq tp-search-reg1-color "red")
(unwind-protect
(progn
(tp-layer-reset)
(define-tp tp-search-reg1-layer ()
:props '(face (:foreground $tp-search-reg1-color)))
(let ((a (generate-new-buffer " *tp-sreg1-a*"))
(b (generate-new-buffer " *tp-sreg1-b*")))
(unwind-protect
(progn
(with-current-buffer a (insert "foo bar"))
(with-current-buffer b (insert "foo bar"))
(tp-set 1 4 'tp-search-reg1-layer a) ; registers A
(tp-regexp-add "foo" 'tp-search-reg1-layer b)
(let ((bufs (tp-reactive-layer-buffers
'tp-search-reg1-layer)))
(should (memq a bufs))
(should (memq b bufs)))
(setq tp-search-reg1-color "blue")
(should (equal (with-current-buffer a
(get-text-property 1 'face))
'(:foreground "blue")))
(should (equal (with-current-buffer b
(get-text-property 1 'face))
'(:foreground "blue"))))
(kill-buffer a)
(kill-buffer b))))
(tp-layer-reset)
(setq tp-search-reg1-color nil)))
(ert-deftest tp-search-test-match-reset-registers-reactive-buffer ()
"tp-match-reset in a second buffer keeps reactive updates flowing there.
The reset-apply path stamps `tp-name' via `set-text-properties' but
never registered the buffer (REG-1)."
(setq tp-search-reg1b-color "red")
(unwind-protect
(progn
(tp-layer-reset)
(define-tp tp-search-reg1b-layer ()
:props '(face (:foreground $tp-search-reg1b-color)))
(let ((a (generate-new-buffer " *tp-sreg1b-a*"))
(b (generate-new-buffer " *tp-sreg1b-b*")))
(unwind-protect
(progn
(with-current-buffer a (insert "foo bar"))
(with-current-buffer b (insert "foo bar"))
(tp-set 1 4 'tp-search-reg1b-layer a)
(tp-match-reset "foo" 'tp-search-reg1b-layer b)
(let ((bufs (tp-reactive-layer-buffers
'tp-search-reg1b-layer)))
(should (memq a bufs))
(should (memq b bufs)))
(setq tp-search-reg1b-color "blue")
(should (equal (with-current-buffer a
(get-text-property 1 'face))
'(:foreground "blue")))
(should (equal (with-current-buffer b
(get-text-property 1 'face))
'(:foreground "blue"))))
(kill-buffer a)
(kill-buffer b))))
(tp-layer-reset)
(setq tp-search-reg1b-color nil)))
(provide 'tp-search-tests)
;;; tp-search-tests.el ends here

26
tp-search.el
View File

@ -20,9 +20,27 @@
(require 'cl-lib)
(require 'text-property-search)
(require 'tp-core)
(require 'tp-reactive)
(require 'tp-layer)
(require 'tp-ops)
(defun tp--search-register-layer-buffer (props object)
"Record OBJECT in the reactive buffer registry for PROPS's layers.
When OBJECT is a buffer or nil (the current buffer) and the applied
PROPS carry a `tp-name' - directly, or inside a `tp-layers' entry
from a group application - register that buffer under each layer name
via `tp-reactive--register-layer-buffer', so reactive updates keep
visiting buffers written through the pattern-apply paths. String
OBJECTs are not registered; see `tp-reactive-layer-buffers' for that
gap."
(when (or (null object) (bufferp object))
(let ((buf (or object (current-buffer))))
(when-let ((name (plist-get props 'tp-name)))
(tp-reactive--register-layer-buffer name buf))
(dolist (layer (plist-get props 'tp-layers))
(when-let ((name (plist-get layer 'tp-name)))
(tp-reactive--register-layer-buffer name buf))))))
(defun tp--pattern-apply-single (pattern properties apply-fn object literal
&optional start end subexp)
"Apply APPLY-FN to matches of single PATTERN in OBJECT.
@ -190,7 +208,10 @@ For buffers, modifies in-place."
(if (stringp obj)
;; For strings: create a new propertized string using tp--apply-props-to-string with :add mode
(tp--apply-props-to-string obj start end props :add)
;; For buffers: modify in-place
;; For buffers: modify in-place. This path stamps `tp-name' for
;; resolved layer applications, so the buffer must be registered
;; in the reactive registry or later updates would skip it (REG-1).
(tp--search-register-layer-buffer props obj)
(let ((pos start))
(while (< pos end)
(let* ((current-props (text-properties-at pos obj))
@ -265,6 +286,9 @@ For buffers, modifies in-place."
(if (stringp obj)
(tp--apply-props-to-string obj start end props :reset)
(set-text-properties start end props obj)
;; A resolved layer application stamps `tp-name': register the
;; buffer so reactive updates keep visiting it (REG-1).
(tp--search-register-layer-buffer props obj)
obj))
(defun tp-match-add (pattern plist &optional object start end)

86
tp-stack-tests.el
View File

@ -862,5 +862,91 @@ not just the first."
(should (null (tp-at 1 'face)))
(should (equal (tp-at 1 'help-echo) "tip"))))
;;; REG-1: every stack write must register its buffer in the reactive registry
(defvar tp-st-reg1-color nil)
(ert-deftest tp-stack-test-push-layer-registers-reactive-buffer ()
"tp-push-layer in a second buffer keeps reactive updates flowing there.
Once the registry knows a layer from a `tp-set' in one buffer, a
stack-path application in another buffer must register too; before
the REG-1 fix the second buffer was silently and permanently skipped
by every later update."
(setq tp-st-reg1-color "red")
(unwind-protect
(progn
(tp-layer-reset)
(define-tp tp-st-reg1-layer ()
:props '(face (:foreground $tp-st-reg1-color)))
(let ((a (generate-new-buffer " *tp-reg1-a*"))
(b (generate-new-buffer " *tp-reg1-b*")))
(unwind-protect
(progn
(with-current-buffer a (insert "hello"))
(with-current-buffer b (insert "hello"))
(tp-set 1 6 'tp-st-reg1-layer a) ; registers A
(with-current-buffer b
(tp-push-layer 1 6 'tp-st-reg1-layer))
;; The registry must know BOTH buffers.
(let ((bufs (tp-reactive-layer-buffers 'tp-st-reg1-layer)))
(should (memq a bufs))
(should (memq b bufs)))
(setq tp-st-reg1-color "blue")
(should (equal (with-current-buffer a
(get-text-property 1 'face))
'(:foreground "blue")))
(should (equal (with-current-buffer b
(get-text-property 1 'face))
'(:foreground "blue")))
;; And the registration is permanent, not a one-shot fluke.
(setq tp-st-reg1-color "green")
(should (equal (with-current-buffer b
(get-text-property 1 'face))
'(:foreground "green"))))
(kill-buffer a)
(kill-buffer b))))
(tp-layer-reset)
(setq tp-st-reg1-color nil)))
(ert-deftest tp-stack-test-stack-write-registers-buried-and-hidden-layers ()
"Stack writes register every named layer of the new stack, not just the top.
A buried layer (under a fresh push) and a hidden layer arrive in the
buffer via string insertion - a path that never registers - and the
next stack write on the region must register them (REG-1; GC-1's
liveness depends on this)."
(unwind-protect
(progn
(tp-layer-reset)
(define-tp tp-st-reg1-buried () '(face bold))
(define-tp tp-st-reg1-top () '(face italic))
(define-tp tp-st-reg1-hidden () '(face underline))
(let ((buf (generate-new-buffer " *tp-reg1-c*")))
(unwind-protect
(with-current-buffer buf
;; Propertized string insertion bypasses registration.
(insert (let ((s (copy-sequence "hello")))
(tp-push-layer s 'tp-st-reg1-buried)
s))
(insert (let ((s (copy-sequence " world")))
(tp-push-layer s 'tp-st-reg1-hidden)
s))
(should (eq (tp-reactive-layer-buffers 'tp-st-reg1-buried)
'unknown))
;; Pushing a new top rewrites the stack: the buried
;; layer below it must be registered as well.
(tp-push-layer 1 6 'tp-st-reg1-top)
(should (memq buf (tp-reactive-layer-buffers
'tp-st-reg1-buried)))
(should (memq buf (tp-reactive-layer-buffers
'tp-st-reg1-top)))
;; Hiding rewrites the stack: the now-hidden layer must
;; stay registered even though it loses its direct
;; tp-name.
(tp-hide-layer 7 12 'tp-st-reg1-hidden)
(should (memq buf (tp-reactive-layer-buffers
'tp-st-reg1-hidden))))
(kill-buffer buf))))
(tp-layer-reset)))
(provide 'tp-stack-tests)
;;; tp-stack-tests.el ends here

43
tp-stack.el
View File

@ -20,6 +20,7 @@
(require 'cl-lib)
(require 'dash)
(require 'tp-core)
(require 'tp-reactive)
(require 'tp-layer)
(require 'tp-ops)
@ -133,6 +134,23 @@ layer properties at all when every layer is hidden) and the
(t (append (car layer-list)
(list 'tp-layers (cdr layer-list))))))
(defun tp--stack-register-layers (stack object)
"Register OBJECT in the reactive buffer registry for every layer in STACK.
STACK is a list of layer plists as stored by the stack operations.
When OBJECT is a buffer or nil (the current buffer), every plist
carrying a `tp-name' - buried and hidden layers included - registers
that buffer via `tp-reactive--register-layer-buffer', so reactive
updates and the anonymous-layer GC keep seeing buffers whose layers
were written by stack mutators rather than by `tp-set'. String
OBJECTs are not registered; see `tp-reactive-layer-buffers' for that
gap. Registration is idempotent, so calling this once per rewritten
run is cheap."
(when (or (null object) (bufferp object))
(let ((buf (or object (current-buffer))))
(dolist (layer stack)
(when-let ((name (plist-get layer 'tp-name)))
(tp-reactive--register-layer-buffer name buf))))))
;;; Queries
(defun tp-region-layer-props (start end layer-name &optional object)
@ -369,7 +387,8 @@ string forms), otherwise the cons (START . END)."
(seq-drop stack actual-idx))))
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj))))
obj)
(tp--stack-register-layers new-stack obj))))
(or obj (cons start end))))))
(defun tp-push-layer (start-or-string &optional end-or-layer layer-or-object object noerror)
@ -425,10 +444,11 @@ alone and a return value of 0 means nothing matched at all."
start end obj
(lambda (abs-start abs-end stack)
(when-let ((found (tp--get-layer-by-idx-or-name stack layer-id)))
(set-text-properties
abs-start abs-end
(tp--stack-build-props (-remove-at (car found) stack))
(let ((new-stack (-remove-at (car found) stack)))
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj))
(setq count (1+ count)))))
count)))
@ -547,6 +567,7 @@ return value of 0 means nothing matched at all."
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj)
(setq count (1+ count)))))
count)))
@ -583,6 +604,7 @@ alone and a return value of 0 means nothing matched at all."
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj)
(setq count (1+ count)))))
count)))
@ -662,6 +684,7 @@ region had layers to rotate (or COUNT was below 1)."
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj)
(setq applied (1+ applied)))))))
applied)))
@ -713,6 +736,7 @@ left alone and a return value of 0 means nothing matched at all."
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj)
(setq count (1+ count)))))
count)))
@ -765,6 +789,7 @@ alone as well, so a return value of 0 means nothing changed."
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj)
(setq count (1+ count)))))))
count)))
@ -807,6 +832,7 @@ as well, so a return value of 0 means nothing changed."
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj)
(tp--stack-register-layers new-stack obj)
(setq count (1+ count)))))))
count)))
@ -867,7 +893,8 @@ to nil in a higher-precedence layer stays nil in the merged layer."
(setq new-stack (cons merged-props new-stack))
(set-text-properties abs-start abs-end
(tp--stack-build-props new-stack)
obj))))))
obj)
(tp--stack-register-layers new-stack obj))))))
nil))
(defun tp-flatten-layers (start-or-string &optional end-or-name name-or-object object)
@ -896,7 +923,8 @@ flattened result."
for i from 0
collect (cons i layer))
(when name (list 'tp-name name)))))
(set-text-properties abs-start abs-end merged-props obj)))))
(set-text-properties abs-start abs-end merged-props obj)
(tp--stack-register-layers (list merged-props) obj)))))
nil))
(defun tp-add-to-layers (idx-or-layer-name-list start-or-string &optional end-or-plist plist-or-object &rest rest)
@ -961,7 +989,8 @@ Returns the modified object (string) or nil for buffer operations."
(when stack
(set-text-properties abs-start abs-end
(tp--stack-build-props modified-stack)
obj)))))
obj)
(tp--stack-register-layers modified-stack obj)))))
(if (stringp obj) obj nil)))
(defun tp-add-to-all-layers (start-or-string &optional end-or-plist plist-or-object &rest rest)