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

Refactor tp-search-map, tp-forward-do, tp-backward-do function signatures

Browse Source 
- Updated tp-search-map signature to (function property &optional value object start end)
- Updated tp-forward-do signature to (function property &optional value object times start end)
- Updated tp-backward-do signature to (function property &optional value object times start end)
- Function callback for tp-search-map now accepts (text &optional start end idx)
- Function callback for tp-forward-do/tp-backward-do now accepts (text &optional start end)
- Updated internal helper functions tp--search-do, tp--forward-do, tp--backward-do
- Added new tests for the updated APIs
- Updated documentation in README.md and README_CN.md with examples

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-17 09:14:15 +00:00
parent 66e045e7c1
commit 8c068fb4a8
4 changed files with 382 additions and 437 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
README.md
View File

@ -198,10 +198,10 @@ A complete overview of all tp.el functions organized by category:
| [`tp-search-backward`](#tp-search-forward--tp-search-backward) | Raw wrapper for text-property-search-backward |
| [`tp-forward`](#tp-forward--tp-backward) | Search forward N times for text with property (buffers and strings) |
| [`tp-backward`](#tp-forward--tp-backward) | Search backward N times for text with property (buffers and strings) |
| [`tp-forward-do`](#tp-forward-do--tp-backward-do) | Apply function to matched text for N forward matches (with optional start point) |
| [`tp-backward-do`](#tp-forward-do--tp-backward-do) | Apply function to matched text for N backward matches (with optional start point) |
| [`tp-forward-do`](#tp-forward-do--tp-backward-do) | Apply function to last match in forward search (with optional start/end range) |
| [`tp-backward-do`](#tp-forward-do--tp-backward-do) | Apply function to last match in backward search (with optional start/end range) |
| [`tp-search`](#tp-search---search-all-matches) | Search all matching properties in range or string |
| [`tp-search-map`](#tp-search-map---apply-function-to-matched-text) | Apply function to matched text for all matches |
| [`tp-search-map`](#tp-search-map---apply-function-to-matched-text) | Apply function to all matches (with optional start/end range) |
#### Property Layer Definition Functions
| Function | Description |
@ -896,60 +896,57 @@ Search forward/backward N times for text with PROPERTY.
#### `tp-forward-do` / `tp-backward-do`
```elisp
(tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT POINT N)
(tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT POINT N)
(tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT TIMES START END)
(tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT TIMES START END)
```
Search forward/backward N times for text with PROPERTY and apply FUNCTION **only to the last match**.
Search forward/backward for text with PROPERTY and apply FUNCTION **only to the last match**.
- **FUNCTION** receives the matched text as its first argument. Optionally, FUNCTION can accept two additional arguments: START and END, representing the start and end positions of the match. The return value of FUNCTION replaces the matched text in the string or buffer.
- **N** is the number of searches, defaulting to 1. The function searches N times but only applies FUNCTION to the last (Nth) match found.
- **FUNCTION** receives `(TEXT &optional START END)` where TEXT is the matched text, START and END are the positions of the match. The return value of FUNCTION replaces the matched text in the string or buffer.
- **PROPERTY** is the text property to search for.
- **VALUE** is the optional value to match; nil means search for PROPERTY without matching value.
- **OBJECT** can be a buffer or string; nil defaults to current buffer.
- **POINT** is the starting position for search; for buffers nil means current point,
for strings nil means 0 (forward) or end of string (backward).
- **TIMES** is the number of searches, defaulting to 1. The function searches TIMES times but only applies FUNCTION to the last (Nth) match found.
- **START** and **END** define the search range; defaults are object start and end.
- Returns the number of successful matches.
**Examples:**
```elisp
;; Upcase only the last (2nd) match in buffer
(with-temp-buffer
(insert "hello world test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 1)
(tp-forward-do #'upcase 'marker nil nil nil 2)
(buffer-string))
;; => "hello world TEST" ; Only the 2nd match is upcased
;; Upcase only the last (2nd) match in string
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-forward-do #'upcase 'marker nil my-string nil 2)
(tp-forward-do #'upcase 'marker nil my-string 2)
my-string)
;; => "hello world HELLO" ; Only the 2nd match is upcased
;; Start search from specific position (only 1 match found and transformed)
;; Search within a range (only matches in range 6-17)
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-forward-do #'upcase 'marker nil my-string 6 2)
(tp-forward-do #'upcase 'marker nil my-string 2 6 17)
my-string)
;; => "hello world HELLO" ; Only matches from position 6 onward
;; => "hello world HELLO" ; Only 1 match in range 6-17
;; Using function with start and end parameters
(with-temp-buffer
(insert "hello world test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 1)
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-forward-do
(lambda (text start end)
(format "[%d-%d]%s" start end text))
'marker nil nil nil 2)
(buffer-string))
;; => "hello world [13-17]test" ; Only the last match is transformed
'marker nil my-string 2)
my-string)
;; => "hello world [12-17]hello" ; Only the last match is transformed
;; Backward search - upcase only the last (2nd) match
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-backward-do #'upcase 'marker nil my-string 2)
my-string)
;; => "HELLO world hello" ; The first match (last when searching backward) is upcased
```
---
@ -1000,18 +997,20 @@ Returns a list of (START END VALUE) for all matching regions.
#### `tp-search-map` - Apply Function to Matched Text
```elisp
;; Buffer/string region
(tp-search-map FUNCTION START END PROPERTY &optional VALUE OBJECT)
;; Entire string
(tp-search-map FUNCTION STRING PROPERTY &optional VALUE)
(tp-search-map FUNCTION PROPERTY &optional VALUE OBJECT START END)
```
Apply FUNCTION to matched text for all matches of PROPERTY.
Apply FUNCTION to all matches of PROPERTY in OBJECT.
- **FUNCTION** receives the matched text as its first argument, and optionally
the 0-based index of the current match as its second argument. The return value
of FUNCTION replaces the matched text in the string or buffer.
- **FUNCTION** receives `(TEXT &optional START END IDX)` where:
- TEXT is the matched text
- START and END are the positions of the match
- IDX is the 0-based index of the current match
The return value of FUNCTION replaces the matched text in the string or buffer.
- **PROPERTY** is the text property to search for.
- **VALUE** is the optional value to match; nil means search for PROPERTY without matching value.
- **OBJECT** can be a buffer or string; nil defaults to current buffer.
- **START** and **END** define the search range; defaults are object start and end.
- Returns the number of matches processed.
**Examples:**
@ -1021,38 +1020,37 @@ Apply FUNCTION to matched text for all matches of PROPERTY.
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-search-map #'upcase my-string 'marker)
(tp-search-map #'upcase 'marker nil my-string)
my-string)
;; => "HELLO world HELLO"
;; Upcase all markers in buffer range
(with-temp-buffer
(insert "hello world test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(tp-search-map #'upcase 1 17 'marker)
(buffer-string))
;; => "HELLO world TEST"
;; Search only in a range
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-search-map #'upcase 'marker nil my-string 0 10)
my-string)
;; => "HELLO world hello" ; Only first match in range 0-10
;; Custom transformation with index
;; Custom transformation with start, end, and index
(let ((my-string (copy-sequence "aaa bbb ccc")))
(tp-set 0 3 '(marker t) my-string)
(tp-set 4 7 '(marker t) my-string)
(tp-set 8 11 '(marker t) my-string)
(tp-search-map
(lambda (text idx)
(lambda (text start end idx)
(format "%d:%s" idx text))
my-string 'marker)
'marker nil my-string)
my-string)
;; => "0:aaa1:bbb2:ccc"
;; Custom transformation without index
;; Custom transformation without optional parameters
(let ((my-string (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) my-string)
(tp-search-map
(lambda (text)
(concat "[" text "]"))
my-string 'marker)
'marker nil my-string)
my-string)
;; => "[hello] world"
```

107
README_CN.md
View File

@ -197,10 +197,10 @@ tp.el 所有函数按类别组织的完整概览：
| [`tp-search-backward`](#tp-search-forward--tp-search-backward) | text-property-search-backward 的原始包装 |
| [`tp-forward`](#tp-forward--tp-backward) | 向前搜索 N 次具有属性的文本（支持缓冲区和字符串） |
| [`tp-backward`](#tp-forward--tp-backward) | 向后搜索 N 次具有属性的文本（支持缓冲区和字符串） |
| [`tp-forward-do`](#tp-forward-do--tp-backward-do) | 对 N 个向前匹配的文本应用函数（支持起始位置） |
| [`tp-backward-do`](#tp-forward-do--tp-backward-do) | 对 N 个向后匹配的文本应用函数（支持起始位置） |
| [`tp-forward-do`](#tp-forward-do--tp-backward-do) | 向前搜索并对最后一个匹配应用函数（支持起始和结束范围） |
| [`tp-backward-do`](#tp-forward-do--tp-backward-do) | 向后搜索并对最后一个匹配应用函数（支持起始和结束范围） |
| [`tp-search`](#tp-search---搜索所有匹配) | 在范围或字符串中搜索所有匹配的属性 |
| [`tp-search-map`](#tp-search-map---对匹配文本应用函数) | 对所有匹配的文本应用函数 |
| [`tp-search-map`](#tp-search-map---对匹配文本应用函数) | 对所有匹配的文本应用函数（支持起始和结束范围） |
#### 属性层定义函数
| 函数 | 描述 |
@ -895,59 +895,57 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
#### `tp-forward-do` / `tp-backward-do`
```elisp
(tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT POINT N)
(tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT POINT N)
(tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT TIMES START END)
(tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT TIMES START END)
```
向前/向后搜索 N 次具有 PROPERTY 的文本，**仅对最后一次匹配应用 FUNCTION**。
在 OBJECT 的 START 到 END 范围内，向前/向后搜索匹配 PROPERTY 属性（值为 VALUE）的部分，**仅对最后一次匹配执行 FUNCTION 函数**。
- **FUNCTION** 接收匹配到的文本作为第一个参数。可选地，FUNCTION 可以接受两个额外的参数：START 和 END，表示匹配的起始和结束位置。FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。
- **N** 是搜索次数，默认为 1。该函数会搜索 N 次，但仅对找到的最后（第 N 次）匹配应用 FUNCTION。
- **OBJECT** 可以是缓冲区或字符串；nil 默认为当前缓冲区。
- **POINT** 是搜索的起始位置；对于缓冲区 nil 表示当前位置，对于字符串 nil 表示 0（向前）或字符串末尾（向后）。
- **FUNCTION** 的参数是 `(TEXT &optional START END)`，其中 TEXT 是此次匹配到的文本，START 和 END 为开始结束的位置。FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。
- **PROPERTY** 是要搜索的文本属性。
- **VALUE** 为 nil 时，表示搜索 PROPERTY 属性，不用匹配值。
- **OBJECT** 默认是当前 buffer 或指定的字符串或指定的 buffer。
- **TIMES** 表示向前/向后搜索几次，默认搜索一次。该函数会搜索 TIMES 次，但仅对找到的最后（第 N 次）匹配应用 FUNCTION。
- **START** 和 **END** 默认为 OBJECT 的起始和结束位置。
- 返回成功匹配的数量。
**示例：**
```elisp
;; 仅将最后一次（第 2 次）匹配的文本转为大写
(with-temp-buffer
(insert "hello world test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 1)
(tp-forward-do #'upcase 'marker nil nil nil 2)
(buffer-string))
;; => "hello world TEST" ; 仅第 2 次匹配被转为大写
;; 仅将最后一次（第 2 次）匹配的文本转为大写
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-forward-do #'upcase 'marker nil my-string nil 2)
(tp-forward-do #'upcase 'marker nil my-string 2)
my-string)
;; => "hello world HELLO" ; 仅第 2 次匹配被转为大写
;; 从特定位置开始搜索（仅找到 1 次匹配并转换）
;; 在指定范围内搜索（仅搜索范围 6-17 内的匹配）
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-forward-do #'upcase 'marker nil my-string 6 2)
(tp-forward-do #'upcase 'marker nil my-string 2 6 17)
my-string)
;; => "hello world HELLO" ; 只处理位置 6 之后的匹配
;; => "hello world HELLO" ; 范围 6-17 内仅有 1 个匹配
;; 使用带有 start 和 end 参数的函数
(with-temp-buffer
(insert "hello world test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 1)
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-forward-do
(lambda (text start end)
(format "[%d-%d]%s" start end text))
'marker nil nil nil 2)
(buffer-string))
;; => "hello world [13-17]test" ; 仅最后一次匹配被转换
'marker nil my-string 2)
my-string)
;; => "hello world [12-17]hello" ; 仅最后一次匹配被转换
;; 向后搜索 - 仅将最后一次（第 2 次）匹配的文本转为大写
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-backward-do #'upcase 'marker nil my-string 2)
my-string)
;; => "HELLO world hello" ; 向后搜索时第一个匹配（即最后找到的）被转为大写
```
---
@ -998,16 +996,20 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
#### `tp-search-map` - 对匹配文本应用函数
```elisp
;; 缓冲区/字符串区域
(tp-search-map FUNCTION START END PROPERTY &optional VALUE OBJECT)
;; 整个字符串
(tp-search-map FUNCTION STRING PROPERTY &optional VALUE)
(tp-search-map FUNCTION PROPERTY &optional VALUE OBJECT START END)
```
对所有 PROPERTY 匹配的文本应用 FUNCTION。
在 OBJECT 的 START 到 END 范围内，匹配到 PROPERTY 属性（值是 VALUE）的部分执行 FUNCTION 函数。
- **FUNCTION** 接收匹配到的文本作为第一个参数，可选地接收当前匹配的 0 基索引作为第二个参数。FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。
- **FUNCTION** 的参数是 `(TEXT &optional START END IDX)`，其中：
- TEXT 是此次匹配到的文本
- START 和 END 为开始结束的位置
- IDX 是遍历中的当前从 0 开始的索引
FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。
- **PROPERTY** 是要搜索的文本属性。
- **VALUE** 为 nil 时，表示搜索 PROPERTY 属性，不用匹配值。
- **OBJECT** 默认是当前 buffer 或指定的字符串或指定的 buffer。
- **START** 和 **END** 默认为 OBJECT 的起始和结束位置。
- 返回处理的匹配数量。
**示例：**
@ -1017,38 +1019,37 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-search-map #'upcase my-string 'marker)
(tp-search-map #'upcase 'marker nil my-string)
my-string)
;; => "HELLO world HELLO"
;; 将缓冲区范围内所有 marker 文本转为大写
(with-temp-buffer
(insert "hello world test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(tp-search-map #'upcase 1 17 'marker)
(buffer-string))
;; => "HELLO world TEST"
;; 仅在指定范围内搜索
(let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(marker t) my-string)
(tp-search-map #'upcase 'marker nil my-string 0 10)
my-string)
;; => "HELLO world hello" ; 仅范围 0-10 内的第一个匹配被处理
;; 使用索引的自定义转换
;; 使用 start、end 和 idx 参数的自定义转换
(let ((my-string (copy-sequence "aaa bbb ccc")))
(tp-set 0 3 '(marker t) my-string)
(tp-set 4 7 '(marker t) my-string)
(tp-set 8 11 '(marker t) my-string)
(tp-search-map
(lambda (text idx)
(lambda (text start end idx)
(format "%d:%s" idx text))
my-string 'marker)
'marker nil my-string)
my-string)
;; => "0:aaa1:bbb2:ccc"
;; 不使用索引的自定义转换
;; 不使用可选参数的自定义转换
(let ((my-string (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) my-string)
(tp-search-map
(lambda (text)
(concat "[" text "]"))
my-string 'marker)
'marker nil my-string)
my-string)
;; => "[hello] world"
```

262
tp-tests.el
View File

@ -642,218 +642,120 @@
(should (equal (car matches) '(12 17 t)))
(should (equal (cadr matches) '(0 5 t))))))
(ert-deftest tp-test-forward-do ()
"Test tp-forward-do applies function only to the last match."
(tp-test-with-temp-buffer
(insert "hello World test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 1)
(skip-unless (fboundp 'text-property-search-forward))
;; Test that function is applied only to the last (2nd) match
(let ((count (tp-forward-do #'upcase 'marker nil nil nil 2)))
(should (= count 2))
;; First match should NOT be upcased
(should (equal (buffer-substring 1 6) "hello"))
;; Only the last (2nd) match should be upcased
(should (equal (buffer-substring 13 17) "TEST")))))
(ert-deftest tp-test--forward-do ()
"Test tp--forward-do applies function only to the last match (internal API)."
(tp-test-with-temp-buffer
(insert "Hello World Test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 1)
(skip-unless (fboundp 'text-property-search-forward))
(let ((result nil))
(tp--forward-do
(lambda (match obj)
(push (prop-match-beginning match) result))
'marker nil nil nil 2)
;; Only the last match should be processed
(should (= (length result) 1))
(should (= (car result) 13)))))
(ert-deftest tp-test-backward-do ()
"Test tp-backward-do applies function only to the last match."
(tp-test-with-temp-buffer
(insert "hello World test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 18)
(skip-unless (fboundp 'text-property-search-backward))
;; Test that function is applied only to the last (2nd) match
(let ((count (tp-backward-do #'upcase 'marker nil nil nil 2)))
(should (= count 2))
;; Only the last (2nd) match should be upcased
(should (equal (buffer-substring 1 6) "HELLO"))
;; First match (searched backward) should NOT be upcased
(should (equal (buffer-substring 13 17) "test")))))
(ert-deftest tp-test--backward-do ()
"Test tp--backward-do applies function only to the last match (internal API)."
(tp-test-with-temp-buffer
(insert "Hello World Test")
(tp-set 1 6 '(marker t))
(tp-set 13 17 '(marker t))
(goto-char 18)
(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 nil 2)
;; Only the last match should be processed
(should (= (length result) 1))
(should (= (car result) 1)))))
;;; tp-forward-do / tp-backward-do tests (new API)
(ert-deftest tp-test-forward-do-on-string ()
"Test tp-forward-do applies only to the last match on string objects."
"Test tp-forward-do on string: applies function to the last match."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
(let ((count (tp-forward-do #'upcase 'marker nil str nil 2)))
;; Search 2 times, function only applied to the last match
(let ((count (tp-forward-do #'upcase 'marker nil str 2)))
(should (= count 2))
;; First match should NOT be upcased
(should (equal (substring str 0 5) "hello"))
;; Only the last (2nd) match should be upcased
(should (equal (substring str 12 17) "HELLO")))))
(ert-deftest tp-test-backward-do-on-string ()
"Test tp-backward-do applies only to the last match on string objects."
(ert-deftest tp-test-forward-do-on-string-with-range ()
"Test tp-forward-do on string with start/end range."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
(let ((count (tp-backward-do #'upcase 'marker nil str nil 2)))
(should (= count 2))
;; Only the last (2nd) match should be upcased
(should (equal (substring str 0 5) "HELLO"))
;; First match (searched backward) should NOT be upcased
(should (equal (substring str 12 17) "hello")))))
(ert-deftest tp-test-forward-do-with-point ()
"Test tp-forward-do with point parameter."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Start from position 6 (after first match)
(let ((count (tp-forward-do #'upcase 'marker nil str 6 2)))
(should (= count 1)) ; Only one match from position 6
;; Search only in range 6-17 (after first match)
(let ((count (tp-forward-do #'upcase 'marker nil str 2 6 17)))
(should (= count 1)) ; Only one match in range 6-17
;; First match should NOT be upcased
(should (equal (substring str 0 5) "hello"))
;; Second match should be upcased
(should (equal (substring str 12 17) "HELLO")))))
(ert-deftest tp-test-backward-do-with-point ()
"Test tp-backward-do with point parameter."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Start from position 10 (before second match)
(let ((count (tp-backward-do #'upcase 'marker nil str 10 2)))
(should (= count 1)) ; Only one match before position 10
;; First match should be upcased
(should (equal (substring str 0 5) "HELLO"))
;; Second match should NOT be upcased
(should (equal (substring str 12 17) "hello")))))
(ert-deftest tp-test-forward-do-with-start-end ()
"Test tp-forward-do passes optional start and end to function for last match only."
(ert-deftest tp-test-forward-do-function-receives-start-end ()
"Test tp-forward-do passes start and end to function."
(let ((str (copy-sequence "hello World hello"))
(starts nil)
(ends nil))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Function accepts text, start, end and returns uppercase
;; Function accepts text, start, end
(let ((count (tp-forward-do (lambda (txt start end)
(push start starts)
(push end ends)
(upcase txt))
'marker nil str nil 2)))
'marker nil str 2)))
(should (= count 2))
;; Check only the last match positions were passed
;; Only the last match positions were passed to function
(should (equal starts '(12)))
(should (equal ends '(17)))
;; Only the last match should be upcased
(should (equal (substring str 0 5) "hello"))
(should (equal (substring str 12 17) "HELLO")))))
(ert-deftest tp-test-forward-do-with-start-only ()
"Test tp-forward-do passes start to function for last match only when function accepts 2 args."
(let ((str (copy-sequence "hello World hello"))
(starts nil))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Function accepts text and start only
(let ((count (tp-forward-do (lambda (txt start)
(push start starts)
(upcase txt))
'marker nil str nil 2)))
(should (= count 2))
;; Check only the last match start position was passed
(should (equal starts '(12)))
;; Only the last match should be upcased
(should (equal (substring str 0 5) "hello"))
(should (equal (substring str 12 17) "HELLO")))))
(ert-deftest tp-test-forward-do-backward-compat ()
"Test tp-forward-do applies only to last match with single-argument functions."
(ert-deftest tp-test-forward-do-single-arg-function ()
"Test tp-forward-do with single-argument function."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Use #'upcase which only takes one argument
(tp-forward-do #'upcase 'marker nil str nil 2)
(tp-forward-do #'upcase 'marker nil str 2)
;; Only the last match should be upcased
(should (equal (substring str 0 5) "hello"))
(should (equal (substring str 12 17) "HELLO"))))
(ert-deftest tp-test-backward-do-with-start-end ()
"Test tp-backward-do passes optional start and end to function for last match only."
(ert-deftest tp-test-backward-do-on-string ()
"Test tp-backward-do on string: applies function to the last match."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Search backward 2 times, function only applied to the last match
(let ((count (tp-backward-do #'upcase 'marker nil str 2)))
(should (= count 2))
;; Only the last (2nd) match should be upcased (first in order)
(should (equal (substring str 0 5) "HELLO"))
;; First match (searched backward) should NOT be upcased
(should (equal (substring str 12 17) "hello")))))
(ert-deftest tp-test-backward-do-on-string-with-range ()
"Test tp-backward-do on string with start/end range."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Search only in range 0-10 (before second match)
(let ((count (tp-backward-do #'upcase 'marker nil str 2 0 10)))
(should (= count 1)) ; Only one match in range 0-10
;; First match should be upcased
(should (equal (substring str 0 5) "HELLO"))
;; Second match should NOT be upcased
(should (equal (substring str 12 17) "hello")))))
(ert-deftest tp-test-backward-do-function-receives-start-end ()
"Test tp-backward-do passes start and end to function."
(let ((str (copy-sequence "hello World hello"))
(starts nil)
(ends nil))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Function accepts text, start, end and returns uppercase
;; Function accepts text, start, end
(let ((count (tp-backward-do (lambda (txt start end)
(push start starts)
(push end ends)
(upcase txt))
'marker nil str nil 2)))
'marker nil str 2)))
(should (= count 2))
;; Check only the last match positions were passed
;; Only the last match positions were passed to function
(should (equal starts '(0)))
(should (equal ends '(5)))
;; Only the last match should be upcased
(should (equal (substring str 0 5) "HELLO"))
(should (equal (substring str 12 17) "hello")))))
(ert-deftest tp-test-backward-do-with-start-only ()
"Test tp-backward-do passes start to function for last match only when function accepts 2 args."
(let ((str (copy-sequence "hello World hello"))
(starts nil))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Function accepts text and start only
(let ((count (tp-backward-do (lambda (txt start)
(push start starts)
(upcase txt))
'marker nil str nil 2)))
(should (= count 2))
;; Check only the last match start position was passed
(should (equal starts '(0)))
;; Only the last match should be upcased
(should (equal (substring str 0 5) "HELLO"))
(should (equal (substring str 12 17) "hello")))))
(ert-deftest tp-test-backward-do-backward-compat ()
"Test tp-backward-do applies only to last match with single-argument functions."
(ert-deftest tp-test-backward-do-single-arg-function ()
"Test tp-backward-do with single-argument function."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Use #'upcase which only takes one argument
(tp-backward-do #'upcase 'marker nil str nil 2)
(tp-backward-do #'upcase 'marker nil str 2)
;; Only the last match should be upcased
(should (equal (substring str 0 5) "HELLO"))
(should (equal (substring str 12 17) "hello"))))
@ -899,7 +801,7 @@
(tp--search-do
(lambda (match obj)
(push (car match) result))
str 'marker)
'marker nil str)
(should (= (length result) 2))
(should (member 0 result))
(should (member 12 result)))))
@ -914,7 +816,7 @@
(tp--search-do
(lambda (match obj)
(push (car match) result))
1 18 'marker)
'marker nil nil 1 18)
(should (= (length result) 2))
(should (member 1 result))
(should (member 13 result)))))
@ -924,7 +826,7 @@
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
(let ((count (tp-search-map #'upcase str 'marker)))
(let ((count (tp-search-map #'upcase 'marker nil str)))
(should (= count 2))
;; Check that text was upcased
(should (equal (substring str 0 5) "HELLO"))
@ -936,7 +838,7 @@
(insert "hello World hello")
(tp-set 1 6 '(marker t))
(tp-set 13 18 '(marker t))
(let ((count (tp-search-map #'upcase 1 18 'marker)))
(let ((count (tp-search-map #'upcase 'marker nil nil 1 18)))
(should (= count 2))
;; Check that text was upcased
(should (equal (buffer-substring 1 6) "HELLO"))
@ -948,11 +850,11 @@
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; First upcase the text
(tp-search-map #'upcase str 'marker)
(tp-search-map #'upcase 'marker nil str)
;; Then add face property
(tp-search-map (lambda (txt)
(tp-add txt 'face '(:background "orange")))
str 'marker)
'marker nil str)
;; Check text was upcased
(should (equal (substring str 0 5) "HELLO"))
(should (equal (substring str 12 17) "HELLO"))
@ -962,40 +864,39 @@
(should (equal (plist-get (plist-get props-0 'face) :background) "orange"))
(should (equal (plist-get (plist-get props-12 'face) :background) "orange")))))
(ert-deftest tp-test-search-map-with-idx ()
"Test tp-search-map passes index to function when it accepts two arguments."
(ert-deftest tp-test-search-map-with-start-end-idx ()
"Test tp-search-map passes start, end, and index to function."
(let ((str (copy-sequence "aaa bbb ccc"))
(indices nil))
(positions nil))
(tp-set 0 3 '(marker t) str)
(tp-set 4 7 '(marker t) str)
(tp-set 8 11 '(marker t) str)
;; Use a function that accepts idx and records the indices
;; Return the uppercased text (same length) to avoid truncation issues
(tp-search-map (lambda (txt idx)
(push idx indices)
;; Use a function that accepts text, start, end, idx
(tp-search-map (lambda (txt start end idx)
(push (list start end idx) positions)
(upcase txt))
str 'marker)
;; Check indices were passed in order (reversed due to push)
(should (equal (reverse indices) '(0 1 2)))
'marker nil str)
;; Check positions and indices were passed in order (reversed due to push)
(should (equal (reverse positions) '((0 3 0) (4 7 1) (8 11 2))))
;; Check text was transformed (uppercased)
(should (equal (substring str 0 3) "AAA"))
(should (equal (substring str 4 7) "BBB"))
(should (equal (substring str 8 11) "CCC"))))
(ert-deftest tp-test-search-map-with-idx-in-buffer ()
"Test tp-search-map passes index to function in buffer range."
(ert-deftest tp-test-search-map-with-start-end-in-buffer ()
"Test tp-search-map passes start and end to function in buffer range."
(tp-test-with-temp-buffer
(insert "aaa bbb ccc")
(tp-set 1 4 '(marker t))
(tp-set 5 8 '(marker t))
(tp-set 9 12 '(marker t))
(let ((indices nil))
(tp-search-map (lambda (txt idx)
(push idx indices)
(let ((positions nil))
(tp-search-map (lambda (txt start end idx)
(push (list start end idx) positions)
(format "[%d]" idx))
1 12 'marker)
;; Check indices were passed in order
(should (equal (reverse indices) '(0 1 2)))
'marker nil nil 1 12)
;; Check positions and indices were passed in order
(should (equal (reverse positions) '((1 4 0) (5 8 1) (9 12 2))))
;; Check text was replaced with index markers
(should (string-match-p "\\[0\\]" (buffer-string)))
(should (string-match-p "\\[1\\]" (buffer-string)))
@ -1006,9 +907,22 @@
(let ((str (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) str)
;; Use #'upcase which only takes one argument
(tp-search-map #'upcase str 'marker)
(tp-search-map #'upcase 'marker nil str)
(should (equal (substring str 0 5) "HELLO"))))
(ert-deftest tp-test-search-map-with-range ()
"Test tp-search-map with start and end range."
(let ((str (copy-sequence "hello World hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
;; Only search in range 0-10 (first match only)
(let ((count (tp-search-map #'upcase 'marker nil str 0 10)))
(should (= count 1))
;; First match should be upcased
(should (equal (substring str 0 5) "HELLO"))
;; Second match should NOT be upcased
(should (equal (substring str 12 17) "hello")))))
;;; ============================================================
;;; Utility Function Tests
;;; ============================================================

342
tp.el
View File

@ -981,60 +981,63 @@ Uses `tp-search-backward' for buffers and `tp-search' for strings."
(setq result (tp-search-backward property value))))
result)))))
(defun tp--forward-do (function property &optional value object point n)
"Internal: Search forward N times for PROPERTY and apply FUNCTION to the last match.
(defun tp--forward-do (function property &optional value object times start end)
"Internal: Search forward TIMES for PROPERTY and apply FUNCTION to the last match.
FUNCTION receives two arguments: the prop-match object (or list for strings)
and OBJECT.
N is the number of searches, defaulting to 1.
TIMES is the number of searches, defaulting to 1.
VALUE is the optional value to match.
OBJECT can be a buffer or string; nil defaults to current buffer.
POINT is the starting position for search; for buffers nil means current point,
for strings nil means 0.
START and END define the search range; defaults are object start and end.
Returns the number of successful matches."
(let ((count (or n 1)))
(let ((count (or times 1)))
(cond
;; String object
((stringp object)
(let* ((start-pos (or point 0))
(let* ((start-pos (or start 0))
(end-pos (or end (length object)))
(all-matches (tp-search object property value))
(filtered-matches (seq-filter (lambda (m)
(>= (car m) start-pos))
(and (>= (car m) start-pos)
(<= (cadr m) end-pos)))
all-matches))
(matches (seq-take filtered-matches count)))
(funcall function (car (last matches)) object)
(when matches
(funcall function (car (last matches)) object))
(length matches)))
;; Buffer or nil
(t
(let ((matches 0)
(buf (or object (current-buffer))))
(let* ((buf (or object (current-buffer)))
(matches 0))
(with-current-buffer buf
(save-excursion
(when point (goto-char point))
(dotimes (i count)
(when-let ((match (tp-search-forward property value t)))
(when (= i (1- count))
(funcall function match buf))
(cl-incf matches)))))
(let ((search-start (or start (point-min)))
(search-end (or end (point-max))))
(save-excursion
(goto-char search-start)
(dotimes (i count)
(when-let ((match (tp-search-forward property value t)))
(when (<= (prop-match-end match) search-end)
(when (= i (1- count))
(funcall function match buf))
(cl-incf matches)))))))
matches)))))
(defun tp-forward-do (function property &optional value object point n)
"Search forward N times for text with PROPERTY and apply FUNCTION only to the last match.
(defun tp-forward-do (function property &optional value object times start end)
"Search forward for text with PROPERTY and apply FUNCTION to the last match.
FUNCTION receives the matched text as its first argument. Optionally,
FUNCTION can accept two additional arguments: START and END, representing
the start and end positions of the match. If FUNCTION accepts 2 arguments,
it receives (TEXT START). If it accepts 3 or more arguments, it receives
(TEXT START END). The return value of FUNCTION replaces the matched text
in the string or buffer.
FUNCTION receives (TEXT &optional START END) where TEXT is the matched text,
START and END are the positions of the match. The return value of FUNCTION
replaces the matched text in the string or buffer.
N is the number of searches, defaulting to 1. The function searches N times
but only applies FUNCTION to the last (Nth) match found.
VALUE is the optional value to match.
PROPERTY is the text property to search for.
VALUE is the optional value to match; nil means search for PROPERTY without
matching value.
OBJECT can be a buffer or string; nil defaults to current buffer.
POINT is the starting position for search; for buffers nil means current point,
for strings nil means 0.
TIMES is the number of searches, defaulting to 1. The function searches
TIMES times but only applies FUNCTION to the last (Nth) match found.
START and END define the search range; defaults are object start and end.
Returns the number of successful matches.
@ -1048,106 +1051,115 @@ Example:
(setq my-string (copy-sequence \"hello world hello\"))
(tp-set 0 5 \\='(marker t) my-string)
(tp-set 12 17 \\='(marker t) my-string)
(tp-forward-do #\\='upcase \\='marker nil my-string nil 2)
(tp-forward-do #\\='upcase \\='marker nil my-string 2)
;; => \"hello world HELLO\" - only the 2nd match is upcased
;; Use start and end positions
;; Use start and end positions in function
(tp-forward-do (lambda (txt start end) (format \"[%d-%d]%s\" start end txt))
\\='marker nil my-string nil 2)"
\\='marker nil my-string 2)
;; Search within a range
(tp-forward-do #\\='upcase \\='marker nil my-string 1 0 10)"
(let ((arity (func-arity function)))
(tp--forward-do
(lambda (match obj)
(let* ((start (if (listp match) (car match) (prop-match-beginning match)))
(end (if (listp match) (cadr match) (prop-match-end match)))
(let* ((m-start (if (listp match) (car match) (prop-match-beginning match)))
(m-end (if (listp match) (cadr match) (prop-match-end match)))
(text (if (stringp obj)
(substring obj start end)
(buffer-substring start end)))
(substring obj m-start m-end)
(buffer-substring m-start m-end)))
(max-arity (cdr arity))
(can-accept-start (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 2))))
(can-accept-end (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 3))))
(new-text (cond
(can-accept-end (funcall function text start end))
(can-accept-start (funcall function text start))
(can-accept-end (funcall function text m-start m-end))
(can-accept-start (funcall function text m-start))
(t (funcall function text)))))
(when (stringp new-text)
(if (stringp obj)
;; For strings: copy text content and properties separately
(let ((len (min (length new-text) (- end start))))
(let ((len (min (length new-text) (- m-end m-start))))
;; Copy text content
(store-substring obj start new-text)
(store-substring obj m-start new-text)
;; Copy properties from new-text to obj
(let ((pos 0))
(while (< pos len)
(let* ((props (text-properties-at pos new-text))
(next-change (or (next-property-change pos new-text) len)))
(when props
(set-text-properties (+ start pos)
(+ start (min next-change len))
(set-text-properties (+ m-start pos)
(+ m-start (min next-change len))
props
obj))
(setq pos next-change)))))
;; For buffers, delete and insert
(unless (equal new-text text)
(save-excursion
(delete-region start end)
(goto-char start)
(delete-region m-start m-end)
(goto-char m-start)
(insert new-text)))))))
property value object point n)))
property value object times start end)))
(defun tp--backward-do (function property &optional value object point n)
"Internal: Search backward N times for PROPERTY and apply FUNCTION to the last match.
(defun tp--backward-do (function property &optional value object times start end)
"Internal: Search backward TIMES for PROPERTY and apply FUNCTION to the last match.
FUNCTION receives two arguments: the prop-match object (or list for strings)
and OBJECT.
N is the number of searches, defaulting to 1.
TIMES is the number of searches, defaulting to 1.
VALUE is the optional value to match.
OBJECT can be a buffer or string; nil defaults to current buffer.
POINT is the starting position for search; for buffers nil means current point,
for strings nil means end of string.
START and END define the search range; defaults are object start and end.
Returns the number of successful matches."
(let ((count (or n 1)))
(let ((count (or times 1)))
(cond
;; String object - reverse the matches
((stringp object)
(let* ((start-pos (or point (length object)))
(let* ((start-pos (or start 0))
(end-pos (or end (length object)))
(all-matches (tp-search object property value))
(filtered-matches
(seq-filter (lambda (m) (<= (cadr m) start-pos)) all-matches))
(seq-filter (lambda (m)
(and (>= (car m) start-pos)
(<= (cadr m) end-pos)))
all-matches))
(matches (seq-take (nreverse filtered-matches) count)))
(funcall function (car (last matches)) object)
(when matches
(funcall function (car (last matches)) object))
(length matches)))
;; Buffer or nil
(t
(let ((matches 0)
(buf (or object (current-buffer))))
(let* ((buf (or object (current-buffer)))
(matches 0))
(with-current-buffer buf
(save-excursion
(when point (goto-char point))
(dotimes (i count)
(when-let ((match (tp-search-backward property value)))
(when (= i (1- count))
(funcall function match buf))
(cl-incf matches)))))
(let ((search-start (or start (point-min)))
(search-end (or end (point-max))))
(save-excursion
(goto-char search-end)
(dotimes (i count)
(when-let ((match (tp-search-backward property value)))
(when (>= (prop-match-beginning match) search-start)
(when (= i (1- count))
(funcall function match buf))
(cl-incf matches)))))))
matches)))))
(defun tp-backward-do (function property &optional value object point n)
"Search backward N times for text with PROPERTY and apply FUNCTION only to the last match.
(defun tp-backward-do (function property &optional value object times start end)
"Search backward for text with PROPERTY and apply FUNCTION to the last match.
FUNCTION receives the matched text as its first argument. Optionally,
FUNCTION can accept two additional arguments: START and END, representing
the start and end positions of the match. If FUNCTION accepts 2 arguments,
it receives (TEXT START). If it accepts 3 or more arguments, it receives
(TEXT START END). The return value of FUNCTION replaces the matched text
in the string or buffer.
FUNCTION receives (TEXT &optional START END) where TEXT is the matched text,
START and END are the positions of the match. The return value of FUNCTION
replaces the matched text in the string or buffer.
N is the number of searches, defaulting to 1. The function searches N times
but only applies FUNCTION to the last (Nth) match found.
VALUE is the optional value to match.
PROPERTY is the text property to search for.
VALUE is the optional value to match; nil means search for PROPERTY without
matching value.
OBJECT can be a buffer or string; nil defaults to current buffer.
POINT is the starting position for search; for buffers nil means current point,
for strings nil means end of string.
TIMES is the number of searches, defaulting to 1. The function searches
TIMES times but only applies FUNCTION to the last (Nth) match found.
START and END define the search range; defaults are object start and end.
Returns the number of successful matches.
@ -1161,52 +1173,56 @@ Example:
(setq my-string (copy-sequence \"hello world hello\"))
(tp-set 0 5 \\='(marker t) my-string)
(tp-set 12 17 \\='(marker t) my-string)
(tp-backward-do #\\='upcase \\='marker nil my-string nil 2)
;; => \"hello world HELLO\" - only the 2nd (last) match is upcased
;; Use start and end positions
(tp-backward-do #\\='upcase \\='marker nil my-string 2)
;; => \"HELLO world hello\" - only the 2nd (last) match is upcased
;; Use start and end positions in function
(tp-backward-do (lambda (txt start end) (format \"[%d-%d]%s\" start end txt))
\\='marker nil my-string nil 2)"
\\='marker nil my-string 2)
;; Search within a range
(tp-backward-do #\\='upcase \\='marker nil my-string 1 0 10)"
(let ((arity (func-arity function)))
(tp--backward-do
(lambda (match obj)
(let* ((start (if (listp match) (car match) (prop-match-beginning match)))
(end (if (listp match) (cadr match) (prop-match-end match)))
(let* ((m-start (if (listp match) (car match) (prop-match-beginning match)))
(m-end (if (listp match) (cadr match) (prop-match-end match)))
(text (if (stringp obj)
(substring obj start end)
(buffer-substring start end)))
(substring obj m-start m-end)
(buffer-substring m-start m-end)))
(max-arity (cdr arity))
(can-accept-start (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 2))))
(can-accept-end (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 3))))
(new-text (cond
(can-accept-end (funcall function text start end))
(can-accept-start (funcall function text start))
(can-accept-end (funcall function text m-start m-end))
(can-accept-start (funcall function text m-start))
(t (funcall function text)))))
(when (stringp new-text)
(if (stringp obj)
;; For strings: copy text content and properties separately
(let ((len (min (length new-text) (- end start))))
(let ((len (min (length new-text) (- m-end m-start))))
;; Copy text content
(store-substring obj start new-text)
(store-substring obj m-start new-text)
;; Copy properties from new-text to obj
(let ((pos 0))
(while (< pos len)
(let* ((props (text-properties-at pos new-text))
(next-change (or (next-property-change pos new-text) len)))
(when props
(set-text-properties (+ start pos)
(+ start (min next-change len))
(set-text-properties (+ m-start pos)
(+ m-start (min next-change len))
props
obj))
(setq pos next-change)))))
;; For buffers, delete and insert
(unless (equal new-text text)
(save-excursion
(delete-region start end)
(goto-char start)
(delete-region m-start m-end)
(goto-char m-start)
(insert new-text)))))))
property value object point n)))
property value object times start end)))
(defun tp-search (start-or-string
&optional end-or-property property-or-value value object)
@ -1298,56 +1314,62 @@ Each element contains the start position, end position, and property value."
(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)
(defun tp--search-do (function property &optional value object start end)
"Internal: Execute FUNCTION on all matches of PROPERTY.
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)
Signature: (tp--search-do FUNCTION PROPERTY &optional VALUE OBJECT START END)
FUNCTION receives two arguments: the prop-match (list of START END VALUE) and OBJECT.
PROPERTY is the text property to search for.
VALUE is the optional value to match; nil means search for PROPERTY without matching value.
OBJECT can be a buffer or string; nil defaults to current buffer.
START and END define the search range; defaults are object start and end.
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)
(let* ((obj (or object (current-buffer)))
(all-matches (if (stringp obj)
(tp-search obj property value)
(let ((s (or start (point-min)))
(e (or end (point-max))))
(tp-search s e property value obj))))
(filtered-matches
(if (and (not (stringp obj)) start end)
(seq-filter (lambda (m)
(and (>= (car m) start)
(<= (cadr m) end)))
all-matches)
(if (stringp obj)
(let ((s (or start 0))
(e (or end (length obj))))
(seq-filter (lambda (m)
(and (>= (car m) s)
(<= (cadr m) e)))
all-matches))
all-matches))))
(dolist (match filtered-matches)
(funcall function match obj))
(length matches)))
(length filtered-matches)))
(defun tp-search-map (function start-or-string &optional end-or-property property-or-value value object)
"Apply FUNCTION to matched text for all matches of PROPERTY.
(defun tp-search-map (function property &optional value object start end)
"Apply FUNCTION to all matches of PROPERTY in OBJECT.
This function supports two calling conventions:
Signature: (tp-search-map FUNCTION PROPERTY &optional VALUE OBJECT START END)
1. Buffer/string region:
(tp-search-map FUNCTION START END PROPERTY &optional VALUE OBJECT)
FUNCTION receives (TEXT &optional START END IDX) where:
- TEXT is the matched text
- START and END are the positions of the match
- IDX is the 0-based index of the current match
2. Entire string:
(tp-search-map FUNCTION STRING PROPERTY &optional VALUE)
FUNCTION receives the matched text as its first argument, and optionally
the 0-based index of the current match as its second argument.
FUNCTION can either:
- Return a new/modified string to replace the matched text
- Modify the text properties of the argument and return it
- Return nil to skip replacement
For text content changes, the return value replaces the matched text.
For property-only changes, the properties are merged back to the original.
PROPERTY is the text property to search for.
VALUE is the optional value to match; nil means search for PROPERTY without
matching value.
OBJECT can be a buffer or string; nil defaults to current buffer.
START and END define the search range; defaults are object start and end.
Returns the number of matches processed.
@ -1358,55 +1380,65 @@ If the replacement is longer, it will be truncated.
Example:
;; Upcase all matched text
(tp-search-map #\\='upcase my-string \\='marker)
(tp-search-map #\\='upcase \\='marker nil my-string)
;; Add properties to matched text
(tp-search-map (lambda (txt) (tp-add txt \\='face \\='bold)) str \\='marker)
;; Use index to add numbering
(tp-search-map (lambda (txt idx) (format \"%d: %s\" idx txt)) str \\='marker)"
(let ((obj (cond
((stringp start-or-string) start-or-string)
((numberp start-or-string) (or object (current-buffer)))
(t nil)))
(idx 0)
(arity (func-arity function)))
(tp-search-map (lambda (txt) (tp-add txt \\='face \\='bold)) \\='marker nil str)
;; Use start, end, and index
(tp-search-map (lambda (txt start end idx)
(format \"[%d:%d-%d]%s\" idx start end txt))
\\='marker nil str)
;; Search within a range
(tp-search-map #\\='upcase \\='marker nil my-string 0 10)"
(let* ((obj (or object (current-buffer)))
(idx 0)
(arity (func-arity function)))
(tp--search-do
(lambda (match obj)
(let* ((start (car match))
(end (cadr match))
(let* ((m-start (car match))
(m-end (cadr match))
(text (if (stringp obj)
(substring obj start end)
(buffer-substring start end)))
(substring obj m-start m-end)
(buffer-substring m-start m-end)))
(max-arity (cdr arity))
(can-accept-start (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 2))))
(can-accept-end (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 3))))
(can-accept-idx (or (eq max-arity 'many)
(and (numberp max-arity) (>= max-arity 2))))
(new-text (if can-accept-idx
(funcall function text idx)
(funcall function text))))
(and (numberp max-arity) (>= max-arity 4))))
(new-text (cond
(can-accept-idx (funcall function text m-start m-end idx))
(can-accept-end (funcall function text m-start m-end))
(can-accept-start (funcall function text m-start))
(t (funcall function text)))))
(setq idx (1+ idx))
(when (stringp new-text)
(if (stringp obj)
;; For strings: copy text content and properties separately
(let ((len (min (length new-text) (- end start))))
(let ((len (min (length new-text) (- m-end m-start))))
;; Copy text content
(store-substring obj start new-text)
(store-substring obj m-start new-text)
;; Copy properties from new-text to obj
(let ((pos 0))
(while (< pos len)
(let* ((props (text-properties-at pos new-text))
(next-change (or (next-property-change pos new-text) len)))
(when props
(set-text-properties (+ start pos)
(+ start (min next-change len))
(set-text-properties (+ m-start pos)
(+ m-start (min next-change len))
props
obj))
(setq pos next-change)))))
;; For buffers, delete and insert
(unless (equal new-text text)
(save-excursion
(delete-region start end)
(goto-char start)
(delete-region m-start m-end)
(goto-char m-start)
(insert new-text)))))))
start-or-string end-or-property property-or-value value object)))
property value object start end)))
;;; Query Functions