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:
parent
932585da3f
commit
b31077e486
14
README.md
14
README.md
@ -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"))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
14
README_CN.md
14
README_CN.md
@ -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"))
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
56
tp-tests.el
56
tp-tests.el
@ -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)))
|
||||
(should (eq (plist-get props 'face) 'bold))
|
||||
(should (equal (plist-get props 'help-echo) "test")))))
|
||||
(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"))))))
|
||||
|
||||
(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
|
||||
|
||||
73
tp.el
73
tp.el
@ -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
|
||||
(tp--get-nested prop-value sub-path)
|
||||
prop-value)))))
|
||||
(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)))
|
||||
(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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user