From 2128f78509524511df63a0a5fc0a8248cf44f55e Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 15 Dec 2025 09:42:11 +0000 Subject: [PATCH] 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 | 20 ++++++++++ tp.el | 104 +++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 95 insertions(+), 29 deletions(-) diff --git a/tp-tests.el b/tp-tests.el index f6db6fc..6aeca2a 100644 --- a/tp-tests.el +++ b/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 ;;; ============================================================ diff --git a/tp.el b/tp.el index 9a3d318..62d7fb1 100644 --- a/tp.el +++ b/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 - (save-excursion - (delete-region start end) - (goto-char start) - (insert new-text)))))) + (unless (equal new-text text) + (save-excursion + (delete-region start end) + (goto-char start) + (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 - (save-excursion - (delete-region start end) - (goto-char start) - (insert new-text)))))) + (unless (equal new-text text) + (save-excursion + (delete-region start end) + (goto-char start) + (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 - (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 - (save-excursion - (delete-region start end) - (goto-char start) - (insert new-text)))))) + (unless (equal new-text text) + (save-excursion + (delete-region start end) + (goto-char start) + (insert new-text))))))) start-or-string end-or-property property-or-value value object)))