geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

Update tp-put API and tests to new format

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-13 09:59:27 +00:00
parent 3097efd788
commit 2fce83315b
2 changed files with 88 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
tp-tests.el
View File

@ -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 7 12 'face 'italic)
(tp-put 1 6 '(face bold))
(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 'help-echo "test")
(tp-put 1 12 '(face bold))
(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 7 12 'face 'italic)
(tp-put 1 6 '(face bold))
(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 7 12 'my-prop 'value2)
(tp-put 1 6 '(my-prop value1))
(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 7 12 'my-prop 'value2)
(tp-put 1 6 '(my-prop value1))
(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 7 12 'face 'italic)
(tp-put 1 6 '(face bold))
(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 13 18 'marker t)
(tp-put 1 6 '(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 13 18 'marker t)
(tp-put 1 6 '(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 5 12 'prop2 'val2)
(tp-put 1 8 '(prop1 val1))
(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"))

80
tp.el
View File

@ -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)
"Set text PROPERTIES on OBJECT (string or buffer region).
(defun tp-put (start-or-string &optional end props-or-prop &rest rest)
"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):
(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 ...)
1. Current buffer:
(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
((stringp object-or-start)
(setq object object-or-start
start start-or-end
end end-or-prop
props properties))
;; First arg is a buffer - use object convention
((bufferp object-or-start)
(setq object object-or-start
start start-or-end
end end-or-prop
props properties))
;; First arg is a number - use buffer region convention
((numberp object-or-start)
;; First arg is a string - apply to entire string
((stringp start-or-string)
(setq object start-or-string
start 0
finish (length start-or-string)
props (if end
(if props-or-prop
(cons end (cons props-or-prop rest))
(list end))
nil)))
;; First arg is a number - region convention
((numberp start-or-string)
(setq start start-or-string
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
end start-or-end
props (if end-or-prop
(cons end-or-prop properties)
properties)))
(t (error "Invalid first argument: %S" object-or-start)))
props props-or-prop)))
(t (error "Invalid first argument: %S" start-or-string)))
;; 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)))))))))