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

Fix tp-add to override embedded face sub-properties with new values

Browse Source 
When tp-add merges face properties, new props values should now
override embedded values for the same sub-properties (e.g., if
new face has :foreground "green" and embedded has :foreground "red",
result should be :foreground "green").

Updated tp--merge-string-props-into-plist to pass props as the
override value when merging faces.

Updated tp--merge-face-values to properly handle mixed face lists
(symbols + plists) when the base face is a plist.

Added test tp-test-tp-add-face-override-subprops to verify this behavior.

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2026-01-05 18:31:06 +00:00
parent c1210185e1
commit a140fd8b45
2 changed files with 56 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
tp-tests.el
View File

@ -3165,6 +3165,32 @@ the inserted text should be that string, not the source text."
(equal (plist-get f :foreground) "red")))
face-val)))))))
(ert-deftest tp-test-tp-add-face-override-subprops ()
"Test that tp-add with tp-text overrides same face sub-properties."
;; When new props have same sub-property as embedded, new value should override
;; Example: new (:foreground "green") should override embedded (:foreground "red")
(let ((result (tp-add "emacs" 'face '(:foreground "green")
'tp-text (propertize "vim" 'face '(:foreground "red")))))
(should (equal result "vim"))
;; Face should be (:foreground "green") - new overrides old
(let ((face-val (tp-at 0 'face result)))
(should (equal face-val '(:foreground "green")))))
;; More complex case: new (bold (:foreground "green")) with embedded (:foreground "red")
(let ((result (tp-add "emacs" 'face '(bold (:foreground "green"))
'tp-text (propertize "vim" 'face '(:foreground "red")))))
(should (equal result "vim"))
;; Face should be (bold (:foreground "green")) - new overrides old
(let ((face-val (tp-at 0 'face result)))
(should (member 'bold (if (listp face-val) face-val (list face-val))))
;; Should have green, not red
(should (cl-some (lambda (f)
(and (listp f)
(keywordp (car-safe f))
(equal (plist-get f :foreground) "green")))
(if (and (listp face-val) (not (keywordp (car-safe face-val))))
face-val
(list face-val)))))))
;;; ============================================================
;;; New define-tp Format Tests (Parameterized and Non-Parameterized)
;;; ============================================================

40
tp.el
View File

@ -260,24 +260,30 @@ Scans the entire string, not just position 0."
(defun tp--merge-string-props-into-plist (str props)
"Merge text properties from string STR into PROPS plist.
Properties from STR are merged with proper face handling using
`tp--merge-face-values'. Returns the merged plist.
Properties from PROPS take precedence over those in STR.
Returns the merged plist where new props override embedded props.
For simplicity, only considers properties at position 0 of STR."
(if (not (tp--string-has-properties-p str))
props
(let ((str-props (text-properties-at 0 str))
(result (copy-sequence props)))
;; Merge each property from the string into result
;; Props values take precedence over embedded string values
(cl-loop for (key val) on str-props by #'cddr
do (let ((existing (plist-get result key)))
(setq result
(plist-put result key
(cond
;; Face properties need special merging
((memq key '(face font-lock-face mouse-face))
(tp--merge-face-values existing val))
;; Other properties - string value takes precedence
(t val))))))
(if existing
;; Props already has this key - merge with props taking precedence
(setq result
(plist-put result key
(cond
;; Face properties need special merging
;; Pass embedded val as face1 (base), existing as face2 (override)
((memq key '(face font-lock-face mouse-face))
(tp--merge-face-values val existing))
;; Other properties - props value takes precedence
(t existing))))
;; Props doesn't have this key - add from string
(setq result (plist-put result key val)))))
result)))
(defun tp--merge-face-values (face1 face2)
@ -326,6 +332,20 @@ Returns the merged face value."
(if (member face1 face2)
face2
(append face2 (list face1))))
;; face1 is a plist - need to merge any plist in face2 with face1
((and (listp face1) (keywordp (car-safe face1)))
;; Extract plist and symbols from face2
(let ((symbols nil)
(plist nil))
(dolist (f face2)
(if (and (listp f) (keywordp (car-safe f)))
(setq plist (if plist (tp--deep-merge-plist plist f) f))
(push f symbols)))
;; Merge face2's plist with face1, then prepend symbols
(let ((merged-plist (if plist (tp--deep-merge-plist face1 plist) face1)))
(if symbols
(append (nreverse symbols) (list merged-plist))
merged-plist))))
((listp face1)
(append face2
(cl-remove-if (lambda (f) (member f face2)) face1)))