Fix: Use propertize directly to preserve text property intervals

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2026-01-07 03:23:08 +00:00
parent fe0594c575
commit 6392be848e
2 changed files with 51 additions and 46 deletions

View File

@ -4057,6 +4057,28 @@ Regression test for: (tp-set \"emacs\" 'face nil) erroring with
;;; Non-Destructive String Modification Tests
;;; ============================================================
(ert-deftest tp-test-set-preserves-text-property-intervals ()
"Test that tp-set preserves text property intervals when adding new properties.
When a string has different properties at different positions, adding a new
property should preserve the original interval structure."
(let ((original #(" button " 0 1 (display (space :width (4)))
7 8 (display (space :width (4))))))
(let ((result (tp-set original 'face '(:foreground "red"))))
;; Result should be a new string with properties
(should (stringp result))
;; Result should NOT be the same object as original
(should (not (eq original result)))
;; Original should NOT be modified
(should (null (get-text-property 0 'face original)))
;; Result should have face property everywhere
(should (equal (get-text-property 0 'face result) '(:foreground "red")))
(should (equal (get-text-property 4 'face result) '(:foreground "red")))
(should (equal (get-text-property 7 'face result) '(:foreground "red")))
;; Result should preserve display property at original positions
(should (equal (get-text-property 0 'display result) '(space :width (4))))
(should (null (get-text-property 2 'display result))) ;; No display at position 2
(should (equal (get-text-property 7 'display result) '(space :width (4)))))))
(ert-deftest tp-test-set-does-not-modify-original-string ()
"Test that tp-set returns a new string and does not modify the original."
(let ((original "Hello"))

75
tp.el
View File

@ -1316,6 +1316,7 @@ Supports multiple calling conventions:
(defun tp--apply-props-to-string (str start end props &optional merge-mode)
"Apply PROPS to string STR from START to END, returning a NEW string.
This function does not modify the original string.
Preserves the original text property intervals by using `propertize'.
MERGE-MODE controls how properties are applied:
nil or :set - Set properties, preserving existing unspecified ones
@ -1326,52 +1327,34 @@ Returns a new propertized string."
(let* ((len (length str))
;; Ensure bounds are valid
(start (max 0 start))
(end (min end len))
;; Build the result string piece by piece
(before (when (> start 0)
(substring str 0 start)))
(middle-text (substring-no-properties str start end))
(after (when (< end len)
(substring str end len)))
;; Get existing properties for the middle section
(existing-props (when (not (eq merge-mode :reset))
(text-properties-at start str)))
;; Calculate final properties for the middle section
(final-props
(cond
;; :reset - use only new props
((eq merge-mode :reset)
props)
;; :add - deep merge with face prepending
((eq merge-mode :add)
(let ((result existing-props))
(cl-loop
for (key val) on props by #'cddr
do (let* ((current-val (plist-get result key))
(new-val (cond
((eq key 'face) (tp--prepend-face val current-val))
((and (listp val) (keywordp (car-safe val))
(listp current-val) (keywordp (car-safe current-val)))
(tp--deep-merge-plist current-val val))
(t val))))
(setq result (plist-put result key new-val))))
result))
;; nil/:set - set properties, preserving unspecified ones
(t
;; Build a new plist by iterating through existing props and overriding with new props
(let ((result nil))
;; First add all props from new props
(cl-loop for (key val) on props by #'cddr
do (setq result (plist-put result key val)))
;; Then add existing props that are not in new props
(cl-loop for (key val) on existing-props by #'cddr
unless (plist-member props key)
do (setq result (plist-put result key val)))
result))))
;; Create the middle section with properties using propertize
(middle-propertized (apply #'propertize middle-text final-props)))
;; Concatenate the parts
(concat before middle-propertized after)))
(end (min end len)))
(cond
;; :reset - completely replace properties in the range
((eq merge-mode :reset)
(let ((result (copy-sequence str)))
(set-text-properties start end props result)
result))
;; :add - deep merge with face prepending
((eq merge-mode :add)
(let ((result (copy-sequence str)))
(cl-loop
for (key val) on props by #'cddr
do (let ((pos start))
(while (< pos end)
(let* ((current-val (get-text-property pos key result))
(new-val (cond
((eq key 'face) (tp--prepend-face val current-val))
((and (listp val) (keywordp (car-safe val))
(listp current-val) (keywordp (car-safe current-val)))
(tp--deep-merge-plist current-val val))
(t val)))
(next-change (or (next-single-property-change pos key result end) end)))
(put-text-property pos next-change key new-val result)
(setq pos next-change)))))
result))
;; nil/:set - use propertize which creates a new copy and preserves existing properties
(t
(apply #'propertize str props)))))
;;;============================================================================
;;; Layer 2: Core Property Functions - Set/Reset/Add