Update tp-put API and tests to new format

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

tp-tests.el

@@ -38,12 +38,12 @@
   (tp-test-with-temp-buffer
     (insert "Hello World")
     ;; Set a single property
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
     (should (eq (tp-get 1 'face) 'bold))
     (should (eq (tp-get 3 'face) 'bold))
     (should (null (tp-get 7 'face)))
     ;; Set multiple properties
-    (tp-put 7 12 'face 'italic 'help-echo "test")
+    (tp-put 7 12 '(face italic help-echo "test"))
     (should (eq (tp-get 7 'face) 'italic))
     (should (equal (tp-get 7 'help-echo) "test"))))
 
@@ -59,14 +59,14 @@
   "Test tp-put returns the modified region."
   (tp-test-with-temp-buffer
     (insert "Hello")
-    (let ((result (tp-put 1 6 'face 'bold)))
+    (let ((result (tp-put 1 6 '(face bold))))
       (should (equal result '(1 . 6))))))
 
 (ert-deftest tp-test-remove ()
   "Test tp-remove removes a specific property."
   (tp-test-with-temp-buffer
     (insert "Hello")
-    (tp-put 1 6 'face 'bold 'help-echo "test")
+    (tp-put 1 6 '(face bold help-echo "test"))
     (should (eq (tp-get 1 'face) 'bold))
     (tp-remove 1 6 'face)
     (should (null (tp-get 1 'face)))
@@ -76,7 +76,7 @@
   "Test tp-remove-list removes multiple properties."
   (tp-test-with-temp-buffer
     (insert "Hello")
-    (tp-put 1 6 'face 'bold 'help-echo "test" 'mouse-face 'highlight)
+    (tp-put 1 6 '(face bold help-echo "test" mouse-face highlight))
     (tp-remove-list 1 6 '(face help-echo))
     (should (null (tp-get 1 'face)))
     (should (null (tp-get 1 'help-echo)))
@@ -86,8 +86,8 @@
   "Test tp-clear removes all properties."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
-    (tp-put 7 12 'face 'italic)
+    (tp-put 7 12 '(face italic))
     (tp-clear 1 12)
     (should (null (tp-get 1 'face)))
     (should (null (tp-get 7 'face)))))
@@ -96,7 +96,7 @@
   "Test tp-clear defaults to entire buffer."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 12 'face 'bold)
+    (tp-put 1 12 '(face bold))
     (tp-clear)
     (should (null (tp-get 1 'face)))
     (should (null (tp-get 7 'face)))))
@@ -105,7 +105,7 @@
   "Test tp-at returns all properties at point."
   (tp-test-with-temp-buffer
     (insert "Hello")
-    (tp-put 1 6 'face 'bold 'help-echo "test")
+    (tp-put 1 6 '(face bold help-echo "test"))
     (let ((props (tp-at 1)))
       (should (eq (plist-get props 'face) 'bold))
       (should (equal (plist-get props 'help-echo) "test")))))
@@ -114,7 +114,7 @@
   "Test tp-at defaults to current point."
   (tp-test-with-temp-buffer
     (insert "Hello")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
     (goto-char 3)
     (should (eq (plist-get (tp-at) 'face) 'bold))))
 
@@ -123,8 +123,8 @@
   (tp-test-with-temp-buffer
     (insert "Hello World")
     ;; Put both properties on the same overlapping region for proper merging
-    (tp-put 1 12 'face 'bold)
+    (tp-put 1 12 '(face bold))
-    (tp-put 1 12 'help-echo "test")
+    (tp-put 1 12 '(help-echo "test"))
     (let ((props (tp-plist 1 12)))
       (should (eq (plist-get props 'face) 'bold))
       (should (equal (plist-get props 'help-echo) "test")))))
@@ -142,8 +142,8 @@
   "Test tp-intervals returns property intervals."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
-    (tp-put 7 12 'face 'italic)
+    (tp-put 7 12 '(face italic))
     (let ((intervals (tp-intervals 1 12)))
       (should (>= (length intervals) 2)))))
 
@@ -522,7 +522,7 @@
   "Test tp-forward finds next property."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 7 12 'face 'bold)
+    (tp-put 7 12 '(face bold))
     (goto-char 1)
     ;; text-property-search-forward may not exist in all Emacs versions
     (skip-unless (fboundp 'text-property-search-forward))
@@ -534,7 +534,7 @@
   "Test tp-backward finds previous property."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
     (goto-char 12)
     ;; text-property-search-backward may not exist in all Emacs versions
     ;; Skip test if function is not available
@@ -547,7 +547,7 @@
   "Test tp-next returns next position with property."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 7 12 'face 'bold)
+    (tp-put 7 12 '(face bold))
     (let ((pos (tp-next 1 'face)))
       (should (= pos 7)))))
 
@@ -555,7 +555,7 @@
   "Test tp-prev returns previous position with property."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
     (let ((pos (tp-prev 12 'face)))
       (should (= pos 1)))))
 
@@ -563,7 +563,7 @@
   "Test tp-goto-next moves point."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 7 12 'face 'bold)
+    (tp-put 7 12 '(face bold))
     (goto-char 1)
     (tp-goto-next 'face)
     (should (= (point) 7))))
@@ -572,7 +572,7 @@
   "Test tp-goto-prev moves point."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
     (goto-char 12)
     (tp-goto-prev 'face)
     (should (= (point) 1))))
@@ -585,8 +585,8 @@
   "Test tp-in finds regions with property."
   (tp-test-with-temp-buffer
     (insert "Hello World Test")
-    (tp-put 1 6 'my-prop 'value1)
+    (tp-put 1 6 '(my-prop value1))
-    (tp-put 7 12 'my-prop 'value2)
+    (tp-put 7 12 '(my-prop value2))
     (let ((regions (tp-in 'my-prop)))
       (should (= (length regions) 2)))))
 
@@ -594,8 +594,8 @@
   "Test tp-in filters by value."
   (tp-test-with-temp-buffer
     (insert "Hello World Test")
-    (tp-put 1 6 'my-prop 'value1)
+    (tp-put 1 6 '(my-prop value1))
-    (tp-put 7 12 'my-prop 'value2)
+    (tp-put 7 12 '(my-prop value2))
     (let ((regions (tp-in 'my-prop 'value1)))
       (should (= (length regions) 1))
       (should (equal (car (car regions)) 1)))))
@@ -604,8 +604,8 @@
   "Test tp-all returns all regions with properties."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 6 'face 'bold)
+    (tp-put 1 6 '(face bold))
-    (tp-put 7 12 'face 'italic)
+    (tp-put 7 12 '(face italic))
     (let ((regions (tp-all)))
       (should (>= (length regions) 2)))))
 
@@ -613,8 +613,8 @@
   "Test tp-regions-map applies function to regions."
   (tp-test-with-temp-buffer
     (insert "Hello World Hello")
-    (tp-put 1 6 'marker t)
+    (tp-put 1 6 '(marker t))
-    (tp-put 13 18 'marker t)
+    (tp-put 13 18 '(marker t))
     (let ((result nil))
       (tp-regions-map
        (lambda (start end idx)
@@ -626,8 +626,8 @@
   "Test tp-strings-map applies function to strings."
   (tp-test-with-temp-buffer
     (insert "Hello World Hello")
-    (tp-put 1 6 'marker t)
+    (tp-put 1 6 '(marker t))
-    (tp-put 13 18 'marker t)
+    (tp-put 13 18 '(marker t))
     (let ((result nil))
       (tp-strings-map
        (lambda (str idx)
@@ -654,7 +654,7 @@
   (tp-test-with-temp-buffer
     ;; Test tp-set alias
     (insert "Hello")
-    (tp-set 1 6 'face 'bold)
+    (tp-set 1 6 '(face bold))
     (should (eq (tp-get 1 'face) 'bold))))
 
 ;;; ============================================================
@@ -671,8 +671,8 @@
   "Test overlapping property regions."
   (tp-test-with-temp-buffer
     (insert "Hello World")
-    (tp-put 1 8 'prop1 'val1)
+    (tp-put 1 8 '(prop1 val1))
-    (tp-put 5 12 'prop2 'val2)
+    (tp-put 5 12 '(prop2 val2))
     (should (eq (tp-get 1 'prop1) 'val1))
     (should (null (tp-get 1 'prop2)))
     (should (eq (tp-get 6 'prop1) 'val1))
@@ -684,7 +684,7 @@
   "Test operations on single character."
   (tp-test-with-temp-buffer
     (insert "H")
-    (tp-put 1 2 'face 'bold)
+    (tp-put 1 2 '(face bold))
     (should (eq (tp-get 1 'face) 'bold))))
 
 (ert-deftest tp-test-layer-on-string ()
@@ -700,17 +700,26 @@
 (ert-deftest tp-test-put-on-string ()
   "Test tp-put works on string objects."
   (let ((str (copy-sequence "Hello World")))
-    (tp-put str 0 5 'face 'bold)
+    (tp-put 0 5 '(face bold) str)
     (should (eq (get-text-property 0 'face str) 'bold))
     (should (null (get-text-property 6 'face str)))))
 
 (ert-deftest tp-test-put-on-string-returns-string ()
   "Test tp-put returns the modified string."
   (let* ((str (copy-sequence "Hello"))
-         (result (tp-put str 0 5 'face 'bold)))
+         (result (tp-put 0 5 '(face bold) str)))
     (should (stringp result))
     (should (eq (get-text-property 0 'face result) 'bold))))
 
+(ert-deftest tp-test-put-entire-string ()
+  "Test tp-put applies to entire string with flat properties."
+  (let* ((str (copy-sequence "Hello"))
+         (result (tp-put str 'face 'bold 'help-echo "test")))
+    (should (stringp result))
+    (should (eq (get-text-property 0 'face result) 'bold))
+    (should (equal (get-text-property 0 'help-echo result) "test"))
+    (should (eq (get-text-property 4 'face result) 'bold))))
+
 (ert-deftest tp-test-match-on-string ()
   "Test tp-match works on string objects."
   (let* ((str (copy-sequence "Hello World Hello"))

tp.el

@@ -100,45 +100,49 @@ Appends 'tp-name property to identify the layer."
 
 ;;; Basic text property functions (similar to ov.el)
 
-(defun tp-put (object-or-start &optional start-or-end end-or-prop &rest properties)
+(defun tp-put (start-or-string &optional end props-or-prop &rest rest)
-  "Set text PROPERTIES on OBJECT (string or buffer region).
+  "Set text properties on string or buffer region.
 
-This function supports two calling conventions:
+This function supports four calling conventions:
 
-1. With OBJECT (string or buffer):
+1. Current buffer:
-   (tp-put OBJECT START END PROPERTY VALUE ...)
-   (tp-put OBJECT START END \\='(PROPERTY VALUE ...))
-
-2. Without OBJECT (current buffer):
-   (tp-put START END PROPERTY VALUE ...)
    (tp-put START END \\='(PROPERTY VALUE ...))
 
+2. Specific buffer:
+   (tp-put START END \\='(PROPERTY VALUE ...) BUFFER)
+
+3. Specific string (0-indexed positions):
+   (tp-put START END \\='(PROPERTY VALUE ...) STRING)
+
+4. Entire string:
+   (tp-put STRING PROPERTY VALUE ...)
+
 PROPERTIES is a plist of property-value pairs.
 Return the modified object (string) or region (START . END) for buffer."
-  (let (object start end props)
+  (let (object start finish props)
     ;; Determine calling convention based on first argument type
     (cond
-     ;; First arg is a string - use object convention
+     ;; First arg is a string - apply to entire string
-     ((stringp object-or-start)
+     ((stringp start-or-string)
-      (setq object object-or-start
+      (setq object start-or-string
-            start start-or-end
+            start 0
-            end end-or-prop
+            finish (length start-or-string)
-            props properties))
+            props (if end
-     ;; First arg is a buffer - use object convention
+                      (if props-or-prop
-     ((bufferp object-or-start)
+                          (cons end (cons props-or-prop rest))
-      (setq object object-or-start
+                        (list end))
-            start start-or-end
+                    nil)))
-            end end-or-prop
+     ;; First arg is a number - region convention
-            props properties))
+     ((numberp start-or-string)
-     ;; First arg is a number - use buffer region convention
+      (setq start start-or-string
-     ((numberp object-or-start)
+            finish end)
+      ;; Check if 4th arg (first of rest) is a buffer or string
+      (if (and rest (or (bufferp (car rest)) (stringp (car rest))))
+          (setq object (car rest)
+                props props-or-prop)
         (setq object nil
-            start object-or-start
+              props props-or-prop)))
-            end start-or-end
+     (t (error "Invalid first argument: %S" start-or-string)))
-            props (if end-or-prop
-                      (cons end-or-prop properties)
-                    properties)))
-     (t (error "Invalid first argument: %S" object-or-start)))
     ;; Handle properties as a list
     (when (listp (car-safe props))
       (setq props (car props)))
@@ -146,7 +150,7 @@ Return the modified object (string) or region (START . END) for buffer."
     (let ((len (length props))
           (i 0))
       (while (< i len)
-        (put-text-property start end
+        (put-text-property start finish
                            (nth i props)
                            (nth (1+ i) props)
                            object)
@@ -154,7 +158,7 @@ Return the modified object (string) or region (START . END) for buffer."
     ;; Return result
     (if (stringp object)
         object
-      (cons start end))))
+      (cons start finish))))
 
 (defalias 'tp-set 'tp-put
   "Alias for `tp-put'.")
@@ -419,7 +423,7 @@ PROPERTIES should be a plist of property-value pairs."
           (properties (cddr args)))
       (when (listp (car-safe properties))
         (setq properties (car properties)))
-      (tp-put object start end properties)
+      (tp-put start end properties object)
       object))  ; Always return the object
    (t (error "Invalid arguments to tp-propertize"))))
 
@@ -452,7 +456,7 @@ Returns the modified object."
                 (fin (or end (if (stringp object)
                                  (length object)
                                (with-current-buffer object (point-max))))))
-            (tp-put object beg fin props)
+            (tp-put beg fin props object)
             object))  ; Always return the object
          (t (error "Invalid object type: %S" (type-of object)))))
     (error "Layer %S doesn't exist!" layer)))
@@ -613,7 +617,7 @@ Returns:
           (let ((beg (match-beginning 0))
                 (end (match-end 0)))
             (when properties
-              (tp-put object beg end properties))
+              (tp-put beg end properties object))
             ;; Advance position: for zero-width match, advance by 1 to avoid infinite loop
             (setq pos (if (= beg end) (1+ beg) end))))
         object))
@@ -628,7 +632,7 @@ Returns:
                 (let ((beg (match-beginning 0))
                       (end (match-end 0)))
                   (when properties
-                    (tp-put beg end properties))
+                    (tp-put beg end properties buf))
                   (push (cons beg end) regions)))
               (nreverse regions)))))))))
 
@@ -677,7 +681,7 @@ Returns:
           (let ((beg (match-beginning 0))
                 (end (match-end 0)))
             (when properties
-              (tp-put object beg end properties))
+              (tp-put beg end properties object))
             ;; Advance position: for zero-width match, advance by 1 to avoid infinite loop
             (setq pos (if (= beg end) (1+ beg) end))))
         object))
@@ -692,7 +696,7 @@ Returns:
                 (let ((beg (match-beginning 0))
                       (end (match-end 0)))
                   (when properties
-                    (tp-put beg end properties))
+                    (tp-put beg end properties buf))
                   (push (cons beg end) regions)))
               (nreverse regions)))))))))