diff --git a/tp-tests.el b/tp-tests.el index a9d092b..c11e5d8 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -3043,8 +3043,8 @@ the inserted text should be that string, not the source text." ;;; ============================================================ (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 + "Test that tp-set with tp-text overrides embedded properties on strings." + ;; When tp-text is a propertized string and tp-set is used, props override embedded (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))) @@ -3052,24 +3052,50 @@ the inserted text should be that string, not the source 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 + ;; tp-set overrides - embedded custom-prop should NOT be present + (should (null (tp-at 0 'custom-prop result))))) + +(ert-deftest tp-test-tp-add-with-embedded-properties-string () + "Test that tp-add with tp-text merges embedded properties on strings." + ;; When tp-text is a propertized string and tp-add is used, props are merged + (let* ((propertized-text (copy-sequence "Hello")) + (_ (put-text-property 0 5 'custom-prop 'embedded-value propertized-text)) + (result (tp-add "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)) + ;; tp-add merges - embedded custom-prop should be present (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." + "Test that tp-set with tp-text overrides embedded face 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 + ;; Set tp-text with its own face, and also specify help-echo (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 + ;; tp-set overrides - embedded face should NOT be present (no face in props) + (should (null (tp-at 0 'face result))) + ;; The help-echo from props should be applied + (should (equal (tp-at 0 'help-echo result) "tip")))) + +(ert-deftest tp-test-tp-add-with-embedded-face-string () + "Test that tp-add with tp-text merges embedded face on strings." + (let* ((propertized-text (copy-sequence "Hello")) + (_ (put-text-property 0 5 'face 'italic propertized-text)) + ;; Add tp-text with its own face, and also specify help-echo + (result (tp-add "X" 'tp-text propertized-text 'help-echo "tip"))) + ;; The text content should be from tp-text + (should (equal result "Hello")) + ;; tp-add merges - embedded face should be present (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." + "Test that tp-set with tp-text overrides embedded properties in buffers." (tp-test-with-temp-buffer (insert "Original") (let* ((propertized-text (copy-sequence "New")) @@ -3079,12 +3105,12 @@ the inserted text should be that string, not the source text." (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))))) + ;; tp-set overrides embedded props - custom-prop should NOT be present + (should (null (tp-at 1 'custom-prop)))))) (ert-deftest tp-test-tp-text-with-mixed-properties () - "Test that tp-text with properties at position 0 merges them correctly." - ;; The simpler implementation merges properties at position 0 + "Test that tp-set with tp-text overrides embedded properties." + ;; tp-set should override embedded props, not merge them (let* ((propertized-text (copy-sequence "ABCD")) ;; Set a property at position 0 (_ (put-text-property 0 4 'region-type 'start propertized-text)) @@ -3094,11 +3120,11 @@ the inserted text should be that string, not the source text." ;; 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 property from position 0 should be merged - (should (equal (tp-at 0 'region-type result) 'start)))) + ;; tp-set overrides embedded props - region-type should NOT be present + (should (null (tp-at 0 'region-type result))))) (ert-deftest tp-test-tp-reset-with-embedded-properties () - "Test that tp-reset with embedded text properties preserves them." + "Test that tp-reset ignores embedded text properties entirely." (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))) @@ -3106,8 +3132,8 @@ the inserted text should be that string, not the source 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)))) + ;; tp-reset ignores embedded props - custom-prop should NOT be present + (should (null (tp-at 0 'custom-prop result))))) (ert-deftest tp-test-tp-add-with-embedded-properties () "Test that tp-add with embedded text properties preserves them." @@ -3122,9 +3148,9 @@ the inserted text should be that string, not the source text." (should (equal (tp-at 0 'custom-prop result) 'value)))) (ert-deftest tp-test-tp-text-face-merging () - "Test that tp-text with embedded face property merges with props face." - ;; This is the core use case: merging face 'bold with face (:foreground \"red\") - (let ((result (tp-set "emacs" 'face 'bold 'tp-text (propertize "vim" 'face '(:foreground "red"))))) + "Test that tp-add with tp-text merges embedded face property with props face." + ;; This is the core use case for tp-add: merging face 'bold with face (:foreground \"red\") + (let ((result (tp-add "emacs" 'face 'bold 'tp-text (propertize "vim" 'face '(:foreground "red"))))) ;; Text should be replaced (should (equal result "vim")) ;; Face should be merged: (:foreground \"red\") + bold diff --git a/tp.el b/tp.el index bed4614..af76118 100644 --- a/tp.el +++ b/tp.el @@ -957,12 +957,16 @@ Text properties embedded in NEW-TEXT are merged with PROPS." ;; Search for next match (setq match (text-property-search-forward 'tp-name layer-name t))))) -(defun tp--handle-tp-text-property (start end props object &optional preserve-props) +(defun tp--handle-tp-text-property (start end props object &optional preserve-props merge-mode) "Handle tp-text property in PROPS for region from START to END in OBJECT. If tp-text is nil, initialize it to the current text in the region. If tp-text is a string different from current text, replace the text. When PRESERVE-PROPS is non-nil, existing text properties are preserved on the replaced text (used by tp-set and tp-add). +MERGE-MODE controls how embedded text properties in tp-text are handled: + :merge - embedded properties are merged with props (tp-add behavior) + :override or nil - props override embedded properties (tp-set behavior) + :reset - embedded properties are ignored, only props used (tp-reset behavior) Returns (PROPS NEW-END NEW-OBJECT) where PROPS is the updated props, NEW-END is the new end position after any text replacement, and NEW-OBJECT is the new string object (only different for strings with tp-text)." @@ -1009,14 +1013,21 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)." (message "tp: transform error for %s: %s" layer-name err) tp-text-val)) tp-text-val)) - ;; Merge embedded text properties from final-text into props - ;; This way the caller applies all properties together - (merged-props (tp--merge-string-props-into-plist final-text props))) + ;; Handle embedded text properties based on merge-mode: + ;; :merge - merge embedded props with props (tp-add) + ;; :override/nil - props take precedence, don't merge (tp-set) + ;; :reset - ignore embedded props entirely (tp-reset) + (result-props + (if (eq merge-mode :merge) + ;; tp-add: merge embedded properties with props + (tp--merge-string-props-into-plist final-text props) + ;; tp-set/:override or tp-reset: just use props as-is + props))) (if (stringp object) ;; For strings: create a new string with tp-text content - ;; Return merged props so all properties are applied together - (let ((new-string (copy-sequence final-text))) - (list merged-props (length new-string) new-string)) + ;; Strip properties - result-props will be applied by the caller + (let ((new-string (substring-no-properties final-text))) + (list result-props (length new-string) new-string)) ;; For buffers: replace text and adjust end position (let ((old-text (if object (with-current-buffer object @@ -1024,7 +1035,7 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)." (buffer-substring-no-properties start end)))) (if (equal old-text (substring-no-properties final-text)) ;; Same text content, no replacement needed - (list merged-props end object) + (list result-props end object) ;; Need to replace text (let ((existing-props (when preserve-props (if object @@ -1037,7 +1048,7 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)." (let ((inhibit-read-only t)) (delete-region start end) (goto-char start) - ;; Insert without properties - we'll apply merged props later + ;; Insert without properties - we'll apply result-props later (insert (substring-no-properties final-text)))) (let ((inhibit-read-only t)) (delete-region start end) @@ -1047,10 +1058,10 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)." ;; Re-apply existing properties to new text region if preserving (when existing-props (cl-loop for (key val) on existing-props by #'cddr - do (unless (plist-member merged-props key) + do (unless (plist-member result-props key) (put-text-property start new-end key val object)))) - (list merged-props new-end object)))))))) + (list result-props new-end object)))))))) ;; Other types - return unchanged (t (list props end object)))))) @@ -1133,12 +1144,13 @@ 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." (pcase-let ((`(,object ,start ,finish ,props) (tp--parse-args start-or-string end-or-prop props-or-val rest))) - ;; Handle tp-text property specially - this also merges embedded text properties + ;; Handle tp-text property specially - :override means props override embedded props (pcase-let ((`(,new-props ,new-finish ,new-object) - (tp--handle-tp-text-property start finish props object t))) + (tp--handle-tp-text-property start finish props object t :override))) (setq props new-props finish new-finish object new-object) (when (and (stringp object) (plist-member props 'tp-text)) (setq start 0))) @@ -1159,12 +1171,13 @@ Returns modified string or (START . END) cons for buffer." (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." (pcase-let ((`(,object ,start ,finish ,props) (tp--parse-args start-or-string end-or-prop props-or-val rest))) - ;; Handle tp-text property - this also merges embedded text properties + ;; Handle tp-text property - :reset means only use props, ignore embedded props (pcase-let ((`(,new-props ,new-finish ,new-object) - (tp--handle-tp-text-property start finish props object nil))) + (tp--handle-tp-text-property start finish props object nil :reset))) (setq props new-props finish new-finish object new-object) (when (and (stringp object) (plist-member props 'tp-text)) (setq start 0))) @@ -1228,13 +1241,14 @@ Duplicate faces are not added." "Add or update text properties with deep merging. 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." (pcase-let ((`(,object ,start ,finish ,props) (tp--parse-args start-or-string end-or-prop props-or-val rest))) - ;; Handle tp-text property - this also merges embedded text properties + ;; Handle tp-text property - :merge means embedded props are merged with props (let ((has-tp-text (plist-member props 'tp-text))) (pcase-let ((`(,new-props ,new-finish ,new-object) - (tp--handle-tp-text-property start finish props object t))) + (tp--handle-tp-text-property start finish props object t :merge))) (setq props new-props finish new-finish object new-object) (when (and (stringp object) has-tp-text) (setq start 0))))