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

Support text properties within tp-text values

Browse Source 
- Modify tp--handle-tp-text-property to detect and preserve embedded text
  properties in tp-text values for both strings and buffers
- Add tp--apply-string-props-to-region helper to apply string properties
- Update tp-set, tp-reset, tp-add to preserve embedded tp-text properties
  by using put-text-property instead of set-text-properties when needed
- Update tp--replace-reactive-text-in-buffer to preserve embedded properties
- Add tests for tp-text with embedded text properties

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2026-01-05 17:27:01 +00:00
parent 2df9f3f323
commit 933acf0292
2 changed files with 182 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
tp-tests.el
View File

@ -3038,6 +3038,92 @@ the inserted text should be that string, not the source text."
(ignore-errors (makunbound 'tp-test-name-part2))
(ignore-errors (makunbound 'tp-test-full-text)))))
;;; ============================================================
;;; tp-text with Embedded Text Properties Tests
;;; ============================================================
(ert-deftest tp-test-tp-text-with-embedded-properties-string ()
"Test that tp-text with embedded text properties preserves them on strings."
;; When tp-text is a propertized string, the embedded properties should be preserved
(let* ((propertized-text (copy-sequence "Hello"))
(_ (put-text-property 0 5 'custom-prop 'embedded-value propertized-text))
(result (tp-set "X" 'tp-text propertized-text 'face 'bold)))
;; The text content should be from tp-text
(should (equal result "Hello"))
;; The face property from props should be applied
(should (equal (tp-at 0 'face result) 'bold))
;; The embedded custom-prop from tp-text should be preserved
(should (equal (tp-at 0 'custom-prop result) 'embedded-value))))
(ert-deftest tp-test-tp-text-with-embedded-face-string ()
"Test that tp-text with embedded face property preserves it on strings."
(let* ((propertized-text (copy-sequence "Hello"))
(_ (put-text-property 0 5 'face 'italic propertized-text))
;; Set tp-text with its own face, and also specify a layer face
(result (tp-set "X" 'tp-text propertized-text 'help-echo "tip")))
;; The text content should be from tp-text
(should (equal result "Hello"))
;; The face from tp-text should be preserved
(should (equal (tp-at 0 'face result) 'italic))
;; The help-echo from props should be applied
(should (equal (tp-at 0 'help-echo result) "tip"))))
(ert-deftest tp-test-tp-text-with-embedded-properties-buffer ()
"Test that tp-text with embedded text properties preserves them in buffers."
(tp-test-with-temp-buffer
(insert "Original")
(let* ((propertized-text (copy-sequence "New"))
(_ (put-text-property 0 3 'custom-prop 'embedded-value propertized-text)))
(tp-set 1 9 `(face bold tp-text ,propertized-text))
;; The text content should be replaced with tp-text value
(should (equal (buffer-substring-no-properties 1 4) "New"))
;; The face from props should be applied
(should (equal (tp-at 1 'face) 'bold))
;; The embedded custom-prop from tp-text should be preserved
(should (equal (tp-at 1 'custom-prop) 'embedded-value)))))
(ert-deftest tp-test-tp-text-with-mixed-interval-properties ()
"Test that tp-text with different properties at different positions preserves them."
(let* ((propertized-text (copy-sequence "ABCD"))
;; Set different properties at different positions
(_ (put-text-property 0 2 'region-type 'start propertized-text))
(_ (put-text-property 2 4 'region-type 'end propertized-text))
(result (tp-set "X" 'tp-text propertized-text 'face 'bold)))
;; The text content should be from tp-text
(should (equal result "ABCD"))
;; The face from props should be applied uniformly
(should (equal (tp-at 0 'face result) 'bold))
(should (equal (tp-at 3 'face result) 'bold))
;; The embedded properties at different positions should be preserved
(should (equal (tp-at 0 'region-type result) 'start))
(should (equal (tp-at 1 'region-type result) 'start))
(should (equal (tp-at 2 'region-type result) 'end))
(should (equal (tp-at 3 'region-type result) 'end))))
(ert-deftest tp-test-tp-reset-with-embedded-properties ()
"Test that tp-reset with embedded text properties preserves them."
(let* ((propertized-text (copy-sequence "Test"))
(_ (put-text-property 0 4 'custom-prop 'value propertized-text))
(result (tp-reset "X" 'tp-text propertized-text 'face 'bold)))
;; The text content should be from tp-text
(should (equal result "Test"))
;; The face from props should be applied
(should (equal (tp-at 0 'face result) 'bold))
;; The embedded custom-prop from tp-text should be preserved
(should (equal (tp-at 0 'custom-prop result) 'value))))
(ert-deftest tp-test-tp-add-with-embedded-properties ()
"Test that tp-add with embedded text properties preserves them."
(let* ((propertized-text (copy-sequence "Test"))
(_ (put-text-property 0 4 'custom-prop 'value propertized-text))
(result (tp-add "X" 'tp-text propertized-text 'face 'bold)))
;; The text content should be from tp-text
(should (equal result "Test"))
;; The face from props should be applied
(should (equal (tp-at 0 'face result) 'bold))
;; The embedded custom-prop from tp-text should be preserved
(should (equal (tp-at 0 'custom-prop result) 'value))))
;;; ============================================================
;;; New define-tp Format Tests (Parameterized and Non-Parameterized)
;;; ============================================================

123
tp.el
View File

@ -252,6 +252,23 @@ NEW values override BASE values."
(t val))))))
result))
(defun tp--apply-string-props-to-region (str start &optional object)
"Apply text properties from string STR to buffer region starting at START.
For each character position in STR, its text properties are applied to
the corresponding position in the buffer/object starting at START.
This preserves the per-character text property variations in STR."
(let ((len (length str))
(pos 0))
(while (< pos len)
(let* ((props (text-properties-at pos str))
(next-change (or (next-property-change pos str len) len)))
(when props
(cl-loop for (key val) on props by #'cddr
do (put-text-property
(+ start pos) (+ start next-change)
key val object)))
(setq pos next-change)))))
(defun tp--merge-face-values (face1 face2)
"Merge two face values into one.
FACE1 is the earlier value, FACE2 is the later value.
@ -907,22 +924,32 @@ it will be applied to the text before updating."
(defun tp--replace-reactive-text-in-buffer (layer-name new-text props)
"Replace text in current buffer for reactive text with LAYER-NAME.
NEW-TEXT is the new text to replace with.
PROPS are the properties to apply to the new text."
PROPS are the properties to apply to the new text.
Text properties embedded in NEW-TEXT are preserved."
(goto-char (point-min))
(let ((match (text-property-search-forward 'tp-name layer-name t)))
(let ((match (text-property-search-forward 'tp-name layer-name t))
;; Check if new-text has embedded text properties
(new-text-has-props (and (stringp new-text)
(text-properties-at 0 new-text))))
(while match
(let* ((m-start (prop-match-beginning match))
(m-end (prop-match-end match))
(old-text (buffer-substring-no-properties m-start m-end)))
;; Only replace if text is different
(unless (equal old-text new-text)
;; Only replace if text content is different
(unless (equal old-text (substring-no-properties new-text))
;; Delete old text and insert new
(delete-region m-start m-end)
(goto-char m-start)
(insert new-text)
;; Apply the layer properties (including tp-text and tp-name) to new text
;; Use put-text-property to preserve embedded text properties in new-text
(let ((new-end (+ m-start (length new-text))))
(set-text-properties m-start new-end props))))
(if new-text-has-props
;; Preserve embedded properties - use put-text-property
(cl-loop for (key val) on props by #'cddr
do (put-text-property m-start new-end key val))
;; No embedded properties - can use set-text-properties
(set-text-properties m-start new-end props)))))
;; Search for next match
(setq match (text-property-search-forward 'tp-name layer-name t)))))
@ -977,20 +1004,36 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)."
(error
(message "tp: transform error for %s: %s" layer-name err)
tp-text-val))
tp-text-val)))
tp-text-val))
;; Check if final-text has text properties that should be preserved
(tp-text-has-props (and (stringp final-text)
(text-properties-at 0 final-text))))
(if (stringp object)
;; For strings: create a new string with tp-text content
;; The new string replaces the original, with props applied
;; Preserve any text properties from the tp-text value itself
(let ((new-string (copy-sequence final-text)))
(list props (length new-string) new-string))
;; If tp-text has embedded text properties, merge them with props
;; The props from the layer are applied as base, tp-text props on top
(if tp-text-has-props
;; Return props and mark that tp-text has embedded properties
;; The caller should handle merging
(list (plist-put (copy-sequence props)
'tp--text-has-props t)
(length new-string) new-string)
(list props (length new-string) new-string)))
;; For buffers: replace text and adjust end position
(let ((old-text (if object
(with-current-buffer object
(buffer-substring-no-properties start end))
(buffer-substring-no-properties start end))))
(if (equal old-text final-text)
;; Same text, no replacement needed
(list props end object)
(if (equal old-text (substring-no-properties final-text))
;; Same text content, no replacement needed
;; But we may need to apply text properties from final-text
(progn
(when tp-text-has-props
;; Apply tp-text embedded properties to the buffer region
(tp--apply-string-props-to-region final-text start object))
(list props end object))
;; Need to replace text
(let ((existing-props (when preserve-props
(if object
@ -1010,10 +1053,12 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)."
(insert final-text))))
(let ((new-end (+ start (length final-text))))
;; Re-apply existing properties to new text region if preserving
;; Use add-text-properties to not override tp-text embedded props
(when existing-props
(cl-loop for (key val) on existing-props by #'cddr
do (put-text-property
start new-end key val object)))
do (unless (get-text-property start key object)
(put-text-property
start new-end key val object))))
(list props new-end object))))))))
;; Other types - return unchanged
(t (list props end object))))))
@ -1106,18 +1151,26 @@ Returns modified string or (START . END) cons for buffer."
(setq props new-props finish new-finish object new-object)
(when (and (stringp object) (plist-member props 'tp-text))
(setq start 0)))
;; Check if we have any existing properties in the range
(let ((has-existing-props (text-properties-at start object)))
(if (and (not has-existing-props)
;; Also check if this is a uniform range (no intervals)
(or (stringp object)
(= start (or (next-single-property-change start nil object finish) finish))))
;; No existing properties - can use set-text-properties to preserve duplicate keys
(set-text-properties start finish props object)
;; Has existing properties - use put-text-property for proper interval handling
;; This may lose duplicate keys but correctly handles overlapping regions
(cl-loop for (key val) on props by #'cddr
do (put-text-property start finish key val object))))
;; Check if tp-text has embedded properties that should be preserved
(let ((tp-text-has-props (plist-get props 'tp--text-has-props)))
;; Remove the internal marker from props before applying
(when tp-text-has-props
(setq props (cl-loop for (key val) on props by #'cddr
unless (eq key 'tp--text-has-props)
append (list key val))))
;; Check if we have any existing properties in the range
(let ((has-existing-props (or tp-text-has-props
(text-properties-at start object))))
(if (and (not has-existing-props)
;; Also check if this is a uniform range (no intervals)
(or (stringp object)
(= start (or (next-single-property-change start nil object finish) finish))))
;; No existing properties - can use set-text-properties to preserve duplicate keys
(set-text-properties start finish props object)
;; Has existing properties - use put-text-property for proper interval handling
;; This may lose duplicate keys but correctly handles overlapping regions
(cl-loop for (key val) on props by #'cddr
do (put-text-property start finish key val object)))))
(if (stringp object) object (cons start finish))))
(defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest)
@ -1132,8 +1185,19 @@ Returns modified string or (START . END) cons for buffer."
(setq props new-props finish new-finish object new-object)
(when (and (stringp object) (plist-member props 'tp-text))
(setq start 0)))
;; Completely replace all properties
(set-text-properties start finish props object)
;; Check if tp-text has embedded properties that should be preserved
(let ((tp-text-has-props (plist-get props 'tp--text-has-props)))
;; Remove the internal marker from props before applying
(when tp-text-has-props
(setq props (cl-loop for (key val) on props by #'cddr
unless (eq key 'tp--text-has-props)
append (list key val))))
;; If tp-text has embedded props, apply props with put-text-property
;; to preserve the embedded properties. Otherwise replace all.
(if tp-text-has-props
(cl-loop for (key val) on props by #'cddr
do (put-text-property start finish key val object))
(set-text-properties start finish props object)))
(if (stringp object) object (cons start finish))))
(defun tp--prepend-face (new-face existing-face)
@ -1201,6 +1265,11 @@ Returns modified string or (START . END) cons for buffer."
(setq props new-props finish new-finish object new-object)
(when (and (stringp object) (plist-member props 'tp-text))
(setq start 0)))
;; Remove the internal tp--text-has-props marker from props before applying
(when (plist-get props 'tp--text-has-props)
(setq props (cl-loop for (key val) on props by #'cddr
unless (eq key 'tp--text-has-props)
append (list key val))))
;; Process each property with deep merging
(let ((pos start))
(while (< pos finish)