From 2fce83315b85031fa202f32a60072b99ca4b2885 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sat, 13 Dec 2025 09:59:27 +0000 Subject: [PATCH] Update tp-put API and tests to new format Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- tp-tests.el | 81 +++++++++++++++++++++++++++++----------------------- tp.el | 82 ++++++++++++++++++++++++++++------------------------- 2 files changed, 88 insertions(+), 75 deletions(-) diff --git a/tp-tests.el b/tp-tests.el index 0153970..24523f8 100644 --- a/tp-tests.el +++ b/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 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")) diff --git a/tp.el b/tp.el index 7d2402e..faf2a25 100644 --- a/tp.el +++ b/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) - "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) - (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))) + ;; 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 + 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)))))))))