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

Fix tp-get to return intervals and tp-match/tp-regexp string parsing

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-14 13:50:45 +00:00
parent 13b73b1dbc
commit 932585da3f
4 changed files with 128 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
README.md
View File

@ -294,6 +294,8 @@ 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.
```elisp
;; Single position
(tp-get POSITION PROPERTY)
@ -302,7 +304,7 @@ Get property value(s) from position or range, with support for nested sub-proper
;; Nested sub-property access
(tp-get POSITION PROPERTY SUB-KEY ...)
;; Range - specific property
;; Range - specific property (returns list of intervals)
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
@ -310,7 +312,7 @@ Get property value(s) from position or range, with support for nested sub-proper
(tp-get START END '(PROPERTY) OBJECT)
(tp-get START END '(PROPERTY SUB-KEY ...) OBJECT)
;; Range - all properties
;; Range - all properties (returns list of intervals)
(tp-get START END)
(tp-get START END OBJECT)
@ -334,18 +336,23 @@ Get property value(s) from position or range, with support for nested sub-proper
;; Get from string (0-indexed)
(tp-get 0 'face my-string) ; => italic
;; Get from range
(tp-get 1 10 'face) ; => bold
;; Get from range - returns list of (START END VALUE) intervals
(tp-get 1 10 'face) ; => ((1 6 bold))
;; Get with multiple intervals
(tp-set 0 5 '(face bold) str)
(tp-set 12 17 '(face italic) str)
(tp-get 0 17 'face str) ; => ((0 5 bold) (12 17 italic))
;; Get with property path as list
(tp-get 5 20 '(face :underline :style) my-string)
(tp-get 5 20 '(face :underline :style) my-string) ; => ((5 20 wave))
;; Get all properties from range
(tp-get 1 10) ; => (face bold help-echo "test")
(tp-get 1 10) ; => ((1 6 (face bold help-echo "test")))
;; Get from entire string
(tp-get "Hello World") ; => all properties
(tp-get "Hello World" 'face) ; => face value
(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
```

23
README_CN.md
View File

@ -293,6 +293,8 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
从位置或范围获取属性值，支持嵌套子属性访问。
对于范围查询，返回 `(START END VALUE)` 区间列表，让你可以查看范围内所有的属性值。
```elisp
;; 单个位置
(tp-get POSITION PROPERTY)
@ -301,7 +303,7 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
;; 嵌套子属性访问
(tp-get POSITION PROPERTY SUB-KEY ...)
;; 范围 - 特定属性
;; 范围 - 特定属性（返回区间列表）
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
@ -309,7 +311,7 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
(tp-get START END '(PROPERTY) OBJECT)
(tp-get START END '(PROPERTY SUB-KEY ...) OBJECT)
;; 范围 - 所有属性
;; 范围 - 所有属性（返回区间列表）
(tp-get START END)
(tp-get START END OBJECT)
@ -333,18 +335,23 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
;; 从字符串获取（0 索引）
(tp-get 0 'face my-string) ; => italic
;; 从范围获取
(tp-get 1 10 'face) ; => bold
;; 从范围获取 - 返回 (START END VALUE) 区间列表
(tp-get 1 10 'face) ; => ((1 6 bold))
;; 获取多个区间
(tp-set 0 5 '(face bold) str)
(tp-set 12 17 '(face italic) str)
(tp-get 0 17 'face str) ; => ((0 5 bold) (12 17 italic))
;; 使用列表形式的属性路径
(tp-get 5 20 '(face :underline :style) my-string)
(tp-get 5 20 '(face :underline :style) my-string) ; => ((5 20 wave))
;; 获取范围内的所有属性
(tp-get 1 10) ; => (face bold help-echo "test")
(tp-get 1 10) ; => ((1 6 (face bold help-echo "test")))
;; 从整个字符串获取
(tp-get "Hello World") ; => 所有属性
(tp-get "Hello World" 'face) ; => face 值
(tp-get "Hello World") ; => 位置 0 处的所有属性
(tp-get "Hello World" 'face) ; => 位置 0 处的 face 值
(tp-get "Hello World" 'face :foreground) ; => 前景色
```

70
tp-tests.el
View File

@ -767,27 +767,31 @@
(should (eq (tp-get 3 'face) 'bold))))
(ert-deftest tp-test-get-range-property ()
"Test tp-get with range and specific property."
"Test tp-get with range and specific property.
Returns list of (START END VALUE) intervals."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-put 1 6 '(face bold))
(should (eq (tp-get 1 6 'face) 'bold))
(should (equal (tp-get 1 6 'face) '((1 6 bold))))
(should (null (tp-get 7 12 'face)))))
(ert-deftest tp-test-get-range-all-properties ()
"Test tp-get with range returns all properties."
"Test tp-get with range returns all property intervals."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-put 1 6 '(face bold help-echo "test"))
(let ((props (tp-get 1 6)))
(should (eq (plist-get props 'face) 'bold))
(should (equal (plist-get props 'help-echo) "test")))))
(let ((intervals (tp-get 1 6)))
(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-range-on-string ()
"Test tp-get with range on string object."
"Test tp-get with range on string object.
Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello World")))
(tp-put 0 5 '(face bold) str)
(should (eq (tp-get 0 5 'face str) 'bold))
(should (equal (tp-get 0 5 'face str) '((0 5 bold))))
(should (null (tp-get 6 11 'face str)))))
;;; ============================================================
@ -1048,6 +1052,34 @@
(should (eq (get-text-property 4 'face str) 'bold))
(should (equal (get-text-property 4 'help-echo str) "original"))))
(ert-deftest tp-test-match-string-as-last-arg ()
"Test tp-match with string as last argument."
(let ((str (copy-sequence "Hello World Hello")))
(let ((result (tp-match "Hello" '(face bold) str)))
(should (stringp result))
(should (eq (get-text-property 0 'face result) 'bold))
(should (eq (get-text-property 12 'face result) 'bold))
(should (null (get-text-property 6 'face result))))))
(ert-deftest tp-test-regexp-string-as-last-arg ()
"Test tp-regexp with string as last argument."
(let ((str (copy-sequence "abc 123 def 456")))
(let ((result (tp-regexp "[0-9]+" '(face italic) str)))
(should (stringp result))
(should (eq (get-text-property 4 'face result) 'italic))
(should (eq (get-text-property 12 'face result) 'italic))
(should (null (get-text-property 0 'face result))))))
(ert-deftest tp-test-get-range-multiple-intervals ()
"Test tp-get returns all property intervals in a range."
(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 0 17 'face str)))
(should (= (length intervals) 2))
(should (equal (car intervals) '(0 5 bold)))
(should (equal (cadr intervals) '(12 17 italic))))))
;;; ============================================================
;;; New API Tests - Issue 1: tp-add face prepending
;;; ============================================================
@ -1153,23 +1185,25 @@
(should (equal (tp-get str 'face :box :line-width) 2))))
(ert-deftest tp-test-get-range-with-list-prop-path ()
"Test tp-get with property path as list."
"Test tp-get with property path as list.
Returns list of (START END VALUE) intervals."
(tp-test-with-temp-buffer
(insert "Hello World")
(put-text-property 1 6 'face '(:foreground "red" :underline (:style wave)) nil)
;; Get with list path
(should (equal (tp-get 1 6 '(face)) '(:foreground "red" :underline (:style wave))))
(should (equal (tp-get 1 6 '(face :foreground)) "red"))
(should (eq (tp-get 1 6 '(face :underline :style)) 'wave))))
;; Get with list path - returns intervals
(should (equal (tp-get 1 6 '(face)) '((1 6 (:foreground "red" :underline (:style wave))))))
(should (equal (tp-get 1 6 '(face :foreground)) '((1 6 "red"))))
(should (equal (tp-get 1 6 '(face :underline :style)) '((1 6 wave))))))
(ert-deftest tp-test-get-range-with-list-prop-path-on-string ()
"Test tp-get with property path as list on string."
"Test tp-get with property path as list on string.
Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello World")))
(put-text-property 0 5 'face '(:foreground "red" :underline (:style wave)) str)
;; Get with list path and object
(should (equal (tp-get 0 5 '(face) str) '(:foreground "red" :underline (:style wave))))
(should (equal (tp-get 0 5 '(face :foreground) str) "red"))
(should (eq (tp-get 0 5 '(face :underline :style) str) 'wave))))
;; Get with list path and object - returns intervals
(should (equal (tp-get 0 5 '(face) str) '((0 5 (:foreground "red" :underline (:style wave))))))
(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))))))
(provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here

66
tp.el
View File

@ -543,27 +543,30 @@ OBJECT defaults to current buffer."
((or (bufferp (car rest-args)) (stringp (car rest-args)))
(setq object (car rest-args)))))
(if property
;; Get specific property from range - return first non-nil value
;; Get specific property from range - return list of (START END VALUE) for all intervals
(let ((pos start)
(result nil))
(while (and (< pos end) (null result))
(let ((prop-value (get-text-property pos property object)))
(setq result (if sub-path
(tp--get-nested prop-value sub-path)
prop-value)))
(setq pos (next-single-property-change pos property object end)))
result)
;; Get all properties from range - merge into plist
(let ((props nil)
(intervals nil))
(while (< pos end)
(let* ((prop-value (get-text-property pos property object))
(next-pos (or (next-single-property-change pos property object end) end))
(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))
;; Get all properties from range - return list of (START END PLIST) intervals
(let ((intervals nil)
(pos start)
(obj (or object (current-buffer))))
(while (< pos end)
(let ((current-props (text-properties-at pos obj)))
(cl-loop for (key val) on current-props by #'cddr
do (unless (plist-member props key)
(setq props (plist-put props key val)))))
(setq pos (next-single-property-change pos nil obj end)))
props))))
(let* ((current-props (text-properties-at pos obj))
(next-pos (or (next-property-change pos obj end) end)))
(when current-props
(push (list pos next-pos current-props) intervals))
(setq pos next-pos)))
(nreverse intervals)))))
(t (error "Invalid arguments to tp-get"))))
;;; Fine-grained property manipulation for nested properties
@ -1223,7 +1226,10 @@ Returns modified object or list of regions."
(defun tp--parse-match-args (args)
"Parse match/regexp function ARGS.
Returns (OBJECT . PROPERTIES)."
Returns (OBJECT . PROPERTIES).
Handles two calling conventions:
1. (OBJECT PROPERTY VALUE ...) or (OBJECT \\='(PROPERTY VALUE ...))
2. (\\='(PROPERTY VALUE ...) OBJECT) or (PROPERTY VALUE ... OBJECT)"
(let (object properties)
(cond
;; First arg is a string - it's the object
@ -1234,12 +1240,32 @@ Returns (OBJECT . PROPERTIES)."
((and args (bufferp (car args)))
(setq object (car args)
properties (cdr args)))
;; First arg is a list (properties) and last arg might be object
((and args (listp (car args)))
(let ((last-arg (car (last args))))
(if (or (stringp last-arg) (bufferp last-arg))
;; Last arg is object: '(props) object
(setq object last-arg
properties (car args))
;; No object, just properties
(setq object nil
properties (car args)))))
;; Check if last arg is an object (for flat property args)
((and args (>= (length args) 2))
(let ((last-arg (car (last args))))
(if (or (stringp last-arg) (bufferp last-arg))
;; Last arg is object: prop val ... object
(setq object last-arg
properties (butlast args))
;; No object, all are properties
(setq object nil
properties args))))
;; No object specified
(t
(setq object nil
properties args)))
;; Handle properties as a list
(when (listp (car-safe properties))
;; Handle properties as a list (normalize)
(when (and (listp (car-safe properties)) (= (length properties) 1))
(setq properties (car properties)))
(cons object properties)))