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

Implement new text property search and navigation functions

Browse Source 
- Modified tp-empty-p to support optional OBJECT parameter (nil = current buffer)
- Modified tp-plist to support two formats: (tp-plist start end &optional OBJECT) and (tp-plist string)
- Added tp-forward and tp-backward with new API (property &optional value object n)
- Added tp-forward-do and tp-backward-do for applying functions to matches
- Added tp-search for searching all matching properties in range or string
- Added tp-search-do for executing function on all matches
- Updated documentation (README.md and README_CN.md)
- Updated test cases (tp-tests.el)
- Removed obsolete function references (tp-next, tp-prev, tp-goto-next, tp-goto-prev, tp-in, tp-all, tp-regions-map, tp-strings-map)

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-15 07:35:41 +00:00
parent b9dc821250
commit 11e6201bc1
4 changed files with 646 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

220
README.md
View File

@ -86,20 +86,18 @@ A complete overview of all tp.el functions organized by category:
#### Search & Navigation Functions #### Search & Navigation Functions
| Function | Description | | Function | Description |
|----------|-------------| |----------|-------------|
| [`tp-forward`](#tp-forward--tp-backward) | Search forward for text with property | | [`tp-search-forward`](#tp-search-forward--tp-search-backward) | Raw wrapper for text-property-search-forward |
| [`tp-backward`](#tp-forward--tp-backward) | Search backward for text with property | | [`tp-search-backward`](#tp-search-forward--tp-search-backward) | Raw wrapper for text-property-search-backward |
| [`tp-next`](#tp-next--tp-prev) | Get next position with text properties | | [`tp-forward`](#tp-forward--tp-backward) | Search forward N times for text with property |
| [`tp-prev`](#tp-next--tp-prev) | Get previous position with text properties | | [`tp-backward`](#tp-forward--tp-backward) | Search backward N times for text with property |
| [`tp-goto-next`](#tp-goto-next--tp-goto-prev) | Move point to next text with property | | [`tp-forward-do`](#tp-forward-do--tp-backward-do) | Apply function to N forward matches |
| [`tp-goto-prev`](#tp-goto-next--tp-goto-prev) | Move point to previous text with property | | [`tp-backward-do`](#tp-forward-do--tp-backward-do) | Apply function to N backward matches |
| [`tp-regions-map`](#tp-regions-map--tp-strings-map) | Apply function to all regions with property | | [`tp-search`](#tp-search---search-all-matches) | Search all matching properties in range or string |
| [`tp-strings-map`](#tp-regions-map--tp-strings-map) | Apply function to all strings with property | | [`tp-search-do`](#tp-search-do---apply-function-to-all-matches) | Apply function to all matching properties |
#### Query Functions #### Query Functions
| Function | Description | | Function | Description |
|----------|-------------| |----------|-------------|
| [`tp-in`](#tp-in---find-regions-with-property) | Find all regions with a specific property |
| [`tp-all`](#tp-all---get-all-propertized-regions) | Get all propertized regions |
| [`tp-intervals`](#tp-intervals---get-property-intervals) | Get property intervals in a region | | [`tp-intervals`](#tp-intervals---get-property-intervals) | Get property intervals in a region |
| [`tp-empty-p`](#tp-empty-p---check-for-properties) | Check if object has no properties | | [`tp-empty-p`](#tp-empty-p---check-for-properties) | Check if object has no properties |
| [`tp-plist`](#tp-plist---get-merged-properties) | Get merged plist of all properties | | [`tp-plist`](#tp-plist---get-merged-properties) | Get merged plist of all properties |
@ -552,14 +550,31 @@ Add/merge properties on regexp matches with deep merge support.
### Search & Navigation Functions ### Search & Navigation Functions
#### `tp-search-forward` / `tp-search-backward`
```elisp
(tp-search-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT)
(tp-search-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT)
```
Raw wrappers for Emacs's `text-property-search-forward` and `text-property-search-backward`.
These are low-level search functions that work directly with prop-match objects.
---
#### `tp-forward` / `tp-backward` #### `tp-forward` / `tp-backward`
```elisp ```elisp
(tp-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) (tp-forward PROPERTY &optional VALUE OBJECT N)
(tp-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) (tp-backward PROPERTY &optional VALUE OBJECT N)
``` ```
Search forward/backward for text with PROPERTY. Search forward/backward N times for text with PROPERTY.
- **N** is the number of searches, defaulting to 1.
- **VALUE** is the optional value to match.
- **OBJECT** can be a buffer; nil defaults to current buffer.
- Returns the prop-match object from the last successful search.
**Examples:** **Examples:**
@ -569,86 +584,105 @@ Search forward/backward for text with PROPERTY.
;; Find next text where 'type equals 'heading ;; Find next text where 'type equals 'heading
(tp-forward 'type 'heading) (tp-forward 'type 'heading)
;; Search forward 3 times
(tp-forward 'marker nil nil 3)
``` ```
--- ---
#### `tp-next` / `tp-prev` #### `tp-forward-do` / `tp-backward-do`
```elisp ```elisp
(tp-next &optional POINT PROPERTY VALUE) (tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT N)
(tp-prev &optional POINT PROPERTY VALUE) (tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT N)
``` ```
Get the next/previous position with text properties. Search forward/backward N times for text with PROPERTY and apply FUNCTION to each match.
--- - **FUNCTION** receives two arguments: the prop-match object and OBJECT.
- **N** is the number of searches, defaulting to 1.
#### `tp-goto-next` / `tp-goto-prev` - Returns the number of successful matches.
```elisp
(tp-goto-next &optional PROPERTY VALUE)
(tp-goto-prev &optional PROPERTY VALUE)
```
Move point to next/previous text with PROPERTY.
---
#### `tp-regions-map` / `tp-strings-map`
```elisp
(tp-regions-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT)
(tp-strings-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT)
```
Apply a function to all regions/strings with PROPERTY.
**Examples:** **Examples:**
```elisp ```elisp
;; Upcase all marked text ;; Apply function to next 3 markers
(tp-strings-map (tp-forward-do
(lambda (str idx) (lambda (match obj)
(message "Found: %s at index %d" str idx)) (message "Found at %d" (prop-match-beginning match)))
'marker) 'marker nil nil 3)
```
---
#### `tp-search` - Search All Matches
```elisp
;; Buffer/string region
(tp-search START END PROPERTY &optional VALUE OBJECT)
;; Entire string
(tp-search STRING PROPERTY &optional VALUE)
```
Search for all text with PROPERTY in a buffer/string range or entire string.
Returns a list of (START END VALUE) for all matching regions.
**Examples:**
```elisp
;; Find all 'marker properties in buffer range
(tp-search 1 100 'marker)
;; => ((5 10 t) (20 25 t) ...)
;; Find all 'type properties with value 'heading in string
(tp-search my-string 'type 'heading)
;; => ((0 10 heading) (50 60 heading) ...)
;; Filter by value
(tp-search 1 100 'type 'heading)
```
---
#### `tp-search-do` - Apply Function to All Matches
```elisp
;; Buffer/string region
(tp-search-do FUNCTION START END PROPERTY &optional VALUE OBJECT)
;; Entire string
(tp-search-do FUNCTION STRING PROPERTY &optional VALUE)
```
Execute FUNCTION on all matches of PROPERTY in a buffer/string range or entire string.
- **FUNCTION** receives two arguments: the match (list of START END VALUE) and OBJECT.
- Returns the number of matches processed.
**Examples:**
```elisp
;; Process all markers in buffer range
(tp-search-do
(lambda (match obj)
(message "Found at %d-%d with value %s"
(car match) (cadr match) (caddr match)))
1 100 'marker)
;; Process all headings in string
(tp-search-do
(lambda (match obj)
(upcase (substring obj (car match) (cadr match))))
my-string 'type 'heading)
``` ```
--- ---
### Query Functions ### Query Functions
#### `tp-in` - Find Regions with Property
```elisp
(tp-in PROPERTY &optional VALUE START END)
```
Get all regions with PROPERTY in current buffer.
**Examples:**
```elisp
;; Get all regions with 'marker property
(tp-in 'marker)
;; => ((1 5 (marker t ...)) (10 15 (marker t ...)))
;; Filter by value
(tp-in 'type 'heading)
```
---
#### `tp-all` - Get All Propertized Regions
```elisp
(tp-all &optional START END)
```
Get all regions with any text properties.
---
#### `tp-intervals` - Get Property Intervals #### `tp-intervals` - Get Property Intervals
```elisp ```elisp
@ -662,20 +696,54 @@ Get all text property intervals in a region.
#### `tp-empty-p` - Check for Properties #### `tp-empty-p` - Check for Properties
```elisp ```elisp
(tp-empty-p OBJECT) (tp-empty-p &optional OBJECT)
``` ```
Return t if OBJECT has no text properties. Return t if OBJECT has no text properties.
- **OBJECT** can be a string or buffer; nil defaults to current buffer.
**Examples:**
```elisp
;; Check current buffer
(tp-empty-p)
(tp-empty-p nil)
;; Check specific string
(tp-empty-p "plain string") ; => t
(tp-empty-p (propertize "styled" 'face 'bold)) ; => nil
;; Check specific buffer
(tp-empty-p my-buffer)
```
--- ---
#### `tp-plist` - Get Merged Properties #### `tp-plist` - Get Merged Properties
```elisp ```elisp
;; Buffer/string region
(tp-plist START END &optional OBJECT) (tp-plist START END &optional OBJECT)
;; Entire string
(tp-plist STRING)
``` ```
Get a merged plist of all properties in a region. Get a merged plist of all properties in a region or entire string.
**Examples:**
```elisp
;; Get properties from buffer region
(tp-plist 1 10)
;; Get properties from string region
(tp-plist 0 5 my-string)
;; Get properties from entire string
(tp-plist my-string)
```
--- ---

220
README_CN.md
View File

@ -85,20 +85,18 @@ tp.el 所有函数按类别组织的完整概览：
#### 搜索和导航函数 #### 搜索和导航函数
| 函数 | 描述 | | 函数 | 描述 |
|------|------| |------|------|
| [`tp-forward`](#tp-forward--tp-backward) | 向前搜索具有属性的文本 | | [`tp-search-forward`](#tp-search-forward--tp-search-backward) | text-property-search-forward 的原始包装 |
| [`tp-backward`](#tp-forward--tp-backward) | 向后搜索具有属性的文本 | | [`tp-search-backward`](#tp-search-forward--tp-search-backward) | text-property-search-backward 的原始包装 |
| [`tp-next`](#tp-next--tp-prev) | 获取下一个具有文本属性的位置 | | [`tp-forward`](#tp-forward--tp-backward) | 向前搜索 N 次具有属性的文本 |
| [`tp-prev`](#tp-next--tp-prev) | 获取上一个具有文本属性的位置 | | [`tp-backward`](#tp-forward--tp-backward) | 向后搜索 N 次具有属性的文本 |
| [`tp-goto-next`](#tp-goto-next--tp-goto-prev) | 移动光标到下一个具有属性的文本 | | [`tp-forward-do`](#tp-forward-do--tp-backward-do) | 对 N 个向前匹配应用函数 |
| [`tp-goto-prev`](#tp-goto-next--tp-goto-prev) | 移动光标到上一个具有属性的文本 | | [`tp-backward-do`](#tp-forward-do--tp-backward-do) | 对 N 个向后匹配应用函数 |
| [`tp-regions-map`](#tp-regions-map--tp-strings-map) | 对所有具有属性的区域应用函数 | | [`tp-search`](#tp-search---搜索所有匹配) | 在范围或字符串中搜索所有匹配的属性 |
| [`tp-strings-map`](#tp-regions-map--tp-strings-map) | 对所有具有属性的字符串应用函数 | | [`tp-search-do`](#tp-search-do---对所有匹配应用函数) | 对所有匹配的属性应用函数 |
#### 查询函数 #### 查询函数
| 函数 | 描述 | | 函数 | 描述 |
|------|------| |------|------|
| [`tp-in`](#tp-in---查找具有属性的区域) | 查找所有具有特定属性的区域 |
| [`tp-all`](#tp-all---获取所有带属性的区域) | 获取所有带属性的区域 |
| [`tp-intervals`](#tp-intervals---获取属性区间) | 获取区域中的属性区间 | | [`tp-intervals`](#tp-intervals---获取属性区间) | 获取区域中的属性区间 |
| [`tp-empty-p`](#tp-empty-p---检查属性) | 检查对象是否没有属性 | | [`tp-empty-p`](#tp-empty-p---检查属性) | 检查对象是否没有属性 |
| [`tp-plist`](#tp-plist---获取合并的属性) | 获取所有属性的合并列表 | | [`tp-plist`](#tp-plist---获取合并的属性) | 获取所有属性的合并列表 |
@ -551,14 +549,31 @@ tp.el 所有函数按类别组织的完整概览：
### 搜索和导航函数 ### 搜索和导航函数
#### `tp-search-forward` / `tp-search-backward`
```elisp
(tp-search-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT)
(tp-search-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT)
```
Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的原始包装。
这些是直接使用 prop-match 对象的底层搜索函数。
---
#### `tp-forward` / `tp-backward` #### `tp-forward` / `tp-backward`
```elisp ```elisp
(tp-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) (tp-forward PROPERTY &optional VALUE OBJECT N)
(tp-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) (tp-backward PROPERTY &optional VALUE OBJECT N)
``` ```
向前/向后搜索具有 PROPERTY 的文本。 向前/向后搜索 N 次具有 PROPERTY 的文本。
- **N** 是搜索次数，默认为 1。
- **VALUE** 是可选的匹配值。
- **OBJECT** 可以是缓冲区；nil 默认为当前缓冲区。
- 返回最后一次成功搜索的 prop-match 对象。
**示例：** **示例：**
@ -568,86 +583,105 @@ tp.el 所有函数按类别组织的完整概览：
;; 查找下一个 'type 等于 'heading 的文本 ;; 查找下一个 'type 等于 'heading 的文本
(tp-forward 'type 'heading) (tp-forward 'type 'heading)
;; 向前搜索 3 次
(tp-forward 'marker nil nil 3)
``` ```
--- ---
#### `tp-next` / `tp-prev` #### `tp-forward-do` / `tp-backward-do`
```elisp ```elisp
(tp-next &optional POINT PROPERTY VALUE) (tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT N)
(tp-prev &optional POINT PROPERTY VALUE) (tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT N)
``` ```
获取下一个/上一个具有文本属性的位置。 向前/向后搜索 N 次具有 PROPERTY 的文本，并对每个匹配应用 FUNCTION。
--- - **FUNCTION** 接收两个参数：prop-match 对象和 OBJECT。
- **N** 是搜索次数，默认为 1。
#### `tp-goto-next` / `tp-goto-prev` - 返回成功匹配的数量。
```elisp
(tp-goto-next &optional PROPERTY VALUE)
(tp-goto-prev &optional PROPERTY VALUE)
```
将光标移动到下一个/上一个具有 PROPERTY 的文本。
---
#### `tp-regions-map` / `tp-strings-map`
```elisp
(tp-regions-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT)
(tp-strings-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT)
```
对所有具有 PROPERTY 的区域/字符串应用函数。
**示例：** **示例：**
```elisp ```elisp
;; 处理所有标记的文本 ;; 对下 3 个 marker 应用函数
(tp-strings-map (tp-forward-do
(lambda (str idx) (lambda (match obj)
(message "找到: %s，索引 %d" str idx)) (message "在 %d 处找到" (prop-match-beginning match)))
'marker) 'marker nil nil 3)
```
---
#### `tp-search` - 搜索所有匹配
```elisp
;; 缓冲区/字符串区域
(tp-search START END PROPERTY &optional VALUE OBJECT)
;; 整个字符串
(tp-search STRING PROPERTY &optional VALUE)
```
在缓冲区/字符串范围或整个字符串中搜索所有具有 PROPERTY 的文本。
返回所有匹配区域的 (START END VALUE) 列表。
**示例：**
```elisp
;; 在缓冲区范围内查找所有 'marker 属性
(tp-search 1 100 'marker)
;; => ((5 10 t) (20 25 t) ...)
;; 在字符串中查找所有值为 'heading 的 'type 属性
(tp-search my-string 'type 'heading)
;; => ((0 10 heading) (50 60 heading) ...)
;; 按值过滤
(tp-search 1 100 'type 'heading)
```
---
#### `tp-search-do` - 对所有匹配应用函数
```elisp
;; 缓冲区/字符串区域
(tp-search-do FUNCTION START END PROPERTY &optional VALUE OBJECT)
;; 整个字符串
(tp-search-do FUNCTION STRING PROPERTY &optional VALUE)
```
在缓冲区/字符串范围或整个字符串中对所有 PROPERTY 匹配执行 FUNCTION。
- **FUNCTION** 接收两个参数：匹配（START END VALUE 列表）和 OBJECT。
- 返回处理的匹配数量。
**示例：**
```elisp
;; 处理缓冲区范围内的所有 marker
(tp-search-do
(lambda (match obj)
(message "在 %d-%d 处找到，值为 %s"
(car match) (cadr match) (caddr match)))
1 100 'marker)
;; 处理字符串中的所有标题
(tp-search-do
(lambda (match obj)
(upcase (substring obj (car match) (cadr match))))
my-string 'type 'heading)
``` ```
--- ---
### 查询函数 ### 查询函数
#### `tp-in` - 查找具有属性的区域
```elisp
(tp-in PROPERTY &optional VALUE START END)
```
获取当前缓冲区中所有具有 PROPERTY 的区域。
**示例：**
```elisp
;; 获取所有具有 'marker 属性的区域
(tp-in 'marker)
;; => ((1 5 (marker t ...)) (10 15 (marker t ...)))
;; 按值过滤
(tp-in 'type 'heading)
```
---
#### `tp-all` - 获取所有带属性的区域
```elisp
(tp-all &optional START END)
```
获取所有具有任何文本属性的区域。
---
#### `tp-intervals` - 获取属性区间 #### `tp-intervals` - 获取属性区间
```elisp ```elisp
@ -661,20 +695,54 @@ tp.el 所有函数按类别组织的完整概览：
#### `tp-empty-p` - 检查属性 #### `tp-empty-p` - 检查属性
```elisp ```elisp
(tp-empty-p OBJECT) (tp-empty-p &optional OBJECT)
``` ```
如果 OBJECT 没有文本属性则返回 t。 如果 OBJECT 没有文本属性则返回 t。
- **OBJECT** 可以是字符串或缓冲区；nil 默认为当前缓冲区。
**示例：**
```elisp
;; 检查当前缓冲区
(tp-empty-p)
(tp-empty-p nil)
;; 检查特定字符串
(tp-empty-p "plain string") ; => t
(tp-empty-p (propertize "styled" 'face 'bold)) ; => nil
;; 检查特定缓冲区
(tp-empty-p my-buffer)
```
--- ---
#### `tp-plist` - 获取合并的属性 #### `tp-plist` - 获取合并的属性
```elisp ```elisp
;; 缓冲区/字符串区域
(tp-plist START END &optional OBJECT) (tp-plist START END &optional OBJECT)
;; 整个字符串
(tp-plist STRING)
``` ```
获取区域中所有属性的合并属性列表。 获取区域或整个字符串中所有属性的合并属性列表。
**示例：**
```elisp
;; 从缓冲区区域获取属性
(tp-plist 1 10)
;; 从字符串区域获取属性
(tp-plist 0 5 my-string)
;; 从整个字符串获取属性
(tp-plist my-string)
```
--- ---

225
tp-tests.el
View File

@ -119,6 +119,23 @@
(should (eq (plist-get props 'face) 'bold)) (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-plist-on-string ()
"Test tp-plist works on entire string."
(let ((str (tp-set "Hello World" 'face 'bold 'help-echo "test")))
(let ((props (tp-plist str)))
(should (eq (plist-get props 'face) 'bold))
(should (equal (plist-get props 'help-echo) "test")))))
(ert-deftest tp-test-plist-on-string-range ()
"Test tp-plist works on string range with object parameter."
(let ((str (copy-sequence "Hello World")))
(tp-set 0 5 '(face bold) str)
(tp-set 6 11 '(help-echo "test") str)
(let ((props-start (tp-plist 0 5 str))
(props-end (tp-plist 6 11 str)))
(should (eq (plist-get props-start 'face) 'bold))
(should (equal (plist-get props-end 'help-echo) "test")))))
;;; ============================================================ ;;; ============================================================
;;; Text Property Interval Tests ;;; Text Property Interval Tests
;;; ============================================================ ;;; ============================================================
@ -128,6 +145,29 @@
(should (tp-empty-p "plain string")) (should (tp-empty-p "plain string"))
(should-not (tp-empty-p (propertize "styled" 'face 'bold)))) (should-not (tp-empty-p (propertize "styled" 'face 'bold))))
(ert-deftest tp-test-empty-p-with-nil ()
"Test tp-empty-p with nil (current buffer)."
(tp-test-with-temp-buffer
(insert "Hello World")
;; Empty buffer (no properties)
(should (tp-empty-p nil))
(should (tp-empty-p))
;; Add properties
(tp-set 1 6 '(face bold))
(should-not (tp-empty-p nil))
(should-not (tp-empty-p))))
(ert-deftest tp-test-empty-p-with-buffer ()
"Test tp-empty-p with explicit buffer object."
(tp-test-with-temp-buffer
(insert "Hello World")
(let ((buf (current-buffer)))
;; Empty (no properties)
(should (tp-empty-p buf))
;; Add properties
(tp-set 1 6 '(face bold))
(should-not (tp-empty-p buf)))))
(ert-deftest tp-test-intervals () (ert-deftest tp-test-intervals ()
"Test tp-intervals returns property intervals." "Test tp-intervals returns property intervals."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
@ -517,6 +557,19 @@
(should match) (should match)
(should (= (prop-match-beginning match) 7))))) (should (= (prop-match-beginning match) 7)))))
(ert-deftest tp-test-forward-with-n ()
"Test tp-forward with N parameter."
(tp-test-with-temp-buffer
(insert "Hello World Test Again")
(tp-set 1 6 '(face bold))
(tp-set 7 12 '(face italic))
(tp-set 13 17 '(face bold))
(goto-char 1)
(skip-unless (fboundp 'text-property-search-forward))
;; Search twice should find third match
(let ((match (tp-forward 'face nil nil 2)))
(should match))))
(ert-deftest tp-test-backward () (ert-deftest tp-test-backward ()
"Test tp-backward finds previous property." "Test tp-backward finds previous property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
@ -530,98 +583,102 @@
(should match) (should match)
(should (= (prop-match-beginning match) 1))))) (should (= (prop-match-beginning match) 1)))))
(ert-deftest tp-test-next () (ert-deftest tp-test-forward-do ()
"Test tp-next returns next position with property." "Test tp-forward-do applies function to matches."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World Test")
(tp-set 7 12 '(face bold)) (tp-set 1 6 '(marker t))
(let ((pos (tp-next 1 'face))) (tp-set 13 17 '(marker t))
(should (= pos 7)))))
(ert-deftest tp-test-prev ()
"Test tp-prev returns previous position with property."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-set 1 6 '(face bold))
(let ((pos (tp-prev 12 'face)))
(should (= pos 1)))))
(ert-deftest tp-test-goto-next ()
"Test tp-goto-next moves point."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-set 7 12 '(face bold))
(goto-char 1) (goto-char 1)
(tp-goto-next 'face) (skip-unless (fboundp 'text-property-search-forward))
(should (= (point) 7)))) (let ((result nil))
(tp-forward-do
(lambda (match obj)
(push (prop-match-beginning match) result))
'marker nil nil 2)
(should (= (length result) 2)))))
(ert-deftest tp-test-goto-prev () (ert-deftest tp-test-backward-do ()
"Test tp-goto-prev moves point." "Test tp-backward-do applies function to matches."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World Test")
(tp-set 1 6 '(face bold)) (tp-set 1 6 '(marker t))
(goto-char 12) (tp-set 13 17 '(marker t))
(tp-goto-prev 'face) (goto-char 18)
(should (= (point) 1)))) (skip-unless (fboundp 'text-property-search-backward))
(let ((result nil))
(tp-backward-do
(lambda (match obj)
(push (prop-match-beginning match) result))
'marker nil nil 2)
(should (= (length result) 2)))))
(ert-deftest tp-test-search-on-string ()
"Test tp-search finds all matching properties in a string."
(let ((str (copy-sequence "Hello World Hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
(let ((matches (tp-search str 'marker)))
(should (= (length matches) 2))
(should (equal (car matches) '(0 5 t)))
(should (equal (cadr matches) '(12 17 t))))))
(ert-deftest tp-test-search-on-string-with-value ()
"Test tp-search filters by value in a string."
(let ((str (copy-sequence "Hello World Hello")))
(tp-set 0 5 '(type heading) str)
(tp-set 6 11 '(type paragraph) str)
(tp-set 12 17 '(type heading) str)
(let ((matches (tp-search str 'type 'heading)))
(should (= (length matches) 2))
(should (equal (caddr (car matches)) 'heading))
(should (equal (caddr (cadr matches)) 'heading)))))
(ert-deftest tp-test-search-in-range ()
"Test tp-search finds all matching properties in a buffer range."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-set 1 6 '(marker t))
(tp-set 13 18 '(marker t))
(let ((matches (tp-search 1 18 'marker)))
(should (= (length matches) 2))
(should (equal (car matches) '(1 6 t)))
(should (equal (cadr matches) '(13 18 t))))))
(ert-deftest tp-test-search-do-on-string ()
"Test tp-search-do applies function to all matches in a string."
(let ((str (copy-sequence "Hello World Hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
(let ((result nil))
(tp-search-do
(lambda (match obj)
(push (car match) result))
str 'marker)
(should (= (length result) 2))
(should (member 0 result))
(should (member 12 result)))))
(ert-deftest tp-test-search-do-in-range ()
"Test tp-search-do applies function to all matches in a buffer range."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-set 1 6 '(marker t))
(tp-set 13 18 '(marker t))
(let ((result nil))
(tp-search-do
(lambda (match obj)
(push (car match) result))
1 18 'marker)
(should (= (length result) 2))
(should (member 1 result))
(should (member 13 result)))))
;;; ============================================================ ;;; ============================================================
;;; Utility Function Tests ;;; Utility Function Tests
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-in () ;; Tests for tp-search are in Search and Navigation Tests section above
"Test tp-in finds regions with property."
(tp-test-with-temp-buffer
(insert "Hello World Test")
(tp-set 1 6 '(my-prop value1))
(tp-set 7 12 '(my-prop value2))
(let ((regions (tp-in 'my-prop)))
(should (= (length regions) 2)))))
(ert-deftest tp-test-in-with-value ()
"Test tp-in filters by value."
(tp-test-with-temp-buffer
(insert "Hello World Test")
(tp-set 1 6 '(my-prop value1))
(tp-set 7 12 '(my-prop value2))
(let ((regions (tp-in 'my-prop 'value1)))
(should (= (length regions) 1))
(should (equal (car (car regions)) 1)))))
(ert-deftest tp-test-all ()
"Test tp-all returns all regions with properties."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-set 1 6 '(face bold))
(tp-set 7 12 '(face italic))
(let ((regions (tp-all)))
(should (>= (length regions) 2)))))
(ert-deftest tp-test-regions-map ()
"Test tp-regions-map applies function to regions."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-set 1 6 '(marker t))
(tp-set 13 18 '(marker t))
(let ((result nil))
(tp-regions-map
(lambda (start end idx)
(push (list start end idx) result))
'marker)
(should (= (length result) 2)))))
(ert-deftest tp-test-strings-map ()
"Test tp-strings-map applies function to strings."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-set 1 6 '(marker t))
(tp-set 13 18 '(marker t))
(let ((result nil))
(tp-strings-map
(lambda (str idx)
(push str result))
'marker)
(should (= (length result) 2))
(should (member "Hello" result)))))
;;; ============================================================ ;;; ============================================================
;;; Alias Tests ;;; Alias Tests
@ -650,7 +707,7 @@
"Test operations on empty buffer." "Test operations on empty buffer."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(should (null (tp-at 1))) (should (null (tp-at 1)))
(should (null (tp-all))))) (should (tp-empty-p))))
(ert-deftest tp-test-overlapping-regions () (ert-deftest tp-test-overlapping-regions ()
"Test overlapping property regions." "Test overlapping property regions."

231
tp.el
View File

@ -832,18 +832,39 @@ POINT defaults to current point.
OBJECT defaults to current buffer." OBJECT defaults to current buffer."
(text-properties-at (or point (point)) object)) (text-properties-at (or point (point)) object))
(defun tp-plist (start end &optional object) (defun tp-plist (start-or-string &optional end object)
"Get the property list of text at START to END in OBJECT. "Get the property list of text in a region or string.
Returns a plist of all properties in the region."
(let ((props nil) This function supports two calling conventions:
(pos start))
(while (< pos end) 1. Buffer/string region:
(let ((current-props (tp-at pos object))) (tp-plist START END &optional OBJECT)
(cl-loop for (key val) on current-props by #'cddr
do (unless (plist-member props key) 2. Entire string:
(setq props (plist-put props key val))))) (tp-plist STRING)
(setq pos (next-single-property-change pos nil object end)))
props)) Returns a plist of all properties in the region or string."
(let (start finish obj)
(cond
;; Entire string form: (tp-plist string)
((stringp start-or-string)
(setq obj start-or-string
start 0
finish (length start-or-string)))
;; Region form: (tp-plist start end &optional object)
((numberp start-or-string)
(setq start start-or-string
finish end
obj object)))
(let ((props nil)
(pos start))
(while (< pos finish)
(let ((current-props (tp-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 finish)))
props)))
;;; Text property intervals ;;; Text property intervals
;; Note: Uses `object-intervals' which requires Emacs 28.1+ ;; Note: Uses `object-intervals' which requires Emacs 28.1+
@ -863,10 +884,18 @@ Uses `object-intervals' (Emacs 28.1+)."
(t (error "Invalid format of object: %S" (t (error "Invalid format of object: %S"
(type-of object)))))) (type-of object))))))
(defun tp-empty-p (object) (defun tp-empty-p (&optional object)
"Return t if OBJECT has no text properties. "Return t if OBJECT has no text properties.
OBJECT can be a string or buffer; nil defaults to current buffer.
Uses `object-intervals' (Emacs 28.1+)." Uses `object-intervals' (Emacs 28.1+)."
(null (object-intervals object))) (let ((obj (or object (current-buffer))))
(cond
((stringp obj)
(null (object-intervals obj)))
((bufferp obj)
(with-current-buffer obj
(null (object-intervals (buffer-substring (point-min) (point-max))))))
(t (error "Invalid object type: %S" (type-of obj))))))
(defun tp-intervals-map (function start end &optional object) (defun tp-intervals-map (function start end &optional object)
"Apply FUNCTION to all intervals between START and END in OBJECT. "Apply FUNCTION to all intervals between START and END in OBJECT.
@ -1470,6 +1499,180 @@ VALUE, PREDICATE, and NOT-CURRENT work as in `text-property-search-forward'."
VALUE, PREDICATE, and NOT-CURRENT work as in `text-property-search-backward'." VALUE, PREDICATE, and NOT-CURRENT work as in `text-property-search-backward'."
(text-property-search-backward property value predicate not-current)) (text-property-search-backward property value predicate not-current))
(defun tp-forward (property &optional value object n)
"Search forward N times for text with PROPERTY.
N is the number of searches, defaulting to 1.
VALUE is the optional value to match.
OBJECT can be a buffer; nil defaults to current buffer.
Returns the prop-match object from the last successful search,
or nil if not found.
Uses `tp-search-forward' internally."
(let ((count (or n 1))
(result nil))
(when object
(set-buffer object))
(dotimes (_ count)
(setq result (tp-search-forward property value)))
result))
(defun tp-backward (property &optional value object n)
"Search backward N times for text with PROPERTY.
N is the number of searches, defaulting to 1.
VALUE is the optional value to match.
OBJECT can be a buffer; nil defaults to current buffer.
Returns the prop-match object from the last successful search,
or nil if not found.
Uses `tp-search-backward' internally."
(let ((count (or n 1))
(result nil))
(when object
(set-buffer object))
(dotimes (_ count)
(setq result (tp-search-backward property value)))
result))
(defun tp-forward-do (function property &optional value object n)
"Search forward N times for text with PROPERTY and apply FUNCTION to each match.
FUNCTION receives two arguments: the prop-match object and OBJECT.
N is the number of searches, defaulting to 1.
VALUE is the optional value to match.
OBJECT can be a buffer; nil defaults to current buffer.
Returns the number of successful matches."
(let ((count (or n 1))
(matches 0)
(buf (or object (current-buffer))))
(with-current-buffer buf
(dotimes (_ count)
(when-let ((match (tp-search-forward property value)))
(funcall function match buf)
(cl-incf matches))))
matches))
(defun tp-backward-do (function property &optional value object n)
"Search backward N times for text with PROPERTY and apply FUNCTION to each match.
FUNCTION receives two arguments: the prop-match object and OBJECT.
N is the number of searches, defaulting to 1.
VALUE is the optional value to match.
OBJECT can be a buffer; nil defaults to current buffer.
Returns the number of successful matches."
(let ((count (or n 1))
(matches 0)
(buf (or object (current-buffer))))
(with-current-buffer buf
(dotimes (_ count)
(when-let ((match (tp-search-backward property value)))
(funcall function match buf)
(cl-incf matches))))
matches))
(defun tp-search (start-or-string &optional end-or-property property-or-value value object)
"Search for all text with PROPERTY in a buffer/string range or entire string.
This function supports two calling conventions:
1. Buffer/string region:
(tp-search START END PROPERTY &optional VALUE OBJECT)
2. Entire string:
(tp-search STRING PROPERTY &optional VALUE)
Returns a list of prop-match objects for all matching regions.
Each prop-match object has beginning, end, and value information."
(cond
;; Entire string form: (tp-search string property &optional value)
((stringp start-or-string)
(let* ((str start-or-string)
(property end-or-property)
(value property-or-value)
(results nil)
(pos 0)
(len (length str)))
(while (< pos len)
(let ((prop-val (get-text-property pos property str)))
(if (and prop-val
(or (null value)
(equal prop-val value)))
;; Find the extent of this property
(let ((next-change (or (next-single-property-change pos property str len) len)))
(push (list pos next-change prop-val) results)
(setq pos next-change))
;; No match, move to next change
(setq pos (or (next-single-property-change pos property str len) len)))))
(nreverse results)))
;; Buffer/string region form: (tp-search start end property &optional value object)
((numberp start-or-string)
(let* ((start start-or-string)
(end end-or-property)
(property property-or-value)
(value value)
(obj (or object (current-buffer)))
(results nil)
(pos start))
(if (stringp obj)
;; String object
(while (< pos end)
(let ((prop-val (get-text-property pos property obj)))
(if (and prop-val
(or (null value)
(equal prop-val value)))
(let ((next-change (or (next-single-property-change pos property obj end) end)))
(push (list pos next-change prop-val) results)
(setq pos next-change))
(setq pos (or (next-single-property-change pos property obj end) end)))))
;; Buffer object
(with-current-buffer obj
(while (< pos end)
(let ((prop-val (get-text-property pos property)))
(if (and prop-val
(or (null value)
(equal prop-val value)))
(let ((next-change (or (next-single-property-change pos property nil end) end)))
(push (list pos next-change prop-val) results)
(setq pos next-change))
(setq pos (or (next-single-property-change pos property nil end) end)))))))
(nreverse results)))
(t (error "Invalid first argument: %S" start-or-string))))
(defun tp-search-do (function start-or-string &optional end-or-property property-or-value value object)
"Execute FUNCTION on all matches of PROPERTY in a buffer/string range or entire string.
This function supports two calling conventions:
1. Buffer/string region:
(tp-search-do FUNCTION START END PROPERTY &optional VALUE OBJECT)
2. Entire string:
(tp-search-do FUNCTION STRING PROPERTY &optional VALUE)
FUNCTION receives two arguments: the prop-match (list of START END VALUE) and OBJECT.
Returns the number of matches processed."
(let ((matches
(cond
;; Entire string form
((stringp start-or-string)
(tp-search start-or-string end-or-property property-or-value))
;; Buffer/string region form
((numberp start-or-string)
(tp-search start-or-string end-or-property property-or-value value object))
(t (error "Invalid first argument: %S" start-or-string))))
(obj (cond
((stringp start-or-string) start-or-string)
((numberp start-or-string) (or object (current-buffer)))
(t nil))))
(dolist (match matches)
(funcall function match obj))
(length matches)))
;;; Match and regexp functions (similar to ov-match and ov-regexp) ;;; Match and regexp functions (similar to ov-match and ov-regexp)
(defun tp--match-apply (pattern properties apply-fn &optional object) (defun tp--match-apply (pattern properties apply-fn &optional object)