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

fix: Preserve tp-name and tp-layers when setting properties with layer/group names

Browse Source 
- tp--resolve-props now uses tp-layer-props (includes tp-name) for layers
- For groups, uses tp--build-layer-props to include tp-layers structure
- Updated tests to verify tp-name and tp-layers are preserved
- Added new test for groups with multiple layers

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-20 07:34:54 +00:00
parent f775d761bf
commit 736cfc59d9
2 changed files with 58 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
tp-tests.el
View File

@ -2054,7 +2054,9 @@ Returns list of (START END VALUE) intervals."
;; Use layer name instead of plist
(tp-set 1 6 'my-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "tip"))))
(should (equal (tp-at 1 'help-echo) "tip"))
;; tp-name should be preserved for reactive text property support
(should (eq (tp-at 1 'tp-name) 'my-style))))
(ert-deftest tp-test-set-with-layer-name-on-string ()
"Test tp-set accepts a layer name on string."
@ -2063,7 +2065,9 @@ Returns list of (START END VALUE) intervals."
(setq tp-layer-groups nil)
(tp-define-layer my-style (face italic))
(tp-set 0 5 'my-style str)
(should (eq (get-text-property 0 'face str) 'italic))))
(should (eq (get-text-property 0 'face str) 'italic))
;; tp-name should be preserved for reactive text property support
(should (eq (get-text-property 0 'tp-name str) 'my-style))))
(ert-deftest tp-test-reset-with-layer-name ()
"Test tp-reset accepts a layer name defined by define-tp."
@ -2074,7 +2078,9 @@ Returns list of (START END VALUE) intervals."
;; Use layer name - should completely replace
(tp-reset 1 6 'my-style)
(should (eq (tp-at 1 'face) 'underline))
(should (null (tp-at 1 'mouse-face)))))
(should (null (tp-at 1 'mouse-face)))
;; tp-name should be preserved
(should (eq (tp-at 1 'tp-name) 'my-style))))
(ert-deftest tp-test-add-with-layer-name ()
"Test tp-add accepts a layer name defined by define-tp."
@ -2085,7 +2091,9 @@ Returns list of (START END VALUE) intervals."
;; Use layer name - should preserve existing properties
(tp-add 1 6 'my-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "existing"))))
(should (equal (tp-at 1 'help-echo) "existing"))
;; tp-name should be preserved
(should (eq (tp-at 1 'tp-name) 'my-style))))
(ert-deftest tp-test-match-set-with-layer-name ()
"Test tp-match-set accepts a layer name."
@ -2095,7 +2103,9 @@ Returns list of (START END VALUE) intervals."
(tp-match-set "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "matched"))
(should (eq (tp-at 13 'face) 'bold))))
(should (eq (tp-at 13 'face) 'bold))
;; tp-name should be preserved
(should (eq (tp-at 1 'tp-name) 'match-style))))
(ert-deftest tp-test-match-set-with-layer-name-on-string ()
"Test tp-match-set accepts a layer name on string."
@ -2105,7 +2115,9 @@ Returns list of (START END VALUE) intervals."
(tp-define-layer match-style (face italic))
(tp-match-set "Hello" 'match-style str)
(should (eq (get-text-property 0 'face str) 'italic))
(should (eq (get-text-property 12 'face str) 'italic))))
(should (eq (get-text-property 12 'face str) 'italic))
;; tp-name should be preserved
(should (eq (get-text-property 0 'tp-name str) 'match-style))))
(ert-deftest tp-test-match-reset-with-layer-name ()
"Test tp-match-reset accepts a layer name."
@ -2165,7 +2177,9 @@ Returns list of (START END VALUE) intervals."
(tp-define-layer number-style (face bold))
(tp-regexp-add "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold))
(should (equal (tp-at 5 'help-echo) "original"))))
(should (equal (tp-at 5 'help-echo) "original"))
;; tp-name should be preserved
(should (eq (tp-at 5 'tp-name) 'number-style))))
(ert-deftest tp-test-set-with-group-name ()
"Test tp-set accepts a group name defined by define-tp-group."
@ -2173,10 +2187,30 @@ Returns list of (START END VALUE) intervals."
(insert "Hello World")
(tp-define-layer-group my-group
("style" . (face bold help-echo "grouped")))
;; Use group name - should use first layer's properties
;; Use group name - should include tp-name for top layer
(tp-set 1 6 'my-group)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "grouped"))))
(should (equal (tp-at 1 'help-echo) "grouped"))
;; tp-name should be preserved for the top layer
(should (eq (tp-at 1 'tp-name) 'my-group-style))))
(ert-deftest tp-test-set-with-group-name-multiple-layers ()
"Test tp-set with group containing multiple layers preserves tp-layers."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-define-layer-group my-group
("first" . (face bold))
("second" . (face italic)))
;; Use group name - should include tp-layers for multiple layers
(tp-set 1 6 'my-group)
;; First layer is on top
(should (eq (tp-at 1 'face) 'bold))
(should (eq (tp-at 1 'tp-name) 'my-group-first))
;; tp-layers should contain the second layer
(let ((layers (tp-at 1 'tp-layers)))
(should layers)
(should (= (length layers) 1))
(should (eq (plist-get (car layers) 'tp-name) 'my-group-second)))))
(ert-deftest tp-test-match-set-with-group-name ()
"Test tp-match-set accepts a group name."
@ -2186,7 +2220,9 @@ Returns list of (START END VALUE) intervals."
("style" . (face italic)))
(tp-match-set "Hello" 'my-group)
(should (eq (tp-at 1 'face) 'italic))
(should (eq (tp-at 13 'face) 'italic))))
(should (eq (tp-at 13 'face) 'italic))
;; tp-name should be preserved
(should (eq (tp-at 1 'tp-name) 'my-group-style))))
(ert-deftest tp-test-resolve-props-returns-nil-for-unknown ()
"Test tp--resolve-props returns nil for unknown layer name."

28
tp.el
View File

@ -1953,37 +1953,33 @@ Appends 'tp-name property to identify the layer."
layers)))
(defun tp--resolve-props (props)
"Resolve PROPS to a property list.
"Resolve PROPS to a property list with layer metadata.
PROPS can be:
- A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups')
- A plist (returned as-is)
If PROPS is a symbol:
- First checks `tp-layer-alist' and returns the layer properties
- Then checks `tp-layer-groups' and returns the first layer's properties
- First checks `tp-layer-alist' and returns the layer properties WITH `tp-name'
- Then checks `tp-layer-groups' and returns properties WITH `tp-layers'
Returns nil if PROPS is a symbol but no matching layer/group is found,
or if the group's first layer doesn't exist in `tp-layer-alist'.
Returns nil if PROPS is a symbol but no matching layer/group is found.
Unlike `tp-layer-props', this does NOT add the `tp-name' property,
making it suitable for use with basic property-setting APIs like
`tp-set', `tp-add', `tp-match-set', etc."
For layer names, includes `tp-name' property for reactive text property support.
For group names, includes `tp-layers' property with the full layer stack."
(cond
;; Already a plist - return as-is
((listp props) props)
;; Symbol - check if it's a layer or group name
((symbolp props)
(cond
;; Check layer first
;; Check layer first - use tp-layer-props which adds tp-name
((assoc props tp-layer-alist)
(cdr (assoc props tp-layer-alist)))
;; Check group (use first layer's properties)
(tp-layer-props props))
;; Check group - build layer stack with tp-layers
((assoc props tp-layer-groups)
(when-let* ((layers (cdr (assoc props tp-layer-groups)))
(first-layer (car layers))
;; Ensure the first layer exists in tp-layer-alist
(layer-entry (assoc first-layer tp-layer-alist)))
(cdr layer-entry)))
(when-let ((layer-props-list (tp-group-props props)))
;; Build the layer stack: first layer on top, rest in tp-layers
(tp--build-layer-props layer-props-list)))
;; Not found - return nil (let caller decide how to handle)
(t nil)))
(t nil)))