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

Add automatic property merging for duplicate keys in single call

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2026-01-01 16:49:16 +00:00
parent adb56bd01d
commit 04feef0433
4 changed files with 350 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
README.md
View File

@ -183,6 +183,28 @@ Native APIs only have simple set and get. tp.el provides three clear operation s
```
- ✅ **Deep Merge**: `tp-add` recursively merges nested plist structures
- ✅ **Smart Face Merging**: Symbol faces are automatically prepended to face lists, plist faces are deep merged
- ✅ **Automatic Duplicate Property Merging in Single Call**: When the same property (e.g., `face`) is specified multiple times in a single `tp-set`/`tp-add`/`tp-reset` call, they are automatically merged
```elisp
;; Merge multiple faces in a single call
(tp-set "emacs"
'face 'bold
'face '(:background "green")
'face '(:foreground "red"))
;; Result: face is ((:background "green" :foreground "red") bold)
;; Later values override earlier ones for the same sub-property
(tp-set "emacs"
'face '(:foreground "red")
'face '(:foreground "yellow"))
;; Result: foreground is "yellow"
;; Use with tp-palette layer
(tp-set "emacs"
'tp-palette 'info
'face '(:foreground "red"))
;; Result: tp-palette's face is merged with (:foreground "red")
```
### Innovative Property Layer System
@ -471,6 +493,25 @@ LAYER-NAME can be a symbol representing a layer defined by `tp-define-layer` or
:data ((my-color . "blue")))
(tp-set " " 'my-style)
;; => #(" " 0 1 (tp-name my-style face (:foreground "blue") ...))
;; Merge multiple faces in a single call (duplicate properties auto-merged)
(tp-set "emacs"
'face 'bold
'face '(:background "green")
'face '(:foreground "red"))
;; => Three faces merged into one: ((:background "green" :foreground "red") bold)
;; Later values override earlier ones for the same sub-property
(tp-set "emacs"
'face '(:foreground "red")
'face '(:foreground "yellow"))
;; => face's :foreground is "yellow" (later overrides earlier)
;; Use with tp-palette layer, merging extra face properties
(tp-set "emacs"
'tp-palette 'info
'face '(:foreground "red"))
;; => tp-palette's face is merged with (:foreground "red"), :foreground is overridden
```
---

41
README_CN.md
View File

@ -182,6 +182,28 @@
```
- ✅ **深度合并**：`tp-add` 递归合并嵌套的 plist 结构
- ✅ **Face 智能合并**：符号 face 自动前置到 face 列表，plist face 深度合并
- ✅ **单次设置中的重复属性自动合并**：在一次 `tp-set`/`tp-add`/`tp-reset` 调用中，如果同一属性（如 `face`）被指定多次，它们会自动合并
```elisp
;; 单次调用中合并多个 face
(tp-set "emacs"
'face 'bold
'face '(:background "green")
'face '(:foreground "red"))
;; 结果: face 是 ((:background "green" :foreground "red") bold)
;; 同一子属性后面的覆盖前面的
(tp-set "emacs"
'face '(:foreground "red")
'face '(:foreground "yellow"))
;; 结果: foreground 是 "yellow"
;; 与 tp-palette 层配合使用
(tp-set "emacs"
'tp-palette 'info
'face '(:foreground "red"))
;; 结果: tp-palette 的 face 与 (:foreground "red") 合并
```
### 创新的属性层系统
@ -462,6 +484,25 @@ LAYER-NAME 可以是通过 `tp-define-layer` 定义的层名称或通过 `tp-def
:data '((my-color . "blue")))
(tp-set " " 'my-style)
;; => #(" " 0 1 (tp-name my-style face (:foreground "blue") ...))
;; 单次调用中合并多个 face（重复属性自动合并）
(tp-set "emacs"
'face 'bold
'face '(:background "green")
'face '(:foreground "red"))
;; => 三个 face 合并为一个: ((:background "green" :foreground "red") bold)
;; 同一子属性后面的值覆盖前面的
(tp-set "emacs"
'face '(:foreground "red")
'face '(:foreground "yellow"))
;; => face 的 :foreground 是 "yellow"（后面的覆盖前面的）
;; 与 tp-palette 层配合使用，合并额外的 face 属性
(tp-set "emacs"
'tp-palette 'info
'face '(:foreground "red"))
;; => tp-palette 的 face 与 (:foreground "red") 合并，:foreground 被覆盖
```
---

158
tp-tests.el
View File

@ -3702,5 +3702,163 @@ internally, and the final result should have face properties, not tp-palette."
(should (null (get-text-property 0 'tp-test-level1 result)))
(should (null (get-text-property 0 'tp-test-level2 result))))))
;;; ============================================================
;;; Duplicate Property Merging Tests
;;; ============================================================
(ert-deftest tp-test-merge-duplicate-face-symbols ()
"Test that multiple face symbols in one call are merged into a face list."
(tp-test-with-temp-buffer
(let ((result (tp-set "emacs"
'face 'bold
'face 'italic)))
;; Should be a list with italic first (later takes precedence)
(let ((face-prop (get-text-property 0 'face result)))
(should (listp face-prop))
(should (memq 'bold face-prop))
(should (memq 'italic face-prop))
;; italic should come before bold (later value takes precedence)
(should (< (cl-position 'italic face-prop)
(cl-position 'bold face-prop)))))))
(ert-deftest tp-test-merge-duplicate-face-plists ()
"Test that multiple face plists in one call are merged."
(tp-test-with-temp-buffer
(let ((result (tp-set "emacs"
'face '(:background "green")
'face '(:foreground "red"))))
(let ((face-prop (get-text-property 0 'face result)))
;; Should be a merged plist
(should (plist-get face-prop :background))
(should (plist-get face-prop :foreground))
(should (equal (plist-get face-prop :background) "green"))
(should (equal (plist-get face-prop :foreground) "red"))))))
(ert-deftest tp-test-merge-duplicate-face-later-overrides ()
"Test that later face plist values override earlier ones for same key."
(tp-test-with-temp-buffer
(let ((result (tp-set "emacs"
'face '(:foreground "red")
'face '(:foreground "yellow"))))
(let ((face-prop (get-text-property 0 'face result)))
;; Later value should override
(should (equal (plist-get face-prop :foreground) "yellow"))))))
(ert-deftest tp-test-merge-face-symbol-and-plist ()
"Test merging face symbol with face plist."
(tp-test-with-temp-buffer
(let ((result (tp-set "emacs"
'face 'bold
'face '(:background "green")
'face '(:foreground "red"))))
(let ((face-prop (get-text-property 0 'face result)))
;; Should be a list with plist and symbol
(should (listp face-prop))
;; First element should be the merged plist (plists merge together)
(should (listp (car face-prop)))
(should (keywordp (caar face-prop)))
;; Check the merged plist has both properties
(let ((merged-plist (car face-prop)))
(should (equal (plist-get merged-plist :background) "green"))
(should (equal (plist-get merged-plist :foreground) "red")))
;; bold should be in the list
(should (memq 'bold face-prop))))))
(ert-deftest tp-test-merge-other-props-later-overrides ()
"Test that non-face duplicate properties use later value."
(tp-test-with-temp-buffer
(let ((result (tp-set "emacs"
'help-echo "first"
'help-echo "second")))
(should (equal (get-text-property 0 'help-echo result) "second")))))
(ert-deftest tp-test-merge-with-palette-layer ()
"Test merging face from tp-palette layer with extra face property."
(tp-test-with-temp-buffer
;; Redefine tp-palette since tp-test-with-temp-buffer resets tp-layer-alist
(define-tp tp-palette (symbol)
(let ((palette (intern (concat "tp-palette-"
(symbol-name symbol)))))
`(face ( :foreground ,(tp-palette-fg-color palette)
:background ,(tp-palette-bg-color palette)
:box (:color ,(tp-palette-border-color palette))))))
(let ((result (tp-set "emacs"
'tp-palette 'info
'face '(:foreground "red"))))
(let ((face-prop (get-text-property 0 'face result)))
;; The face from tp-palette should be merged with :foreground "red"
;; With :foreground "red" overriding the palette's foreground
(should (equal (plist-get face-prop :foreground) "red"))
;; Background from palette should still be present
(should (plist-get face-prop :background))
;; Box from palette should still be present
(should (plist-get face-prop :box))))))
(ert-deftest tp-test-merge-multiple-layers-with-face ()
"Test merging multiple layers that each contribute face properties."
(tp-test-with-temp-buffer
(define-tp tp-test-layer1 ()
'(face (:foreground "blue")))
(define-tp tp-test-layer2 ()
'(face (:background "yellow")))
(let ((result (tp-set "emacs"
'tp-test-layer1 t
'tp-test-layer2 t
'face '(:weight bold))))
(let ((face-prop (get-text-property 0 'face result)))
;; All face properties should be merged
(should (equal (plist-get face-prop :foreground) "blue"))
(should (equal (plist-get face-prop :background) "yellow"))
(should (equal (plist-get face-prop :weight) 'bold))))))
(ert-deftest tp-test-merge-in-region-form ()
"Test duplicate property merging in region form."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-set 1 6 '(face bold face (:foreground "green")))
(let ((face-prop (tp-at 1 'face)))
;; Should be a list with plist and symbol
(should (listp face-prop))
;; Check properties
(should (or (memq 'bold face-prop)
(eq face-prop 'bold))))))
(ert-deftest tp-test-tp-add-merge-faces ()
"Test that tp-add also merges duplicate face properties."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-add 1 6 '(face bold face (:foreground "red")))
(let ((face-prop (tp-at 1 'face)))
;; Should have both face values merged
(should (listp face-prop))
(should (memq 'bold face-prop))
;; Check for the plist part with :foreground
(should (cl-some (lambda (f)
(and (listp f)
(keywordp (car f))
(equal (plist-get f :foreground) "red")))
face-prop)))))
(ert-deftest tp-test-tp-reset-merge-faces ()
"Test that tp-reset also merges duplicate face properties."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-reset 1 6 '(face bold face (:foreground "red")))
(let ((face-prop (tp-at 1 'face)))
;; Should have both face values merged
(should (listp face-prop))
(should (memq 'bold face-prop)))))
(ert-deftest tp-test-merge-mouse-face ()
"Test that mouse-face properties are also merged."
(tp-test-with-temp-buffer
(let ((result (tp-set "emacs"
'mouse-face 'highlight
'mouse-face '(:background "blue"))))
(let ((mouse-face-prop (get-text-property 0 'mouse-face result)))
;; Should be a list with plist and symbol
(should (listp mouse-face-prop))
(should (memq 'highlight mouse-face-prop))))))
(provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here

111
tp.el
View File

@ -244,6 +244,106 @@ NEW values override BASE values."
(t val))))))
result))
(defun tp--merge-face-values (face1 face2)
"Merge two face values into one.
FACE1 is the earlier value, FACE2 is the later value.
For face plists (like (:foreground \"red\")), merge with later overriding.
For symbol faces, create a list with FACE2 taking precedence.
Returns the merged face value."
(cond
;; No earlier face - just use later face
((null face1) face2)
;; No later face - just use earlier face
((null face2) face1)
;; Both are plists - merge with later overriding earlier
((and (listp face1) (keywordp (car-safe face1))
(listp face2) (keywordp (car-safe face2)))
(tp--deep-merge-plist face1 face2))
;; Later is a plist, earlier is a symbol or list of faces
((and (listp face2) (keywordp (car-safe face2)))
(cond
((symbolp face1)
(list face2 face1))
((listp face1)
(cons face2 face1))
(t face2)))
;; Earlier is a plist, later is a symbol
((and (listp face1) (keywordp (car-safe face1))
(symbolp face2))
(list face2 face1))
;; Later is a symbol - prepend to earlier
((symbolp face2)
(cond
((symbolp face1)
(if (eq face1 face2)
face2
(list face2 face1)))
((listp face1)
(if (member face2 face1)
(cons face2 (remove face2 face1)) ; Move to front
(cons face2 face1)))
(t face2)))
;; Later is a list of faces - prepend to earlier
((listp face2)
(cond
((symbolp face1)
(if (member face1 face2)
face2
(append face2 (list face1))))
((listp face1)
(append face2
(cl-remove-if (lambda (f) (member f face2)) face1)))
(t face2)))
(t face2)))
(defun tp--merge-duplicate-keys (plist)
"Merge duplicate keys in PLIST into a single key-value pair.
For `face' and `font-lock-face' properties, values are merged so that
later values take precedence over earlier ones for the same sub-properties.
For other properties, later values override earlier ones.
This function is designed for single-call property setting where multiple
properties of the same type can be specified and should be merged.
Example:
(tp--merge-duplicate-keys \\='(face bold face (:foreground \"red\")))
=> (face ((:foreground \"red\") bold))
(tp--merge-duplicate-keys \\='(face (:background \"blue\") face (:foreground \"red\")))
=> (face (:background \"blue\" :foreground \"red\"))
(tp--merge-duplicate-keys \\='(prop1 a prop2 b prop1 c))
=> (prop1 c prop2 b)"
(let ((key-values (make-hash-table :test 'eq))
(key-order nil))
;; Collect all values for each key in order
(cl-loop for (key val) on plist by #'cddr
do (progn
(unless (gethash key key-values)
(push key key-order))
(puthash key
(cons val (gethash key key-values))
key-values)))
;; Reverse key-order to get original order
(setq key-order (nreverse key-order))
;; Build result plist by merging values for each key
(let ((result nil))
(dolist (key key-order)
(let ((values (nreverse (gethash key key-values)))) ; Reverse to get original order
(if (= (length values) 1)
;; Single value - use as-is
(setq result (append result (list key (car values))))
;; Multiple values - merge them
(let ((merged-val
(cond
;; Face properties - use special face merging
((memq key '(face font-lock-face mouse-face))
(cl-reduce #'tp--merge-face-values values))
;; Other properties - later overrides earlier
(t (car (last values))))))
(setq result (append result (list key merged-val)))))))
result)))
(defun tp--get-nested (value path)
"Get nested value from VALUE following PATH (list of keys).
Supports plists, alists, and list-of-keys extraction."
@ -964,6 +1064,11 @@ Supports multiple calling conventions:
;; Unwrap double-wrapped properties
(when (and (listp props) (listp (car-safe props)))
(setq props (car props)))
;; Merge duplicate keys in the plist (for single-call property setting)
;; This must happen before tp--resolve-props to properly handle face merging
;; Use (cddr props) for O(1) check instead of (> (length props) 2)
(when (and (listp props) (cddr props))
(setq props (tp--merge-duplicate-keys props)))
;; Resolve props: handles layer/group names and anonymous reactive plists
(when props
(setq props (or (tp--resolve-props props) props)))
@ -2762,7 +2867,11 @@ Returns the expanded plist."
(t
(setq result (append result (list key val)))))
(setq remaining (cddr remaining))))
result))
;; Merge duplicate keys in the expanded result
;; Use (cddr result) for O(1) check instead of (> (length result) 2)
(if (cddr result)
(tp--merge-duplicate-keys result)
result)))
(defun tp--resolve-props (props)
"Resolve PROPS to a property list with layer metadata.