Fix: Use propertize directly to preserve text property intervals
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
parent
fe0594c575
commit
6392be848e
22
tp-tests.el
22
tp-tests.el
@ -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
75
tp.el
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user