diff --git a/README.md b/README.md index 346fbb8..437160c 100644 --- a/README.md +++ b/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")) ``` --- diff --git a/README_CN.md b/README_CN.md index 04defe7..30f8e67 100644 --- a/README_CN.md +++ b/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")) ``` --- diff --git a/tp-tests.el b/tp-tests.el index 314b0c0..fd9aa28 100644 --- a/tp-tests.el +++ b/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 diff --git a/tp.el b/tp.el index 6990d23..91463d9 100644 --- a/tp.el +++ b/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))