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

Fix face sub-property merging in tp-add and tp--merge-face-values

Browse Source 
When face values contain mixed lists (symbols and plists like
(bold (:foreground "green"))), the plist parts are now correctly
merged with earlier plists. This ensures that later values for
the same sub-property (like :foreground) properly override earlier
values without creating duplicates.

Example that now works correctly:
(tp-add
  (tp-add
    (tp-set "emacs" 'face 'bold)
    'face '(:foreground "red"))
  'face '(bold (:foreground "green")))
=> face is (bold (:foreground "green")) instead of
   (bold (:foreground "green") (:foreground "red"))

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2026-01-05 19:29:59 +00:00
parent 39bbd6b431
commit 3e5773c2a2
2 changed files with 80 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
tp-tests.el
View File

@ -1160,6 +1160,31 @@ Returns list of (START END VALUE) intervals."
(should (eq (plist-get face :weight) 'bold))
(should (equal (plist-get face :background) "blue")))))
(ert-deftest tp-test-add-face-subprop-override ()
"Test tp-add correctly merges face sub-properties.
Later values should override earlier values for the same sub-property."
;; The original issue: (tp-add (tp-add (tp-set \"emacs\" 'face 'bold)
;; 'face '(:foreground \"red\")) 'face '(bold (:foreground \"green\")))
;; should result in :foreground \"green\", not both \"red\" and \"green\"
(let* ((base (tp-set "emacs" 'face 'bold))
(with-red (tp-add base 'face '(:foreground "red")))
(with-green (tp-add with-red 'face '(bold (:foreground "green")))))
;; Final result should have only one :foreground which is "green"
(let ((face3 (get-text-property 0 'face with-green)))
(should (listp face3))
(should (member 'bold face3))
;; Extract the plist part
(let ((plist-part (cl-find-if (lambda (f)
(and (listp f) (keywordp (car-safe f))))
face3)))
(should plist-part)
(should (equal (plist-get plist-part :foreground) "green"))
;; Ensure there's no duplicate :foreground
(let ((plist-count (cl-count-if (lambda (f)
(and (listp f) (keywordp (car-safe f))))
face3)))
(should (= plist-count 1)))))))
(ert-deftest tp-test-add-on-string ()
"Test tp-add on string."
(let ((str (copy-sequence "Hello")))

61
tp.el
View File

@ -388,9 +388,27 @@ Returns the merged face value."
(if symbols
(append symbols (list merged-plist))
merged-plist))))
;; Both are lists - parse both, merge plists, combine symbols
((listp face1)
(append face2
(cl-remove-if (lambda (f) (member f face2)) face1)))
(let* ((parsed1 (tp--parse-face-list face1))
(symbols1 (car parsed1))
(plist1 (cdr parsed1))
(parsed2 (tp--parse-face-list face2))
(symbols2 (car parsed2))
(plist2 (cdr parsed2))
;; Merge plists with face2's plist taking precedence
(merged-plist (cond
((and plist1 plist2) (tp--deep-merge-plist plist1 plist2))
(plist2 plist2)
(plist1 plist1)
(t nil)))
;; Combine symbols: face2 symbols first, then face1 symbols not in face2
(merged-symbols (append symbols2
(cl-remove-if (lambda (s) (member s symbols2)) symbols1))))
;; Build result: symbols first, then merged plist if any
(if merged-plist
(append merged-symbols (list merged-plist))
merged-symbols)))
(t face2)))
(t face2)))
@ -1264,6 +1282,7 @@ Examples:
If NEW-FACE is a plist (like (:foreground \"red\")), deeply merge it.
If NEW-FACE is a symbol or list of faces, prepend it to create a face list.
For mixed lists containing both symbols and plists, plists are merged correctly.
Duplicate faces are not added."
(cond
;; No existing face - just use new face
@ -1277,7 +1296,17 @@ Duplicate faces are not added."
((symbolp existing-face)
(list new-face existing-face))
((listp existing-face)
(cons new-face existing-face))
;; Parse existing to extract any plists and merge them
(let* ((parsed (tp--parse-face-list existing-face))
(existing-symbols (car parsed))
(existing-plist (cdr parsed)))
(if existing-plist
;; Merge new-face plist with existing plist, prepend symbols
(let ((merged-plist (tp--deep-merge-plist existing-plist new-face)))
(if existing-symbols
(append existing-symbols (list merged-plist))
merged-plist))
(cons new-face existing-face))))
(t new-face)))
;; New face is a symbol - prepend to existing
((symbolp new-face)
@ -1291,7 +1320,7 @@ Duplicate faces are not added."
existing-face
(cons new-face existing-face)))
(t new-face)))
;; New face is a list of faces - prepend to existing
;; New face is a list of faces - parse and merge with existing
((listp new-face)
(cond
((symbolp existing-face)
@ -1299,8 +1328,28 @@ Duplicate faces are not added."
new-face
(append new-face (list existing-face))))
((listp existing-face)
(append new-face
(cl-remove-if (lambda (f) (member f new-face)) existing-face)))
;; Parse both to extract symbols and plists, then merge appropriately
(let* ((parsed-new (tp--parse-face-list new-face))
(new-symbols (car parsed-new))
(new-plist (cdr parsed-new))
(parsed-existing (tp--parse-face-list existing-face))
(existing-symbols (car parsed-existing))
(existing-plist (cdr parsed-existing))
;; Merge plists with new taking precedence
(merged-plist (cond
((and existing-plist new-plist)
(tp--deep-merge-plist existing-plist new-plist))
(new-plist new-plist)
(existing-plist existing-plist)
(t nil)))
;; Combine symbols: new symbols first, then existing symbols not in new
(merged-symbols (append new-symbols
(cl-remove-if (lambda (s) (member s new-symbols))
existing-symbols))))
;; Build result: symbols first, then merged plist if any
(if merged-plist
(append merged-symbols (list merged-plist))
merged-symbols)))
(t new-face)))
(t new-face)))