From 70f60f1a25f1f132981795e7a2675c777ed270d7 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Tue, 6 Jan 2026 16:05:58 +0000 Subject: [PATCH] Use propertize for non-destructive string operations in tp-set/add/reset/remove This change makes tp-set, tp-add, tp-reset, and tp-remove return a NEW propertized string when operating on strings, rather than modifying the original string in-place. This is more idiomatic for Emacs Lisp and prevents unintended side effects. For buffer operations, the existing in-place modification behavior is preserved. Key changes: - Added tp--apply-props-to-string helper function that uses propertize - Updated tp-set, tp-add, tp-reset to use the new helper for strings - Updated tp-remove with new helper functions for non-destructive removal - Updated tp--match-apply and tp--regexp-apply to accumulate changes - Added tests verifying original strings are not modified - Updated documentation to reflect the new behavior Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- README.md | 6 +- tp-tests.el | 90 +++++++++++++ tp.el | 374 +++++++++++++++++++++++++++++++++++++++++----------- 3 files changed, 388 insertions(+), 82 deletions(-) diff --git a/README.md b/README.md index 4c05080..42d44ad 100644 --- a/README.md +++ b/README.md @@ -880,7 +880,7 @@ OBJECT is a buffer or string; nil means current buffer. (tp-match-set "TODO" '(face warning))) ;; => ((1 . 5) (17 . 21)) -;; On string - returns modified string +;; On string - returns a NEW propertized string (original is not modified) (tp-match-set "o" '(face bold) "Hello World") ;; => #("Hello World" 4 5 (face bold) 7 8 (face bold)) @@ -2357,7 +2357,7 @@ Add or merge properties to specific layers in a region or string. - **IDX-OR-LAYER-NAME-LIST** is a list of layer indices (integers) or layer names (symbols). For indices: 0 means top layer, -1 means bottom layer. - Properties are deeply merged into the specified layers (nested plists are merged, not replaced). - OBJECT defaults to current buffer for region form. -- Returns the modified string or nil for buffer operations. +- For strings, returns a NEW string (original is not modified). For buffers, returns nil. **Examples:** @@ -2392,7 +2392,7 @@ Add or merge properties to all layers in a region or string. - Properties are deeply merged into all existing layers. - OBJECT defaults to current buffer for region form. -- Returns the modified string or nil for buffer operations. +- For strings, returns a NEW string (original is not modified). For buffers, returns nil. **Examples:** diff --git a/tp-tests.el b/tp-tests.el index 02482ab..4a07514 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -4041,5 +4041,95 @@ Regression test for: (tp-set \"emacs\" 'face nil) erroring with (tp-set 1 6 '(face nil)) (should (eq (tp-at 1 'face) nil)))) +;;; ============================================================ +;;; Non-Destructive String Modification Tests +;;; ============================================================ + +(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")) + (let ((result (tp-set original 'face 'bold))) + ;; Result should be a new string with properties + (should (stringp result)) + (should (eq (get-text-property 0 'face result) 'bold)) + ;; Original should NOT be modified (no properties) + (should (null (get-text-property 0 'face original))) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + +(ert-deftest tp-test-reset-does-not-modify-original-string () + "Test that tp-reset returns a new string and does not modify the original." + (let ((original "Hello")) + (let ((result (tp-reset original 'face 'bold))) + ;; Result should be a new string with properties + (should (stringp result)) + (should (eq (get-text-property 0 'face result) 'bold)) + ;; Original should NOT be modified (no properties) + (should (null (get-text-property 0 'face original))) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + +(ert-deftest tp-test-add-does-not-modify-original-string () + "Test that tp-add returns a new string and does not modify the original." + (let ((original "Hello")) + (let ((result (tp-add original 'face 'bold))) + ;; Result should be a new string with properties + (should (stringp result)) + (should (eq (get-text-property 0 'face result) 'bold)) + ;; Original should NOT be modified (no properties) + (should (null (get-text-property 0 'face original))) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + +(ert-deftest tp-test-remove-does-not-modify-original-string () + "Test that tp-remove returns a new string and does not modify the original." + ;; First create a propertized string (using propertize to create the original) + (let ((original (propertize "Hello" 'face 'bold 'help-echo "tip"))) + (let ((result (tp-remove original 'face))) + ;; Result should be a new string without face property + (should (stringp result)) + (should (null (get-text-property 0 'face result))) + (should (equal (get-text-property 0 'help-echo result) "tip")) + ;; Original should still have face property + (should (eq (get-text-property 0 'face original) 'bold)) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + +(ert-deftest tp-test-set-region-does-not-modify-original-string () + "Test that tp-set with region returns a new string and does not modify the original." + (let ((original "Hello World")) + (let ((result (tp-set 0 5 '(face bold) original))) + ;; Result should be a new string with properties on the region + (should (stringp result)) + (should (eq (get-text-property 0 'face result) 'bold)) + ;; Original should NOT be modified (no properties) + (should (null (get-text-property 0 'face original))) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + +(ert-deftest tp-test-match-set-does-not-modify-original-string () + "Test that tp-match-set returns a new string and does not modify the original." + (let ((original "Hello World")) + (let ((result (tp-match-set "Hello" '(face bold) original))) + ;; Result should be a new string with properties + (should (stringp result)) + (should (eq (get-text-property 0 'face result) 'bold)) + ;; Original should NOT be modified (no properties) + (should (null (get-text-property 0 'face original))) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + +(ert-deftest tp-test-regexp-set-does-not-modify-original-string () + "Test that tp-regexp-set returns a new string and does not modify the original." + (let ((original "abc 123 def")) + (let ((result (tp-regexp-set "[0-9]+" '(face bold) original))) + ;; Result should be a new string with properties on the match + (should (stringp result)) + (should (eq (get-text-property 4 'face result) 'bold)) + ;; Original should NOT be modified (no properties) + (should (null (get-text-property 4 'face original))) + ;; Strings should not be eq (different objects) + (should (not (eq original result)))))) + (provide 'tp-ert-tests) ;;; tp-ert-tests.el ends here diff --git a/tp.el b/tp.el index 74fa8fe..8f44e38 100644 --- a/tp.el +++ b/tp.el @@ -1235,6 +1235,60 @@ Supports multiple calling conventions: (setq props (or (tp--resolve-props props) props))) (list object start finish props))) +(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. + +MERGE-MODE controls how properties are applied: + nil or :set - Set properties, preserving existing unspecified ones + :reset - Completely replace all properties + :add - Merge properties deeply (for face, prepend symbols) + +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 + (let ((result (copy-sequence existing-props))) + (cl-loop for (key val) on props by #'cddr + 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))) + ;;;============================================================================ ;;; Layer 2: Core Property Functions - Set/Reset/Add ;;;============================================================================ @@ -1250,7 +1304,9 @@ Supports four calling conventions: PROPS can be a plist or a layer/group name symbol. Preserves existing properties not specified in PROPS. For tp-text, props override embedded text properties. -Returns modified string or (START . END) cons for buffer." + +For strings, returns a NEW propertized string (original is not modified). +For buffers, returns (START . END) cons." (pcase-let ((`(,object ,start ,finish ,props) (tp--parse-args start-or-string end-or-prop props-or-val rest))) ;; Handle tp-text property specially - :override means props override embedded props @@ -1259,25 +1315,25 @@ 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)))) - (if (stringp object) object (cons start finish)))) + (if (stringp object) + ;; For strings: create a new propertized string (non-destructive) + (tp--apply-props-to-string object start finish props nil) + ;; For buffers: modify in place (standard behavior) + (let ((has-existing-props (text-properties-at start object))) + (if (and (not has-existing-props) + (= start (or (next-single-property-change start nil object finish) finish))) + (set-text-properties start finish props object) + (cl-loop for (key val) on props by #'cddr + do (put-text-property start finish key val object)))) + (cons start finish)))) (defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest) "Completely replace all text properties with PROPS. Like `tp-set' but replaces ALL existing properties. For tp-text, embedded text properties are ignored - only props are used. -Returns modified string or (START . END) cons for buffer." + +For strings, returns a NEW propertized string (original is not modified). +For buffers, returns (START . END) cons." (pcase-let ((`(,object ,start ,finish ,props) (tp--parse-args start-or-string end-or-prop props-or-val rest))) ;; Handle tp-text property - :reset means only use props, ignore embedded props @@ -1286,9 +1342,12 @@ 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) - (if (stringp object) object (cons start finish)))) + (if (stringp object) + ;; For strings: create a new propertized string (non-destructive) + (tp--apply-props-to-string object start finish props :reset) + ;; For buffers: modify in place (standard behavior) + (set-text-properties start finish props object) + (cons start finish)))) (defun tp--prepend-face (new-face existing-face) "Prepend NEW-FACE to EXISTING-FACE for the face property. @@ -1378,7 +1437,9 @@ Duplicate faces are not added." Unlike `tp-set', deeply merges nested properties. For `face' property, symbol faces are prepended to existing face list. For tp-text, embedded text properties are merged with props. -Returns modified string or (START . END) cons for buffer." + +For strings, returns a NEW propertized string (original is not modified). +For buffers, returns (START . END) cons." (pcase-let ((`(,object ,start ,finish ,props) (tp--parse-args start-or-string end-or-prop props-or-val rest))) ;; Handle tp-text property - :merge means embedded props are merged with props @@ -1388,10 +1449,14 @@ Returns modified string or (START . END) cons for buffer." (setq props new-props finish new-finish object new-object) (when (and (stringp object) has-tp-text) (setq start 0)))) - ;; For strings with tp-text, properties are already merged - just apply them - ;; For other cases, process each property with deep merging - (if (and (stringp object) (plist-member props 'tp-text)) - (set-text-properties start finish props object) + (if (stringp object) + ;; For strings: create a new propertized string (non-destructive) + (if (plist-member props 'tp-text) + ;; For tp-text, properties are already merged + (tp--apply-props-to-string object start finish props :reset) + ;; Otherwise use :add mode for deep merging + (tp--apply-props-to-string object start finish props :add)) + ;; For buffers: modify in place with deep merging (let ((pos start)) (while (< pos finish) (let* ((current-props (text-properties-at pos object)) @@ -1406,8 +1471,8 @@ Returns modified string or (START . END) cons for buffer." (tp--deep-merge-plist current-val val)) (t val)))) (put-text-property pos next-pos key new-val object))) - (setq pos next-pos))))) - (if (stringp object) object (cons start finish)))) + (setq pos next-pos)))) + (cons start finish)))) ;;;============================================================================ ;;; Layer 2: Core Property Functions - Get/At @@ -1705,39 +1770,39 @@ This function supports multiple calling conventions: (tp-remove STRING PROPERTY SUB-KEY \\='(NESTED-KEYS...)) (tp-remove \"Hello\" \\='face :underline \\='(:style :position)) -Returns the modified string for string input, or nil for buffer operations." +For strings, returns a NEW string with properties removed (original is not modified). +For buffers, returns nil." (cond - ;; First arg is a string - apply to entire string + ;; First arg is a string - apply to entire string, non-destructively ((stringp start-or-string) - (let ((str start-or-string) - (start 0) - (end (length start-or-string))) + (let* ((str start-or-string) + (start 0) + (end (length str))) (cond ;; (tp-remove str 'face :underline '(:style :position)) - nested sub-property removal with list ((and (symbolp end-or-prop) (keywordp prop-or-sub) rest (listp (car rest))) - (tp--remove-property start end (list end-or-prop prop-or-sub (car rest)) str)) + (tp--remove-property-from-string str start end (list end-or-prop prop-or-sub (car rest)))) ;; (tp-remove str 'face :underline :position :style ...) - nested sub-property removal with keywords ((and (symbolp end-or-prop) (keywordp prop-or-sub) rest (keywordp (car rest))) - (tp--remove-property start end (list end-or-prop prop-or-sub rest) str)) + (tp--remove-property-from-string str start end (list end-or-prop prop-or-sub rest))) ;; (tp-remove str 'face :underline) - sub-property removal ((and (symbolp end-or-prop) (keywordp prop-or-sub)) - (tp--remove-sub start end end-or-prop prop-or-sub str)) + (tp--remove-sub-from-string str start end end-or-prop prop-or-sub)) ;; (tp-remove str 'face 'help-echo ...) - multiple properties ((symbolp end-or-prop) - (let ((props (cons end-or-prop (cons prop-or-sub rest)))) - ;; Filter to only include valid property symbols (not nil) - (dolist (prop (cl-remove-if-not #'symbolp props)) - (remove-text-properties start end (list prop nil) str)))) + (let ((props-to-remove (cl-remove-if-not #'symbolp + (cons end-or-prop (cons prop-or-sub rest))))) + (tp--remove-props-from-string str start end props-to-remove))) ;; (tp-remove str '(face :underline)) - nested property spec ((listp end-or-prop) - (tp--remove-property start end end-or-prop str))) - str)) + (tp--remove-property-from-string str start end end-or-prop)) + (t str)))) ;; First arg is a number - buffer region ((numberp start-or-string) (let* ((start start-or-string) @@ -1748,6 +1813,127 @@ Returns the modified string for string input, or nil for buffer operations." nil)) (t (error "Invalid arguments to tp-remove")))) +(defun tp--remove-props-from-string (str start end props-to-remove) + "Create a new string from STR with PROPS-TO-REMOVE removed from START to END. +Returns a new string (original is not modified)." + (let* ((len (length str)) + (start (max 0 start)) + (end (min end len)) + (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 and remove the specified ones + (existing-props (text-properties-at start str)) + (final-props (let ((result nil)) + (cl-loop for (key val) on existing-props by #'cddr + unless (memq key props-to-remove) + do (setq result (plist-put result key val))) + result)) + (middle-propertized (if final-props + (apply #'propertize middle-text final-props) + middle-text))) + (concat before middle-propertized after))) + +(defun tp--remove-sub-from-string (str start end property sub-key) + "Create a new string from STR with SUB-KEY removed from PROPERTY. +Returns a new string (original is not modified)." + (let* ((len (length str)) + (start (max 0 start)) + (end (min end len)) + (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 and modify the face + (existing-props (text-properties-at start str)) + (prop-value (plist-get existing-props property)) + (new-value (when (and prop-value (listp prop-value) (keywordp (car-safe prop-value))) + (let ((result nil)) + (cl-loop for (k v) on prop-value by #'cddr + unless (eq k sub-key) + do (setq result (plist-put result k v))) + result))) + (final-props (let ((result nil)) + (cl-loop for (key val) on existing-props by #'cddr + do (setq result (plist-put result key + (if (eq key property) + new-value + val)))) + result)) + (middle-propertized (if final-props + (apply #'propertize middle-text final-props) + middle-text))) + (concat before middle-propertized after))) + +(defun tp--remove-property-from-string (str start end property-spec) + "Create a new string from STR with PROPERTY-SPEC removed from START to END. +PROPERTY-SPEC can be a symbol or a nested spec like (PROPERTY SUB-KEY ...). +Returns a new string (original is not modified)." + (cond + ((symbolp property-spec) + (tp--remove-props-from-string str start end (list property-spec))) + ((listp property-spec) + (let ((property (car property-spec)) + (sub-key (cadr property-spec)) + (nested-keys (caddr property-spec))) + (cond + ;; Nested sub-property removal + ((and sub-key nested-keys) + ;; For complex nested removal, we need to handle this specially + (let* ((len (length str)) + (start (max 0 start)) + (end (min end len)) + (before (when (> start 0) + (substring str 0 start))) + (middle-text (substring-no-properties str start end)) + (after (when (< end len) + (substring str end len))) + (existing-props (text-properties-at start str)) + (prop-value (plist-get existing-props property)) + (new-value (when (and prop-value (listp prop-value)) + (tp--remove-nested-keys prop-value sub-key nested-keys))) + (final-props (let ((result nil)) + (cl-loop for (key val) on existing-props by #'cddr + do (setq result (plist-put result key + (if (eq key property) + new-value + val)))) + result)) + (middle-propertized (if final-props + (apply #'propertize middle-text final-props) + middle-text))) + (concat before middle-propertized after))) + ;; Simple sub-property removal + (sub-key + (tp--remove-sub-from-string str start end property sub-key)) + ;; Just a property name + (t + (tp--remove-props-from-string str start end (list property)))))) + (t str))) + +(defun tp--remove-nested-keys (plist sub-key nested-keys) + "Remove NESTED-KEYS from the SUB-KEY value within PLIST. +Returns the modified plist." + (let* ((sub-value (plist-get plist sub-key)) + (keys-to-remove (if (listp nested-keys) nested-keys (list nested-keys))) + (new-sub-value (when (and sub-value (listp sub-value)) + (let ((result nil)) + (cl-loop for (k v) on sub-value by #'cddr + unless (memq k keys-to-remove) + do (setq result (plist-put result k v))) + result)))) + (if new-sub-value + (plist-put plist sub-key new-sub-value) + ;; Remove the sub-key entirely if no value left + (let ((result nil)) + (cl-loop for (k v) on plist by #'cddr + unless (eq k sub-key) + do (setq result (plist-put result k v))) + result)))) + ;;;###autoload (defun tp-clear (&optional start end object) "Clear all text properties from START to END in OBJECT. @@ -1762,18 +1948,22 @@ If START and END are not provided, clear the entire buffer." ;;;============================================================================ (defun tp--match-apply-single (pattern properties apply-fn object) - "Apply APPLY-FN to matches of single PATTERN in OBJECT." + "Apply APPLY-FN to matches of single PATTERN in OBJECT. +For strings, returns a new string with properties applied (non-destructive). +For buffers, modifies in-place and returns list of regions." (cond ;; String object ((stringp object) - (let ((pos 0)) - (while (string-match (regexp-quote pattern) object pos) + (let ((result object) + (pos 0) + (offset 0)) ; Track offset for position changes (though properties shouldn't change length) + (while (string-match (regexp-quote pattern) result pos) (let ((beg (match-beginning 0)) (end (match-end 0))) (when properties - (funcall apply-fn beg end properties object)) + (setq result (funcall apply-fn beg end properties result))) (setq pos (if (= beg end) (1+ beg) end)))) - object)) + result)) ;; Buffer or nil (current buffer) (t (let ((buf (or object (current-buffer)))) @@ -1794,14 +1984,16 @@ If START and END are not provided, clear the entire buffer." PATTERN can be a string or a list of strings (multiple patterns). When PATTERN is a list, each element is a pattern to match. APPLY-FN is called with (START END PROPS OBJECT) for each match. -Returns modified object or list of regions." +For strings, returns a NEW string with properties applied (non-destructive). +For buffers, returns list of regions." (let ((patterns (if (listp pattern) pattern (list pattern)))) (cond ;; String object ((stringp object) - (dolist (p patterns) - (tp--match-apply-single p properties apply-fn object)) - object) + (let ((result object)) + (dolist (p patterns) + (setq result (tp--match-apply-single p properties apply-fn result))) + result)) ;; Buffer or nil (current buffer) (t (let ((all-regions nil)) @@ -1813,18 +2005,20 @@ Returns modified object or list of regions." (defun tp--regexp-apply-single (pattern properties apply-fn object) "Apply APPLY-FN to regexp matches of single PATTERN in OBJECT. APPLY-FN is called with (START END PROPS OBJECT) for each match. -Returns modified object or list of regions." +For strings, returns a NEW string with properties applied (non-destructive). +For buffers, modifies in-place and returns list of regions." (cond ;; String object ((stringp object) - (let ((pos 0)) - (while (string-match pattern object pos) + (let ((result object) + (pos 0)) + (while (string-match pattern result pos) (let ((beg (match-beginning 0)) (end (match-end 0))) (when properties - (funcall apply-fn beg end properties object)) + (setq result (funcall apply-fn beg end properties result))) (setq pos (if (= beg end) (1+ beg) end)))) - object)) + result)) ;; Buffer or nil (current buffer) (t (let ((buf (or object (current-buffer)))) @@ -1845,14 +2039,16 @@ Returns modified object or list of regions." PATTERN can be a string (single regexp) or a list of strings (multiple regexps). When PATTERN is a list, each element is a regexp to match. APPLY-FN is called with (START END PROPS OBJECT) for each match. -Returns modified object or list of regions." +For strings, returns a NEW string with properties applied (non-destructive). +For buffers, returns list of regions." (let ((patterns (if (listp pattern) pattern (list pattern)))) (cond ;; String object ((stringp object) - (dolist (p patterns) - (tp--regexp-apply-single p properties apply-fn object)) - object) + (let ((result object)) + (dolist (p patterns) + (setq result (tp--regexp-apply-single p properties apply-fn result))) + result)) ;; Buffer or nil (current buffer) (t (let ((all-regions nil)) @@ -1863,22 +2059,29 @@ Returns modified object or list of regions." (defun tp--deep-merge-apply (start end props obj) "Apply PROPS to OBJ from START to END with deep merge. -Merges nested plists instead of replacing them." - (let ((pos start)) - (while (< pos end) - (let* ((current-props (text-properties-at pos obj)) - (next-pos (or (next-property-change pos obj end) end))) - (cl-loop for (key val) on props by #'cddr - do (let* ((current-val (plist-get current-props key)) - (new-val - (cond - ((and (listp val) (keywordp (car-safe val)) - (listp current-val) - (keywordp (car-safe current-val))) - (tp--deep-merge-plist current-val val)) - (t val)))) - (put-text-property pos next-pos key new-val obj))) - (setq pos next-pos))))) +Merges nested plists instead of replacing them. +For strings, returns a NEW string (original is not modified). +For buffers, modifies in-place." + (if (stringp obj) + ;; For strings: create a new propertized string using tp--apply-props-to-string with :add mode + (tp--apply-props-to-string obj start end props :add) + ;; For buffers: modify in-place + (let ((pos start)) + (while (< pos end) + (let* ((current-props (text-properties-at pos obj)) + (next-pos (or (next-property-change pos obj end) end))) + (cl-loop for (key val) on props by #'cddr + do (let* ((current-val (plist-get current-props key)) + (new-val + (cond + ((and (listp val) (keywordp (car-safe val)) + (listp current-val) + (keywordp (car-safe current-val))) + (tp--deep-merge-plist current-val val)) + (t val)))) + (put-text-property pos next-pos key new-val obj))) + (setq pos next-pos)))) + obj)) (defun tp-match-set (pattern plist &optional object) "Set properties on all occurrences of PATTERN. @@ -1908,12 +2111,23 @@ or a symbol representing a layer/group name defined by `define-tp' or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. -Unlike `tp-match-set', this completely replaces all existing properties." +Unlike `tp-match-set', this completely replaces all existing properties. + +For strings, returns a NEW string (original is not modified). +For buffers, modifies in-place and returns list of regions." (tp--match-apply pattern (tp--ensure-props plist) - (lambda (start end props obj) - (set-text-properties start end props obj)) + #'tp--reset-apply object)) +(defun tp--reset-apply (start end props obj) + "Apply PROPS to OBJ from START to END, completely replacing existing properties. +For strings, returns a NEW string. +For buffers, modifies in-place." + (if (stringp obj) + (tp--apply-props-to-string obj start end props :reset) + (set-text-properties start end props obj) + obj)) + (defun tp-match-add (pattern plist &optional object) "Add/update properties on all occurrences of PATTERN. @@ -1956,10 +2170,12 @@ or a symbol representing a layer/group name defined by `define-tp' or `define-tp-group'. OBJECT is a buffer or string; nil means current buffer. -Unlike `tp-regexp-set', this completely replaces all existing properties." +Unlike `tp-regexp-set', this completely replaces all existing properties. + +For strings, returns a NEW string (original is not modified). +For buffers, modifies in-place and returns list of regions." (tp--regexp-apply pattern (tp--ensure-props plist) - (lambda (start end props obj) - (set-text-properties start end props obj)) + #'tp--reset-apply object)) (defun tp-regexp-add (pattern plist &optional object)