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

Fix re-definition of tp layers to properly update :props, :data, :compute, and :watcher

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-20 14:47:52 +00:00
parent e90aa03806
commit d176d2e7cb
2 changed files with 255 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

215
tp-tests.el
View File

@ -2759,5 +2759,220 @@ incorrectly generate an anonymous tp-name instead of using the layer name."
(when (buffer-live-p buf2) (kill-buffer buf2))
(ignore-errors (makunbound 'tp-test-global-color)))))
;;; ============================================================
;;; Re-definition Tests (Issue: define-tp should update all properties on re-execution)
;;; ============================================================
(ert-deftest tp-test-redefine-layer-updates-data-initial-values ()
"Test that re-defining a layer with different :data initial values updates the variable."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition with gray color
(tp-define-layer test-redef-layer
:props (face (:background $tp-test-redef-color))
:data ((tp-test-redef-color . "gray")))
;; Check initial value
(should (equal tp-test-redef-color "gray"))
;; Check layer props
(let ((props (cdr (assoc 'test-redef-layer tp-layer-alist))))
(should (equal (plist-get (plist-get props 'face) :background) "gray")))
;; Re-define with different color
(tp-define-layer test-redef-layer
:props (face (:background $tp-test-redef-color))
:data ((tp-test-redef-color . "blue")))
;; Check variable is updated
(should (equal tp-test-redef-color "blue"))
;; Check layer props are updated
(let ((props (cdr (assoc 'test-redef-layer tp-layer-alist))))
(should (equal (plist-get (plist-get props 'face) :background) "blue"))))
;; Cleanup
(ignore-errors (makunbound 'tp-test-redef-color)))))
(ert-deftest tp-test-redefine-layer-updates-props ()
"Test that re-defining a layer updates :props correctly."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition
(tp-define-layer test-redef-props
:props (face (:foreground $tp-test-redef-fg))
:data ((tp-test-redef-fg . "red")))
(let ((props (cdr (assoc 'test-redef-props tp-layer-alist))))
(should (equal (plist-get (plist-get props 'face) :foreground) "red")))
;; Re-define with different props structure
(tp-define-layer test-redef-props
:props (face (:background $tp-test-redef-bg) help-echo "new")
:data ((tp-test-redef-bg . "yellow")))
;; Check new props are applied
(let ((props (cdr (assoc 'test-redef-props tp-layer-alist))))
(should (equal (plist-get (plist-get props 'face) :background) "yellow"))
(should (equal (plist-get props 'help-echo) "new"))
;; Old :foreground should NOT be present
(should (null (plist-get (plist-get props 'face) :foreground)))))
;; Cleanup
(ignore-errors (makunbound 'tp-test-redef-fg))
(ignore-errors (makunbound 'tp-test-redef-bg)))))
(ert-deftest tp-test-redefine-layer-clears-old-reactive-deps ()
"Test that re-defining a layer with different reactive vars clears old dependencies."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition with $old-var
(tp-define-layer test-redef-deps
:props (face (:foreground $tp-test-old-var))
:data ((tp-test-old-var . "red")))
;; Check old var is in dependencies
(should (assoc 'tp-test-old-var tp-reactive-deps))
(let ((deps (cdr (assoc 'tp-test-old-var tp-reactive-deps))))
(should (assoc 'test-redef-deps deps)))
;; Re-define with $new-var
(tp-define-layer test-redef-deps
:props (face (:foreground $tp-test-new-var))
:data ((tp-test-new-var . "blue")))
;; Check old var is no longer in dependencies for this layer
(when-let ((deps (cdr (assoc 'tp-test-old-var tp-reactive-deps))))
(should-not (assoc 'test-redef-deps deps)))
;; Check new var is in dependencies
(should (assoc 'tp-test-new-var tp-reactive-deps))
(let ((deps (cdr (assoc 'tp-test-new-var tp-reactive-deps))))
(should (assoc 'test-redef-deps deps))))
;; Cleanup
(ignore-errors (makunbound 'tp-test-old-var))
(ignore-errors (makunbound 'tp-test-new-var)))))
(ert-deftest tp-test-redefine-layer-updates-watchers ()
"Test that re-defining a layer updates :watch correctly."
(tp-test-with-temp-buffer
(defvar tp-test-watch-log-old nil "Log for old watcher.")
(defvar tp-test-watch-log-new nil "Log for new watcher.")
(unwind-protect
(progn
;; First definition with old watcher
(tp-define-layer test-redef-watch
:props (face (:foreground $tp-test-watch-var))
:data ((tp-test-watch-var . "red"))
:watch ((tp-test-watch-var
(lambda (new old layer)
(push (list 'old new) tp-test-watch-log-old)))))
;; Re-define with new watcher
(tp-define-layer test-redef-watch
:props (face (:foreground $tp-test-watch-var))
:data ((tp-test-watch-var . "red"))
:watch ((tp-test-watch-var
(lambda (new old layer)
(push (list 'new new) tp-test-watch-log-new)))))
;; Change variable
(setq tp-test-watch-var "blue")
;; Old watcher should NOT be called
(should (null tp-test-watch-log-old))
;; New watcher should be called
(should (= (length tp-test-watch-log-new) 1))
(should (equal (car tp-test-watch-log-new) '(new "blue"))))
;; Cleanup
(ignore-errors (makunbound 'tp-test-watch-var))
(makunbound 'tp-test-watch-log-old)
(makunbound 'tp-test-watch-log-new))))
(ert-deftest tp-test-redefine-layer-updates-compute ()
"Test that re-defining a layer updates :compute correctly."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition with old compute
(setq tp-test-compute-src "hello")
(tp-define-layer test-redef-compute
:props (help-echo $tp-test-compute-out)
:data (tp-test-compute-src)
:compute ((tp-test-compute-out
(lambda () (upcase tp-test-compute-src)))))
(should (equal tp-test-compute-out "HELLO"))
;; Re-define with different compute
(tp-define-layer test-redef-compute
:props (help-echo $tp-test-compute-out)
:data (tp-test-compute-src)
:compute ((tp-test-compute-out
(lambda () (concat tp-test-compute-src "-suffix")))))
;; Check compute is updated
(should (equal tp-test-compute-out "hello-suffix"))
;; Trigger re-compute by changing source
(setq tp-test-compute-src "world")
(should (equal tp-test-compute-out "world-suffix")))
;; Cleanup
(ignore-errors (makunbound 'tp-test-compute-src))
(ignore-errors (makunbound 'tp-test-compute-out)))))
(ert-deftest tp-test-redefine-layer-from-reactive-to-static ()
"Test re-defining a layer from reactive to non-reactive clears dependencies."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition with reactive variable
(tp-define-layer test-reactive-to-static
:props (face (:foreground $tp-test-r2s-color))
:data ((tp-test-r2s-color . "red")))
;; Check reactive dependency is registered
(should (assoc 'tp-test-r2s-color tp-reactive-deps))
;; Re-define as static (non-reactive)
(tp-define-layer test-reactive-to-static
(face bold))
;; Check reactive dependency is cleared
(when-let ((deps (cdr (assoc 'tp-test-r2s-color tp-reactive-deps))))
(should-not (assoc 'test-reactive-to-static deps)))
;; Check layer has new static props
(let ((props (cdr (assoc 'test-reactive-to-static tp-layer-alist))))
(should (eq (plist-get props 'face) 'bold))))
;; Cleanup
(ignore-errors (makunbound 'tp-test-r2s-color)))))
(ert-deftest tp-test-redefine-layer-group-updates-data ()
"Test that re-defining a layer group with different :data initial values updates the variable."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition
(tp-define-layer-group test-redef-group
("layer1" :props (face (:background $tp-test-group-color))
:data ((tp-test-group-color . "gray"))))
;; Check initial value
(should (equal tp-test-group-color "gray"))
;; Re-define with different color
(tp-define-layer-group test-redef-group
("layer1" :props (face (:background $tp-test-group-color))
:data ((tp-test-group-color . "blue"))))
;; Check variable is updated
(should (equal tp-test-group-color "blue"))
;; Check layer props are updated
(let ((props (cdr (assoc 'test-redef-group-layer1 tp-layer-alist))))
(should (equal (plist-get (plist-get props 'face) :background) "blue"))))
;; Cleanup
(ignore-errors (makunbound 'tp-test-group-color)))))
(ert-deftest tp-test-redefine-applied-layer-updates-text ()
"Test that re-defining a layer updates text regions that have it applied."
(tp-test-with-temp-buffer
(unwind-protect
(progn
;; First definition
(tp-define-layer test-redef-applied
:props (face (:background $tp-test-applied-color))
:data ((tp-test-applied-color . "gray")))
;; Apply to text
(insert "Hello World")
(tp-set 1 6 'test-redef-applied)
;; Check initial color
(should (equal (plist-get (get-text-property 1 'face) :background) "gray"))
;; Re-define with different color
(tp-define-layer test-redef-applied
:props (face (:background $tp-test-applied-color))
:data ((tp-test-applied-color . "blue")))
;; The text should now have the new color
;; Note: This happens because re-definition updates the variable,
;; which triggers the reactive update mechanism
(should (equal (plist-get (get-text-property 1 'face) :background) "blue")))
;; Cleanup
(ignore-errors (makunbound 'tp-test-applied-color)))))
(provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here

47
tp.el
View File

@ -396,7 +396,9 @@ Also adds variable watchers so changes to data vars trigger computed updates."
(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 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
@ -405,8 +407,12 @@ If a variable is not bound, define it with the initial value (nil if not specifi
(tp--reactive-var-symbol sym))
(t sym)))
(initial-val (if is-cons (cdr sym) nil)))
(unless (boundp var-sym)
(set var-sym initial-val)))))
(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))))))
(defun tp--update-layer-regions (layer-name &optional where)
"Update text regions that have LAYER-NAME applied.
@ -2066,6 +2072,8 @@ The layer is stored in `tp-layer-alist'."
(if (or all-reactive-syms data compute)
;; Has reactive features - register dependencies and resolve at runtime
`(progn
;; Clean up old dependencies first (for re-definition)
(tp--unregister-reactive-deps ',name)
;; Ensure all reactive variables are defined
(tp--ensure-reactive-variables ',all-vars-to-define)
;; Register data variables
@ -2084,10 +2092,17 @@ The layer is stored in `tp-layer-alist'."
;; Set layer properties with resolved values
(let ((resolved-props (tp--resolve-reactive-symbols ',properties)))
(tp--set-layer-props ',name resolved-props))
;; Update any text regions that already have this layer applied
;; This ensures re-definition immediately updates applied text
(tp--update-layer-regions ',name)
(assoc ',name tp-layer-alist))
;; No reactive symbols - use static properties
`(progn
;; Clean up old dependencies first (for re-definition from reactive to non-reactive)
(tp--unregister-reactive-deps ',name)
(tp--set-layer-props ',name ',properties)
;; Update any text regions that already have this layer applied
(tp--update-layer-regions ',name)
(assoc ',name tp-layer-alist)))))
(defalias 'define-tp 'tp-define-layer)
@ -2250,6 +2265,8 @@ and the group itself is stored in `tp-layer-groups'."
(if (or all-reactive-syms data compute)
;; Has reactive features - register dependencies and resolve at runtime
(push `(progn
;; Clean up old dependencies first (for re-definition)
(tp--unregister-reactive-deps ',layer-name)
;; Ensure all reactive variables are defined
(tp--ensure-reactive-variables ',all-vars-to-define)
;; Register data variables
@ -2267,10 +2284,17 @@ and the group itself is stored in `tp-layer-groups'."
`((tp--register-layer-watchers ',layer-name ',watch)))
;; Set layer properties with resolved values
(let ((resolved-props (tp--resolve-reactive-symbols ',props)))
(tp--set-layer-props ',layer-name resolved-props)))
(tp--set-layer-props ',layer-name resolved-props))
;; Update any text regions that already have this layer applied
(tp--update-layer-regions ',layer-name))
layer-defs)
;; No reactive symbols - use static properties
(push `(tp--set-layer-props ',layer-name ',props)
(push `(progn
;; Clean up old dependencies first (for re-definition)
(tp--unregister-reactive-deps ',layer-name)
(tp--set-layer-props ',layer-name ',props)
;; Update any text regions that already have this layer applied
(tp--update-layer-regions ',layer-name))
layer-defs))
(push layer-name layer-names)))
;; Simple format (cons cell of name . props)
@ -2281,15 +2305,24 @@ and the group itself is stored in `tp-layer-groups'."
(if reactive-syms
;; Has reactive symbols - register dependencies and resolve at runtime
(push `(progn
;; Clean up old dependencies first (for re-definition)
(tp--unregister-reactive-deps ',layer-name)
(tp--ensure-reactive-variables
',(mapcar #'tp--reactive-var-symbol reactive-syms))
(tp--register-reactive-deps
',layer-name ',reactive-syms ',props)
(let ((resolved-props (tp--resolve-reactive-symbols ',props)))
(tp--set-layer-props ',layer-name resolved-props)))
(tp--set-layer-props ',layer-name resolved-props))
;; Update any text regions that already have this layer applied
(tp--update-layer-regions ',layer-name))
layer-defs)
;; No reactive symbols - use static properties
(push `(tp--set-layer-props ',layer-name ',props)
(push `(progn
;; Clean up old dependencies first (for re-definition)
(tp--unregister-reactive-deps ',layer-name)
(tp--set-layer-props ',layer-name ',props)
;; Update any text regions that already have this layer applied
(tp--update-layer-regions ',layer-name))
layer-defs))
(push layer-name layer-names)
;; Only increment idx for anonymous (Format 1) elements