Fix tp-get to return intervals for entire strings and support property path lists

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-14 15:15:12 +00:00
parent 932585da3f
commit b31077e486
4 changed files with 120 additions and 37 deletions

View File

@ -294,7 +294,7 @@ Set only the display property, preserving other properties.
Get property value(s) from position or range, with support for nested sub-properties.
For range queries, returns a list of `(START END VALUE)` intervals, allowing you to see all property values across the range.
For range and entire string queries, returns a list of `(START END VALUE)` intervals, allowing you to see all property values across the range.
```elisp
;; Single position
@ -316,10 +316,11 @@ For range queries, returns a list of `(START END VALUE)` intervals, allowing you
(tp-get START END)
(tp-get START END OBJECT)
;; Entire string
;; Entire string (returns list of intervals)
(tp-get STRING)
(tp-get STRING PROPERTY)
(tp-get STRING PROPERTY SUB-KEY ...)
(tp-get STRING '(PROPERTY SUB-KEY ...))
```
**Examples:**
@ -350,10 +351,11 @@ For range queries, returns a list of `(START END VALUE)` intervals, allowing you
;; Get all properties from range
(tp-get 1 10) ; => ((1 6 (face bold help-echo "test")))
;; Get from entire string
(tp-get "Hello World") ; => all properties at position 0
(tp-get "Hello World" 'face) ; => face value at position 0
(tp-get "Hello World" 'face :foreground) ; => foreground color
;; Get from entire string - returns list of intervals
(tp-get str) ; => ((0 5 (face bold)) (12 17 (face italic)))
(tp-get str 'face) ; => ((0 5 bold) (12 17 italic))
(tp-get str 'face :foreground) ; => ((0 5 "red") (12 17 "blue"))
(tp-get str '(face :foreground)) ; => ((0 5 "red") (12 17 "blue"))
```
---

View File

@ -293,7 +293,7 @@ tp.el 提供三个主要的属性设置函数,每个有不同的语义:
从位置或范围获取属性值,支持嵌套子属性访问。
对于范围查询,返回 `(START END VALUE)` 区间列表,让你可以查看范围内所有的属性值。
对于范围和整个字符串查询,返回 `(START END VALUE)` 区间列表,让你可以查看范围内所有的属性值。
```elisp
;; 单个位置
@ -315,10 +315,11 @@ tp.el 提供三个主要的属性设置函数,每个有不同的语义:
(tp-get START END)
(tp-get START END OBJECT)
;; 整个字符串
;; 整个字符串(返回区间列表)
(tp-get STRING)
(tp-get STRING PROPERTY)
(tp-get STRING PROPERTY SUB-KEY ...)
(tp-get STRING '(PROPERTY SUB-KEY ...))
```
**示例:**
@ -349,10 +350,11 @@ tp.el 提供三个主要的属性设置函数,每个有不同的语义:
;; 获取范围内的所有属性
(tp-get 1 10) ; => ((1 6 (face bold help-echo "test")))
;; 从整个字符串获取
(tp-get "Hello World") ; => 位置 0 处的所有属性
(tp-get "Hello World" 'face) ; => 位置 0 处的 face 值
(tp-get "Hello World" 'face :foreground) ; => 前景色
;; 从整个字符串获取 - 返回区间列表
(tp-get str) ; => ((0 5 (face bold)) (12 17 (face italic)))
(tp-get str 'face) ; => ((0 5 bold) (12 17 italic))
(tp-get str 'face :foreground) ; => ((0 5 "red") (12 17 "blue"))
(tp-get str '(face :foreground)) ; => ((0 5 "red") (12 17 "blue"))
```
---

View File

@ -1164,25 +1164,37 @@ Returns list of (START END VALUE) intervals."
;;; ============================================================
(ert-deftest tp-test-get-entire-string-all-props ()
"Test tp-get returns all properties from entire string."
"Test tp-get returns all property intervals from entire string."
(let ((str (tp-set "Hello" 'face 'bold 'help-echo "test")))
(let ((props (tp-get str)))
(let ((intervals (tp-get str)))
(should (= (length intervals) 1))
(let ((props (caddr (car intervals))))
(should (eq (plist-get props 'face) 'bold))
(should (equal (plist-get props 'help-echo) "test")))))
(should (equal (plist-get props 'help-echo) "test"))))))
(ert-deftest tp-test-get-entire-string-single-prop ()
"Test tp-get returns single property from entire string."
"Test tp-get returns single property intervals from entire string."
(let ((str (tp-set "Hello" 'face 'bold 'help-echo "test")))
(should (eq (tp-get str 'face) 'bold))
(should (equal (tp-get str 'help-echo) "test"))))
(let ((face-intervals (tp-get str 'face))
(help-intervals (tp-get str 'help-echo)))
(should (= (length face-intervals) 1))
(should (eq (caddr (car face-intervals)) 'bold))
(should (= (length help-intervals) 1))
(should (equal (caddr (car help-intervals)) "test")))))
(ert-deftest tp-test-get-entire-string-nested-prop ()
"Test tp-get returns nested property from entire string."
"Test tp-get returns nested property intervals from entire string."
(let ((str (copy-sequence "Hello")))
(put-text-property 0 5 'face '(:foreground "red" :box (:color "blue" :line-width 2)) str)
(should (equal (tp-get str 'face :foreground) "red"))
(should (equal (tp-get str 'face :box :color) "blue"))
(should (equal (tp-get str 'face :box :line-width) 2))))
(let ((fg-intervals (tp-get str 'face :foreground))
(box-color-intervals (tp-get str 'face :box :color))
(box-width-intervals (tp-get str 'face :box :line-width)))
(should (= (length fg-intervals) 1))
(should (equal (caddr (car fg-intervals)) "red"))
(should (= (length box-color-intervals) 1))
(should (equal (caddr (car box-color-intervals)) "blue"))
(should (= (length box-width-intervals) 1))
(should (equal (caddr (car box-width-intervals)) 2)))))
(ert-deftest tp-test-get-range-with-list-prop-path ()
"Test tp-get with property path as list.
@ -1205,5 +1217,27 @@ Returns list of (START END VALUE) intervals."
(should (equal (tp-get 0 5 '(face :foreground) str) '((0 5 "red"))))
(should (equal (tp-get 0 5 '(face :underline :style) str) '((0 5 wave))))))
(ert-deftest tp-test-get-entire-string-with-list-prop-path ()
"Test tp-get with property path as list on entire string.
Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello World Hello")))
(put-text-property 0 5 'face '(:foreground "red") str)
(put-text-property 12 17 'face '(:foreground "blue") str)
;; Get with list path for entire string
(let ((intervals (tp-get str '(face :foreground))))
(should (= (length intervals) 2))
(should (equal (car intervals) '(0 5 "red")))
(should (equal (cadr intervals) '(12 17 "blue"))))))
(ert-deftest tp-test-get-entire-string-multiple-intervals ()
"Test tp-get returns multiple intervals from entire string."
(let ((str (copy-sequence "Hello World Hello")))
(tp-set 0 5 '(face bold) str)
(tp-set 12 17 '(face italic) str)
(let ((intervals (tp-get str 'face)))
(should (= (length intervals) 2))
(should (equal (car intervals) '(0 5 bold)))
(should (equal (cadr intervals) '(12 17 italic))))))
(provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here

71
tp.el
View File

@ -457,7 +457,7 @@ This function supports multiple calling conventions:
5. Range, nested sub-property:
(tp-get START END PROPERTY SUB-KEY ...)
6. Range, all properties (returns plist):
6. Range, all properties:
(tp-get START END)
(tp-get START END OBJECT)
@ -473,25 +473,70 @@ This function supports multiple calling conventions:
(tp-get str \\='face :underline)
(tp-get str \\='face :underline :style)
10. Entire string with property path as list:
(tp-get STRING \\='(PROPERTY SUB-KEY ...))
(tp-get str \\='(face :foreground))
For range and entire string queries, returns a list of (START END VALUE)
intervals, allowing you to see all property values across the range.
For single position queries, returns the property value at that position.
For buffers, positions are 1-indexed.
For strings, positions are 0-indexed.
OBJECT defaults to current buffer."
(cond
;; (tp-get STRING ...) - entire string
;; Note: When getting properties from an entire string, we sample from
;; position 0. This assumes the string has uniform properties across its
;; length, which is the common case for strings created with tp-set.
;; Returns list of (START END VALUE) intervals for all property values
((stringp pos-or-start-or-string)
(let ((str pos-or-start-or-string))
(if (null property-or-end)
;; (tp-get str) - return all properties
(text-properties-at 0 str)
;; (tp-get str 'face ...) - get specific property with optional sub-path
(let* ((prop-value (get-text-property 0 property-or-end str))
(sub-path args))
(if sub-path
(let* ((str pos-or-start-or-string)
(len (length str))
(property nil)
(sub-path nil))
(cond
;; (tp-get str) - return all property intervals
((null property-or-end)
(let ((intervals nil)
(pos 0))
(while (< pos len)
(let* ((current-props (text-properties-at pos str))
(next-pos (or (next-property-change pos str len) len)))
(when current-props
(push (list pos next-pos current-props) intervals))
(setq pos next-pos)))
(nreverse intervals)))
;; (tp-get str '(face :foreground)) - property path as list
((listp property-or-end)
(setq property (car property-or-end))
(setq sub-path (cdr property-or-end))
(let ((intervals nil)
(pos 0))
(while (< pos len)
(let* ((prop-value (get-text-property pos property str))
(next-pos (or (next-single-property-change pos property str len) len))
(value (if sub-path
(tp--get-nested prop-value sub-path)
prop-value)))))
prop-value)))
(when value
(push (list pos next-pos value) intervals))
(setq pos next-pos)))
(nreverse intervals)))
;; (tp-get str 'face ...) - property as symbol with optional sub-path
((symbolp property-or-end)
(setq property property-or-end)
(setq sub-path args)
(let ((intervals nil)
(pos 0))
(while (< pos len)
(let* ((prop-value (get-text-property pos property str))
(next-pos (or (next-single-property-change pos property str len) len))
(value (if sub-path
(tp--get-nested prop-value sub-path)
prop-value)))
(when value
(push (list pos next-pos value) intervals))
(setq pos next-pos)))
(nreverse intervals))))))
;; (tp-get POS PROP ...) or (tp-get POS PROP OBJECT) - single position with symbol property
((and (numberp pos-or-start-or-string)
(symbolp property-or-end))