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-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-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-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-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 matched text for N backward matches (with optional start point) | | [`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`](#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 #### Property Layer Definition Functions
| Function | Description | | Function | Description |
@ -896,60 +896,57 @@ Search forward/backward N times for text with PROPERTY.
#### `tp-forward-do` / `tp-backward-do` #### `tp-forward-do` / `tp-backward-do`
```elisp ```elisp
(tp-forward-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 POINT N) (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. - **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. - **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. - **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, - **TIMES** is the number of searches, defaulting to 1. The function searches TIMES times but only applies FUNCTION to the last (Nth) match found.
for strings nil means 0 (forward) or end of string (backward). - **START** and **END** define the search range; defaults are object start and end.
- Returns the number of successful matches. - Returns the number of successful matches.
**Examples:** **Examples:**
```elisp ```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 ;; Upcase only the last (2nd) match in string
(let ((my-string (copy-sequence "hello world hello"))) (let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(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) my-string)
;; => "hello world HELLO" ; Only the 2nd match is upcased ;; => "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"))) (let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(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) 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 ;; Using function with start and end parameters
(with-temp-buffer (let ((my-string (copy-sequence "hello world hello")))
(insert "hello world test") (tp-set 0 5 '(marker t) my-string)
(tp-set 1 6 '(marker t)) (tp-set 12 17 '(marker t) my-string)
(tp-set 13 17 '(marker t))
(goto-char 1)
(tp-forward-do (tp-forward-do
(lambda (text start end) (lambda (text start end)
(format "[%d-%d]%s" start end text)) (format "[%d-%d]%s" start end text))
'marker nil nil nil 2) 'marker nil my-string 2)
(buffer-string)) my-string)
;; => "hello world [13-17]test" ; Only the last match is transformed ;; => "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 #### `tp-search-map` - Apply Function to Matched Text
```elisp ```elisp
;; Buffer/string region (tp-search-map FUNCTION PROPERTY &optional VALUE OBJECT START END)
(tp-search-map FUNCTION START END PROPERTY &optional VALUE OBJECT)
;; Entire string
(tp-search-map FUNCTION STRING PROPERTY &optional VALUE)
``` ```
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 - **FUNCTION** receives `(TEXT &optional START END IDX)` where:
the 0-based index of the current match as its second argument. The return value - TEXT is the matched text
of FUNCTION replaces the matched text in the string or buffer. - 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. - Returns the number of matches processed.
**Examples:** **Examples:**
@ -1021,38 +1020,37 @@ Apply FUNCTION to matched text for all matches of PROPERTY.
(let ((my-string (copy-sequence "hello world hello"))) (let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(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) my-string)
;; => "HELLO world HELLO" ;; => "HELLO world HELLO"
;; Upcase all markers in buffer range ;; Search only in a range
(with-temp-buffer (let ((my-string (copy-sequence "hello world hello")))
(insert "hello world test") (tp-set 0 5 '(marker t) my-string)
(tp-set 1 6 '(marker t)) (tp-set 12 17 '(marker t) my-string)
(tp-set 13 17 '(marker t)) (tp-search-map #'upcase 'marker nil my-string 0 10)
(tp-search-map #'upcase 1 17 'marker) my-string)
(buffer-string)) ;; => "HELLO world hello" ; Only first match in range 0-10
;; => "HELLO world TEST"
;; Custom transformation with index ;; Custom transformation with start, end, and index
(let ((my-string (copy-sequence "aaa bbb ccc"))) (let ((my-string (copy-sequence "aaa bbb ccc")))
(tp-set 0 3 '(marker t) my-string) (tp-set 0 3 '(marker t) my-string)
(tp-set 4 7 '(marker t) my-string) (tp-set 4 7 '(marker t) my-string)
(tp-set 8 11 '(marker t) my-string) (tp-set 8 11 '(marker t) my-string)
(tp-search-map (tp-search-map
(lambda (text idx) (lambda (text start end idx)
(format "%d:%s" idx text)) (format "%d:%s" idx text))
my-string 'marker) 'marker nil my-string)
my-string) my-string)
;; => "0:aaa1:bbb2:ccc" ;; => "0:aaa1:bbb2:ccc"
;; Custom transformation without index ;; Custom transformation without optional parameters
(let ((my-string (copy-sequence "hello world"))) (let ((my-string (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-search-map (tp-search-map
(lambda (text) (lambda (text)
(concat "[" text "]")) (concat "[" text "]"))
my-string 'marker) 'marker nil my-string)
my-string) my-string)
;; => "[hello] world" ;; => "[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-search-backward`](#tp-search-forward--tp-search-backward) | text-property-search-backward 的原始包装 |
| [`tp-forward`](#tp-forward--tp-backward) | 向前搜索 N 次具有属性的文本（支持缓冲区和字符串） | | [`tp-forward`](#tp-forward--tp-backward) | 向前搜索 N 次具有属性的文本（支持缓冲区和字符串） |
| [`tp-backward`](#tp-forward--tp-backward) | 向后搜索 N 次具有属性的文本（支持缓冲区和字符串） | | [`tp-backward`](#tp-forward--tp-backward) | 向后搜索 N 次具有属性的文本（支持缓冲区和字符串） |
| [`tp-forward-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) | 对 N 个向后匹配的文本应用函数（支持起始位置） | | [`tp-backward-do`](#tp-forward-do--tp-backward-do) | 向后搜索并对最后一个匹配应用函数（支持起始和结束范围） |
| [`tp-search`](#tp-search---搜索所有匹配) | 在范围或字符串中搜索所有匹配的属性 | | [`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` #### `tp-forward-do` / `tp-backward-do`
```elisp ```elisp
(tp-forward-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 POINT N) (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 的返回值将替换字符串或缓冲区中的匹配文本。 - **FUNCTION** 的参数是 `(TEXT &optional START END)`，其中 TEXT 是此次匹配到的文本，START 和 END 为开始结束的位置。FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。
- **N** 是搜索次数，默认为 1。该函数会搜索 N 次，但仅对找到的最后（第 N 次）匹配应用 FUNCTION。 - **PROPERTY** 是要搜索的文本属性。
- **OBJECT** 可以是缓冲区或字符串；nil 默认为当前缓冲区。 - **VALUE** 为 nil 时，表示搜索 PROPERTY 属性，不用匹配值。
- **POINT** 是搜索的起始位置；对于缓冲区 nil 表示当前位置，对于字符串 nil 表示 0（向前）或字符串末尾（向后）。 - **OBJECT** 默认是当前 buffer 或指定的字符串或指定的 buffer。
- **TIMES** 表示向前/向后搜索几次，默认搜索一次。该函数会搜索 TIMES 次，但仅对找到的最后（第 N 次）匹配应用 FUNCTION。
- **START** 和 **END** 默认为 OBJECT 的起始和结束位置。
- 返回成功匹配的数量。 - 返回成功匹配的数量。
**示例：** **示例：**
```elisp ```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 次）匹配的文本转为大写 ;; 仅将最后一次（第 2 次）匹配的文本转为大写
(let ((my-string (copy-sequence "hello world hello"))) (let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(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) my-string)
;; => "hello world HELLO" ; 仅第 2 次匹配被转为大写 ;; => "hello world HELLO" ; 仅第 2 次匹配被转为大写
;; 从特定位置开始搜索（仅找到 1 次匹配并转换） ;; 在指定范围内搜索（仅搜索范围 6-17 内的匹配）
(let ((my-string (copy-sequence "hello world hello"))) (let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(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) my-string)
;; => "hello world HELLO" ; 只处理位置 6 之后的匹配 ;; => "hello world HELLO" ; 范围 6-17 内仅有 1 个匹配
;; 使用带有 start 和 end 参数的函数 ;; 使用带有 start 和 end 参数的函数
(with-temp-buffer (let ((my-string (copy-sequence "hello world hello")))
(insert "hello world test") (tp-set 0 5 '(marker t) my-string)
(tp-set 1 6 '(marker t)) (tp-set 12 17 '(marker t) my-string)
(tp-set 13 17 '(marker t))
(goto-char 1)
(tp-forward-do (tp-forward-do
(lambda (text start end) (lambda (text start end)
(format "[%d-%d]%s" start end text)) (format "[%d-%d]%s" start end text))
'marker nil nil nil 2) 'marker nil my-string 2)
(buffer-string)) my-string)
;; => "hello world [13-17]test" ; 仅最后一次匹配被转换 ;; => "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` - 对匹配文本应用函数 #### `tp-search-map` - 对匹配文本应用函数
```elisp ```elisp
;; 缓冲区/字符串区域 (tp-search-map FUNCTION PROPERTY &optional VALUE OBJECT START END)
(tp-search-map FUNCTION START END PROPERTY &optional VALUE OBJECT)
;; 整个字符串
(tp-search-map FUNCTION STRING PROPERTY &optional VALUE)
``` ```
对所有 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"))) (let ((my-string (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-set 12 17 '(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) my-string)
;; => "HELLO world HELLO" ;; => "HELLO world HELLO"
;; 将缓冲区范围内所有 marker 文本转为大写 ;; 仅在指定范围内搜索
(with-temp-buffer (let ((my-string (copy-sequence "hello world hello")))
(insert "hello world test") (tp-set 0 5 '(marker t) my-string)
(tp-set 1 6 '(marker t)) (tp-set 12 17 '(marker t) my-string)
(tp-set 13 17 '(marker t)) (tp-search-map #'upcase 'marker nil my-string 0 10)
(tp-search-map #'upcase 1 17 'marker) my-string)
(buffer-string)) ;; => "HELLO world hello" ; 仅范围 0-10 内的第一个匹配被处理
;; => "HELLO world TEST"
;; 使用索引的自定义转换 ;; 使用 start、end 和 idx 参数的自定义转换
(let ((my-string (copy-sequence "aaa bbb ccc"))) (let ((my-string (copy-sequence "aaa bbb ccc")))
(tp-set 0 3 '(marker t) my-string) (tp-set 0 3 '(marker t) my-string)
(tp-set 4 7 '(marker t) my-string) (tp-set 4 7 '(marker t) my-string)
(tp-set 8 11 '(marker t) my-string) (tp-set 8 11 '(marker t) my-string)
(tp-search-map (tp-search-map
(lambda (text idx) (lambda (text start end idx)
(format "%d:%s" idx text)) (format "%d:%s" idx text))
my-string 'marker) 'marker nil my-string)
my-string) my-string)
;; => "0:aaa1:bbb2:ccc" ;; => "0:aaa1:bbb2:ccc"
;; 不使用索引的自定义转换 ;; 不使用可选参数的自定义转换
(let ((my-string (copy-sequence "hello world"))) (let ((my-string (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) my-string) (tp-set 0 5 '(marker t) my-string)
(tp-search-map (tp-search-map
(lambda (text) (lambda (text)
(concat "[" text "]")) (concat "[" text "]"))
my-string 'marker) 'marker nil my-string)
my-string) my-string)
;; => "[hello] world" ;; => "[hello] world"
``` ```

262
tp-tests.el
View File

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

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