Fix tp-search-map to properly copy text properties for strings

store-substring only copies text content, not properties.
Added explicit property copying after store-substring to ensure
both text content and property modifications are applied.

Also updated tp-forward-do and tp-backward-do with the same fix.
Added test for property modification via tp-search-map.

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>

tp-tests.el

@@ -770,6 +770,26 @@
       (should (equal (buffer-substring 1 6) "HELLO"))
       (should (equal (buffer-substring 13 18) "HELLO")))))
 
+(ert-deftest tp-test-search-map-property-modification ()
+  "Test tp-search-map applies property modifications to matched text."
+  (let ((str (copy-sequence "hello World hello")))
+    (tp-set 0 5 '(marker t) str)
+    (tp-set 12 17 '(marker t) str)
+    ;; First upcase the text
+    (tp-search-map #'upcase str 'marker)
+    ;; Then add face property
+    (tp-search-map (lambda (txt)
+                     (tp-add txt 'face '(:background "orange")))
+                   str 'marker)
+    ;; Check text was upcased
+    (should (equal (substring str 0 5) "HELLO"))
+    (should (equal (substring str 12 17) "HELLO"))
+    ;; Check face property was added
+    (let ((props-0 (text-properties-at 0 str))
+          (props-12 (text-properties-at 12 str)))
+      (should (equal (plist-get (plist-get props-0 'face) :background) "orange"))
+      (should (equal (plist-get (plist-get props-12 'face) :background) "orange")))))
+
 ;;; ============================================================
 ;;; Utility Function Tests
 ;;; ============================================================

tp.el

@@ -1117,17 +1117,29 @@ Example:
                       (substring obj start end)
                     (buffer-substring start end)))
             (new-text (funcall function text)))
-       (when (and new-text (not (equal new-text text)))
+       (when (stringp new-text)
          (if (stringp obj)
-             ;; For strings, we need to replace in-place
-             ;; Note: store-substring has length restrictions
-             (progn
-               (store-substring obj start new-text))
+             ;; For strings: copy text content and properties separately
+             (let ((len (min (length new-text) (- end start))))
+               ;; Copy text content
+               (store-substring obj start new-text)
+               ;; Copy properties from new-text to obj
+               (let ((pos 0))
+                 (while (< pos len)
+                   (let* ((props (text-properties-at pos new-text))
+                          (next-change (or (next-property-change pos new-text) len)))
+                     (when props
+                       (set-text-properties (+ start pos)
+                                            (+ start (min next-change len))
+                                            props
+                                            obj))
+                     (setq pos next-change)))))
            ;; For buffers, delete and insert
+           (unless (equal new-text text)
              (save-excursion
                (delete-region start end)
                (goto-char start)
-             (insert new-text))))))
+               (insert new-text)))))))
    property value object n))
 
 (defun tp--backward-do (function property &optional value object n)
@@ -1187,17 +1199,29 @@ Example:
                       (substring obj start end)
                     (buffer-substring start end)))
             (new-text (funcall function text)))
-       (when (and new-text (not (equal new-text text)))
+       (when (stringp new-text)
          (if (stringp obj)
-             ;; For strings, we need to replace in-place
-             ;; Note: store-substring has length restrictions
-             (progn
-               (store-substring obj start new-text))
+             ;; For strings: copy text content and properties separately
+             (let ((len (min (length new-text) (- end start))))
+               ;; Copy text content
+               (store-substring obj start new-text)
+               ;; Copy properties from new-text to obj
+               (let ((pos 0))
+                 (while (< pos len)
+                   (let* ((props (text-properties-at pos new-text))
+                          (next-change (or (next-property-change pos new-text) len)))
+                     (when props
+                       (set-text-properties (+ start pos)
+                                            (+ start (min next-change len))
+                                            props
+                                            obj))
+                     (setq pos next-change)))))
            ;; For buffers, delete and insert
+           (unless (equal new-text text)
              (save-excursion
                (delete-region start end)
                (goto-char start)
-             (insert new-text))))))
+               (insert new-text)))))))
    property value object n))
 
 (defun tp-search (start-or-string &optional end-or-property property-or-value value object)
@@ -1315,19 +1339,27 @@ This function supports two calling conventions:
 2. Entire string:
    (tp-search-map FUNCTION STRING PROPERTY &optional VALUE)
 
-FUNCTION receives the matched text as its only argument.  The return value
-of FUNCTION replaces the matched text in the string or buffer.
+FUNCTION receives a copy of the matched text as its only argument.
+FUNCTION can either:
+- Return a new/modified string to replace the matched text
+- Modify the text properties of the argument and return it
+- Return nil to skip replacement
+
+For text content changes, the return value replaces the matched text.
+For property-only changes, the properties are merged back to the original.
 
 Returns the number of matches processed.
 
-Note: For string objects, the replacement text must have the same length
+Note: For string objects, replacement text must have the same length
 as the original matched text, since strings have fixed length in Emacs.
 If the replacement is shorter, only that portion will be replaced.
 If the replacement is longer, it will be truncated.
 
 Example:
   ;; Upcase all matched text
-  (tp-search-map #\\='upcase my-string \\='marker)"
+  (tp-search-map #\\='upcase my-string \\='marker)
+  ;; Add properties to matched text
+  (tp-search-map (lambda (txt) (tp-add txt \\='face \\='bold)) str \\='marker)"
   (let ((obj (cond
               ((stringp start-or-string) start-or-string)
               ((numberp start-or-string) (or object (current-buffer)))
@@ -1340,15 +1372,29 @@ Example:
                         (substring obj start end)
                       (buffer-substring start end)))
               (new-text (funcall function text)))
-         (when (and new-text (not (equal new-text text)))
+         (when (stringp new-text)
            (if (stringp obj)
-               ;; For strings, replace in-place
+               ;; For strings: copy text content and properties separately
+               (let ((len (min (length new-text) (- end start))))
+                 ;; Copy text content
                  (store-substring obj start new-text)
+                 ;; Copy properties from new-text to obj
+                 (let ((pos 0))
+                   (while (< pos len)
+                     (let* ((props (text-properties-at pos new-text))
+                            (next-change (or (next-property-change pos new-text) len)))
+                       (when props
+                         (set-text-properties (+ start pos)
+                                              (+ start (min next-change len))
+                                              props
+                                              obj))
+                       (setq pos next-change)))))
              ;; For buffers, delete and insert
+             (unless (equal new-text text)
                (save-excursion
                  (delete-region start end)
                  (goto-char start)
-               (insert new-text))))))
+                 (insert new-text)))))))
      start-or-string end-or-property property-or-value value object)))