Merge remote-tracking branch 'origin/copilot/fix-tp-remove-custom-attributes'

tp-tests.el

@@ -1435,34 +1435,34 @@ Later values should override earlier values for the same sub-property."
 
 (ert-deftest tp-test-remove-entire-string-single-prop ()
   "Test tp-remove removes single property from entire string."
-  (let ((str (tp-set "Hello" 'face 'bold 'help-echo "test")))
-    (tp-remove str 'face)
-    (should (null (get-text-property 0 'face str)))
-    (should (equal (get-text-property 0 'help-echo str) "test"))))
+  (let* ((str (tp-set "Hello" 'face 'bold 'help-echo "test"))
+         (result (tp-remove str 'face)))
+    (should (null (get-text-property 0 'face result)))
+    (should (equal (get-text-property 0 'help-echo result) "test"))))
 
 (ert-deftest tp-test-remove-entire-string-multiple-props ()
   "Test tp-remove removes multiple properties from entire string."
-  (let ((str (tp-set "Hello" 'face 'bold 'help-echo "test" 'mouse-face 'highlight)))
-    (tp-remove str 'face 'help-echo)
-    (should (null (get-text-property 0 'face str)))
-    (should (null (get-text-property 0 'help-echo str)))
-    (should (eq (get-text-property 0 'mouse-face str) 'highlight))))
+  (let* ((str (tp-set "Hello" 'face 'bold 'help-echo "test" 'mouse-face 'highlight))
+         (result (tp-remove str 'face 'help-echo)))
+    (should (null (get-text-property 0 'face result)))
+    (should (null (get-text-property 0 'help-echo result)))
+    (should (eq (get-text-property 0 'mouse-face result) 'highlight))))
 
 (ert-deftest tp-test-remove-entire-string-sub-prop ()
   "Test tp-remove removes sub-property from entire string."
-  (let ((str (copy-sequence "Hello")))
-    (put-text-property 0 5 'face '(:foreground "red" :underline t) str)
-    (tp-remove str 'face :underline)
-    (let ((face (get-text-property 0 'face str)))
+  (let* ((str (copy-sequence "Hello"))
+         (_ (put-text-property 0 5 'face '(:foreground "red" :underline t) str))
+         (result (tp-remove str 'face :underline)))
+    (let ((face (get-text-property 0 'face result)))
       (should (equal (plist-get face :foreground) "red"))
       (should (null (plist-get face :underline))))))
 
 (ert-deftest tp-test-remove-entire-string-nested-sub-prop ()
   "Test tp-remove removes nested sub-properties from entire string."
-  (let ((str (copy-sequence "Hello")))
-    (put-text-property 0 5 'face '(:foreground "red" :underline (:style wave :color "blue")) str)
-    (tp-remove str 'face :underline '(:style))
-    (let* ((face (get-text-property 0 'face str))
+  (let* ((str (copy-sequence "Hello"))
+         (_ (put-text-property 0 5 'face '(:foreground "red" :underline (:style wave :color "blue")) str))
+         (result (tp-remove str 'face :underline '(:style))))
+    (let* ((face (get-text-property 0 'face result))
            (underline (plist-get face :underline)))
       (should (equal (plist-get face :foreground) "red"))
       (should (equal (plist-get underline :color) "blue"))
@@ -1472,11 +1472,11 @@ Later values should override earlier values for the same sub-property."
   "Test tp-remove removes a single nested key from a sub-property.
 This tests the fix for the bug where (tp-remove str 'face :underline :position)
 was removing the entire :underline instead of just :position."
-  (let ((str (copy-sequence "happy hacking emacs")))
-    (tp-set str 'face '(:foreground "red" :underline (:position t :color "green"))
-            'line-prefix ">> " 'other "other")
-    (tp-remove str 'face :underline :position)
-    (let* ((face (get-text-property 0 'face str))
+  (let* ((str (tp-set "happy hacking emacs"
+                      'face '(:foreground "red" :underline (:position t :color "green"))
+                      'line-prefix ">> " 'other "other"))
+         (result (tp-remove str 'face :underline :position)))
+    (let* ((face (get-text-property 0 'face result))
            (underline (plist-get face :underline)))
       ;; :foreground should be preserved
       (should (equal (plist-get face :foreground) "red"))
@@ -1485,8 +1485,8 @@ was removing the entire :underline instead of just :position."
       (should (equal (plist-get underline :color) "green"))
       (should (null (plist-get underline :position)))
       ;; Other properties should be preserved
-      (should (equal (get-text-property 0 'line-prefix str) ">> "))
-      (should (equal (get-text-property 0 'other str) "other")))))
+      (should (equal (get-text-property 0 'line-prefix result) ">> "))
+      (should (equal (get-text-property 0 'other result) "other")))))
 
 ;;; ============================================================
 ;;; New API Tests - Issue 3 & 4: tp-get for strings and new API
@@ -4131,7 +4131,9 @@ The region form (tp-set START END PROPS STRING) modifies the string in-place."
       (should (not (eq original result))))))
 
 (ert-deftest tp-test-remove-custom-layer ()
-  "Test that tp-remove correctly removes custom text property layers."
+  "Test that tp-remove correctly removes custom text property layers.
+When a layer is removed, only its face contribution should be removed,
+not the entire face property."
   ;; First define the custom layer
   (tp-layer-reset)
   (eval '(define-tp tp-delete (color)
@@ -4142,25 +4144,31 @@ The region form (tp-set START END PROPS STRING) modifies the string in-place."
          (result (tp-remove str-with-props 'tp-delete)))
     ;; Original should still have the properties
     (should (get-text-property 0 'face str-with-props))
-    ;; Result should not have face property (since it was added by tp-delete)
-    (should (null (get-text-property 0 'face result)))
+    ;; Result should have face 'bold (only the tp-delete contribution removed)
+    (should (equal (get-text-property 0 'face result) 'bold))
+    ;; Result should not have tp-delete property
+    (should (null (get-text-property 0 'tp-delete result)))
     ;; Result should not have tp-name property
     (should (null (get-text-property 0 'tp-name result)))))
 
 (ert-deftest tp-test-remove-custom-layer-preserves-other-props ()
-  "Test that tp-remove with layer name preserves other properties."
+  "Test that tp-remove with layer name preserves other properties.
+When the layer property is set (via mixed syntax), its face contribution
+can be tracked and removed."
   (tp-layer-reset)
   (eval '(define-tp tp-delete (color)
            `(face (:strike-through ,color))))
-  ;; Test with entire string form - set layer and separate property
+  ;; Test with mixed syntax - set layer alongside other properties
+  ;; This allows tracking of the layer property
   (let* ((str "emacs")
-         (str-with-layer (tp-set str 'tp-delete "red"))
-         (str-with-both (tp-set 0 (length str-with-layer) '(help-echo "test") str-with-layer))
-         (result (tp-remove str-with-both 'tp-delete)))
+         (str-with-props (tp-set str 'help-echo "test" 'tp-delete "red"))
+         (result (tp-remove str-with-props 'tp-delete)))
     ;; help-echo should still be present
     (should (equal (get-text-property 0 'help-echo result) "test"))
     ;; face (from tp-delete) should be removed
-    (should (null (get-text-property 0 'face result)))))
+    (should (null (get-text-property 0 'face result)))
+    ;; tp-delete property should be removed
+    (should (null (get-text-property 0 'tp-delete result)))))
 
 (provide 'tp-ert-tests)
 ;;; tp-ert-tests.el ends here

tp.el

@@ -303,6 +303,84 @@ and PLIST is the merged plist of all face attributes."
          (t (setq i (1+ i))))))
     (cons (nreverse symbols) plist)))
 
+(defun tp--remove-sub-from-face-value (face-value sub-key)
+  "Remove SUB-KEY from FACE-VALUE, handling complex face structures.
+FACE-VALUE can be:
+- A simple plist like (:foreground \"red\" :background \"blue\")
+- A symbol like bold
+- A mixed list like ((:foreground \"red\") (:strike-through t) bold)
+
+Returns the modified face value with SUB-KEY removed from any plist components.
+Returns nil if the result would be empty."
+  (cond
+   ;; Nil face - nothing to remove
+   ((null face-value) nil)
+   ;; Symbol face - no sub-key to remove
+   ((symbolp face-value) face-value)
+   ;; Simple plist - remove the sub-key directly
+   ((and (listp face-value) (keywordp (car-safe face-value)))
+    (let ((result nil))
+      (cl-loop for (k v) on face-value by #'cddr
+               unless (eq k sub-key)
+               do (setq result (plist-put result k v)))
+      result))
+   ;; Mixed list - parse and remove from plist component
+   ((listp face-value)
+    (let* ((parsed (tp--parse-face-list face-value))
+           (symbols (car parsed))
+           (plist (cdr parsed)))
+      (when plist
+        ;; Remove sub-key from the merged plist
+        (let ((new-plist nil))
+          (cl-loop for (k v) on plist by #'cddr
+                   unless (eq k sub-key)
+                   do (setq new-plist (plist-put new-plist k v)))
+          (setq plist new-plist)))
+      ;; Reconstruct the face value
+      (cond
+       ((and symbols plist) (append symbols (list plist)))
+       (symbols (if (= (length symbols) 1) (car symbols) symbols))
+       (plist plist)
+       (t nil))))
+   ;; Unknown format - return as-is
+   (t face-value)))
+
+(defun tp--subtract-face-from-face-value (face-value face-to-remove)
+  "Remove FACE-TO-REMOVE from FACE-VALUE.
+FACE-TO-REMOVE is the face contribution to subtract (from a layer).
+FACE-VALUE is the current combined face value.
+Returns the modified face value with the layer's face contribution removed."
+  (cond
+   ;; Nothing to remove from
+   ((null face-value) nil)
+   ;; If face-to-remove is nil, return as-is
+   ((null face-to-remove) face-value)
+   ;; If they're equal, remove entirely
+   ((equal face-value face-to-remove) nil)
+   ;; face-to-remove is a plist - remove those keys from face-value
+   ((and (listp face-to-remove) (keywordp (car-safe face-to-remove)))
+    (let ((keys-to-remove (cl-loop for (k _v) on face-to-remove by #'cddr
+                                   collect k)))
+      ;; Remove each key
+      (dolist (key keys-to-remove)
+        (setq face-value (tp--remove-sub-from-face-value face-value key)))
+      face-value))
+   ;; face-to-remove is a symbol - remove it from face-value
+   ((symbolp face-to-remove)
+    (cond
+     ((eq face-value face-to-remove) nil)
+     ((and (listp face-value) (not (keywordp (car-safe face-value))))
+      (let ((result (remove face-to-remove face-value)))
+        (if (= (length result) 1) (car result) result)))
+     (t face-value)))
+   ;; face-to-remove is a list - remove each element
+   ((listp face-to-remove)
+    (dolist (elem face-to-remove)
+      (setq face-value (tp--subtract-face-from-face-value face-value elem)))
+    face-value)
+   ;; Unknown - return as-is
+   (t face-value)))
+
 (defun tp--merge-string-props-into-plist (str props)
   "Merge text properties from string STR into PROPS plist.
 Properties from PROPS take precedence over those in STR.
@@ -1931,9 +2009,13 @@ For non-layer symbols, returns a list containing just that symbol."
   (if (tp--is-layer-name-p layer-name)
       (let* ((existing-props (text-properties-at start str))
              (existing-tp-name (plist-get existing-props 'tp-name))
-             ;; Only proceed if this layer is actually applied here
+             (layer-prop-value (plist-get existing-props layer-name))
+             ;; Proceed if tp-name matches OR if the layer property exists
+             ;; (for cases where layer was used in mixed syntax without tp-name)
              (layer-props
-              (when (eq existing-tp-name layer-name)
+              (cond
+               ;; tp-name matches - traditional layer application
+               ((eq existing-tp-name layer-name)
                 (cond
                  ;; Parameterized layer - get property keys it would produce
                  ;; We pass a dummy arg (t) since we only need the key names, not values
@@ -1945,15 +2027,29 @@ For non-layer symbols, returns a list containing just that symbol."
                  ;; Layer group
                  ((assoc layer-name tp-layer-groups)
                   (when-let ((layer-props-list (tp-group-props layer-name t)))
-                    (tp--build-layer-props layer-props-list)))))))
+                    (tp--build-layer-props layer-props-list)))))
+               ;; Layer property exists (mixed syntax like `tp-set str 'face 'bold 'layer arg`)
+               ;; In this case, the layer's face properties are merged into face
+               (layer-prop-value
+                (cond
+                 ((tp-layer-parameterized-p layer-name)
+                  (tp-layer-props-with-arg layer-name layer-prop-value nil))
+                 ((assoc layer-name tp-layer-alist)
+                  (tp-layer-props layer-name nil))
+                 ((assoc layer-name tp-layer-groups)
+                  (when-let ((layer-props-list (tp-group-props layer-name t)))
+                    (tp--build-layer-props layer-props-list))))))))
         (if layer-props
-            ;; Return all property keys from the layer plus tp-name
+            ;; Return all property keys from the layer plus tp-name and the layer itself
             (let ((keys (cl-loop for (key _val) on layer-props by #'cddr
                                  collect key)))
-              (if (memq 'tp-name keys)
-                  keys
-                (cons 'tp-name keys)))
-          ;; Layer name doesn't match tp-name, just remove the literal symbol
+              (unless (memq 'tp-name keys)
+                (push 'tp-name keys))
+              (unless (memq layer-name keys)
+                (push layer-name keys))
+              keys)
+          ;; Layer name doesn't match tp-name and layer property doesn't exist
+          ;; Just remove the literal symbol
           (list layer-name)))
     ;; Not a layer name, just return the symbol itself
     (list layer-name)))
@@ -1968,10 +2064,29 @@ STR and START are used to determine context for parameterized layers."
           (push expanded result))))
     (nreverse result)))
 
+(defun tp--get-layer-face-contribution (layer-name layer-prop-value)
+  "Get the face contribution from LAYER-NAME.
+LAYER-PROP-VALUE is the value of the layer property (the argument passed to it).
+Returns the face value that the layer adds, or nil if no face contribution."
+  (when (tp--is-layer-name-p layer-name)
+    (let ((layer-props
+           (cond
+            ((tp-layer-parameterized-p layer-name)
+             (tp-layer-props-with-arg layer-name layer-prop-value nil))
+            ((assoc layer-name tp-layer-alist)
+             (tp-layer-props layer-name nil))
+            ((assoc layer-name tp-layer-groups)
+             (when-let ((layer-props-list (tp-group-props layer-name t)))
+               (tp--build-layer-props layer-props-list))))))
+      (when layer-props
+        (plist-get layer-props 'face)))))
+
 (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.
 PROPS-TO-REMOVE can include layer names, which will be expanded to include
 all properties that the layer adds.
+For face properties from layers, subtracts the layer's face contribution
+instead of removing the entire face property.
 Returns a new string (original is not modified)."
   (let* ((len (length str))
          (start (max 0 start))
@@ -1981,23 +2096,57 @@ Returns a new string (original is not modified)."
          (middle-text (substring-no-properties str start end))
          (after (when (< end len)
                   (substring str end len)))
-         ;; Expand layer names to their actual properties
-         (expanded-props (tp--expand-props-to-remove props-to-remove str start))
-         ;; 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 expanded-props)
-                                 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)))
+         ;; Remaining face after layer subtractions
+         (remaining-face nil)
+         ;; Track if face was modified by layer subtraction
+         (face-was-modified nil)
+         ;; Collect all properties to remove entirely (non-face or non-layer)
+         (props-to-remove-entirely nil))
+    ;; Process each property to remove
+    (dolist (prop props-to-remove)
+      (if (tp--is-layer-name-p prop)
+          ;; Layer name - get its face contribution and subtract from face
+          (let* ((layer-prop-value (plist-get existing-props prop))
+                 (layer-face (tp--get-layer-face-contribution prop layer-prop-value)))
+            ;; Subtract layer's face from the current face
+            (when layer-face
+              (let ((current-face (or remaining-face (plist-get existing-props 'face))))
+                (setq remaining-face
+                      (tp--subtract-face-from-face-value current-face layer-face))
+                ;; Mark that we processed the face (even if result is nil)
+                (setq face-was-modified t)))
+            ;; Add the layer property itself to remove list
+            (push prop props-to-remove-entirely)
+            ;; Also add tp-name if it matches
+            (when (eq (plist-get existing-props 'tp-name) prop)
+              (push 'tp-name props-to-remove-entirely)))
+        ;; Non-layer property - remove entirely
+        (push prop props-to-remove-entirely)))
+    ;; Build final properties
+    (let* ((final-props
+            (let ((result nil))
+              (cl-loop for (key val) on existing-props by #'cddr
+                       do (cond
+                           ;; Face property with layer subtraction
+                           ((and (eq key 'face) face-was-modified)
+                            (when remaining-face
+                              (setq result (plist-put result key remaining-face))))
+                           ;; Property to remove entirely
+                           ((memq key props-to-remove-entirely)
+                            nil) ; skip
+                           ;; Keep other properties
+                           (t (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)."
+Returns a new string (original is not modified).
+Handles complex face values that contain a mix of symbols and plists."
   (let* ((len (length str))
          (start (max 0 start))
          (end (min end len))
@@ -2006,15 +2155,12 @@ Returns a new string (original is not modified)."
          (middle-text (substring-no-properties str start end))
          (after (when (< end len)
                   (substring str end len)))
-         ;; Get existing properties and modify the face
+         ;; Get existing properties and modify the property
          (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)))
+         ;; Use the new helper to handle complex face values
+         (new-value (when prop-value
+                      (tp--remove-sub-from-face-value prop-value sub-key)))
          (final-props (let ((result nil))
                         (cl-loop for (key val) on existing-props by #'cddr
                                  do (setq result (plist-put result key
@@ -2053,7 +2199,7 @@ Returns a new string (original is not modified)."
                (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)))
+                            (tp--remove-nested-sub-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
@@ -2073,7 +2219,7 @@ Returns a new string (original is not modified)."
         (tp--remove-props-from-string str start end (list property))))))
    (t str)))
 
-(defun tp--remove-nested-keys (plist sub-key nested-keys)
+(defun tp--remove-nested-sub-keys (plist sub-key nested-keys)
   "Remove NESTED-KEYS from the SUB-KEY value within PLIST.
 Returns a new plist (does not modify the original)."
   (let* ((sub-value (plist-get plist sub-key))