diff --git a/README.md b/README.md index 582af37..e0d3371 100644 --- a/README.md +++ b/README.md @@ -86,20 +86,18 @@ A complete overview of all tp.el functions organized by category: #### Search & Navigation Functions | Function | Description | |----------|-------------| -| [`tp-forward`](#tp-forward--tp-backward) | Search forward for text with property | -| [`tp-backward`](#tp-forward--tp-backward) | Search backward for text with property | -| [`tp-next`](#tp-next--tp-prev) | Get next position with text properties | -| [`tp-prev`](#tp-next--tp-prev) | Get previous position with text properties | -| [`tp-goto-next`](#tp-goto-next--tp-goto-prev) | Move point to next text with property | -| [`tp-goto-prev`](#tp-goto-next--tp-goto-prev) | Move point to previous text with property | -| [`tp-regions-map`](#tp-regions-map--tp-strings-map) | Apply function to all regions with property | -| [`tp-strings-map`](#tp-regions-map--tp-strings-map) | Apply function to all strings with property | +| [`tp-search-forward`](#tp-search-forward--tp-search-backward) | Raw wrapper for text-property-search-forward | +| [`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 | +| [`tp-backward`](#tp-forward--tp-backward) | Search backward N times for text with property | +| [`tp-forward-do`](#tp-forward-do--tp-backward-do) | Apply function to N forward matches | +| [`tp-backward-do`](#tp-forward-do--tp-backward-do) | Apply function to N backward matches | +| [`tp-search`](#tp-search---search-all-matches) | Search all matching properties in range or string | +| [`tp-search-do`](#tp-search-do---apply-function-to-all-matches) | Apply function to all matching properties | #### Query Functions | Function | Description | |----------|-------------| -| [`tp-in`](#tp-in---find-regions-with-property) | Find all regions with a specific property | -| [`tp-all`](#tp-all---get-all-propertized-regions) | Get all propertized regions | | [`tp-intervals`](#tp-intervals---get-property-intervals) | Get property intervals in a region | | [`tp-empty-p`](#tp-empty-p---check-for-properties) | Check if object has no properties | | [`tp-plist`](#tp-plist---get-merged-properties) | Get merged plist of all properties | @@ -552,14 +550,31 @@ Add/merge properties on regexp matches with deep merge support. ### Search & Navigation Functions +#### `tp-search-forward` / `tp-search-backward` + +```elisp +(tp-search-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) +(tp-search-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) +``` + +Raw wrappers for Emacs's `text-property-search-forward` and `text-property-search-backward`. +These are low-level search functions that work directly with prop-match objects. + +--- + #### `tp-forward` / `tp-backward` ```elisp -(tp-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) -(tp-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) +(tp-forward PROPERTY &optional VALUE OBJECT N) +(tp-backward PROPERTY &optional VALUE OBJECT N) ``` -Search forward/backward for text with PROPERTY. +Search forward/backward N times for text with PROPERTY. + +- **N** is the number of searches, defaulting to 1. +- **VALUE** is the optional value to match. +- **OBJECT** can be a buffer; nil defaults to current buffer. +- Returns the prop-match object from the last successful search. **Examples:** @@ -569,86 +584,105 @@ Search forward/backward for text with PROPERTY. ;; Find next text where 'type equals 'heading (tp-forward 'type 'heading) + +;; Search forward 3 times +(tp-forward 'marker nil nil 3) ``` --- -#### `tp-next` / `tp-prev` +#### `tp-forward-do` / `tp-backward-do` ```elisp -(tp-next &optional POINT PROPERTY VALUE) -(tp-prev &optional POINT PROPERTY VALUE) +(tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT N) +(tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT N) ``` -Get the next/previous position with text properties. +Search forward/backward N times for text with PROPERTY and apply FUNCTION to each match. ---- - -#### `tp-goto-next` / `tp-goto-prev` - -```elisp -(tp-goto-next &optional PROPERTY VALUE) -(tp-goto-prev &optional PROPERTY VALUE) -``` - -Move point to next/previous text with PROPERTY. - ---- - -#### `tp-regions-map` / `tp-strings-map` - -```elisp -(tp-regions-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT) -(tp-strings-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT) -``` - -Apply a function to all regions/strings with PROPERTY. +- **FUNCTION** receives two arguments: the prop-match object and OBJECT. +- **N** is the number of searches, defaulting to 1. +- Returns the number of successful matches. **Examples:** ```elisp -;; Upcase all marked text -(tp-strings-map - (lambda (str idx) - (message "Found: %s at index %d" str idx)) - 'marker) +;; Apply function to next 3 markers +(tp-forward-do + (lambda (match obj) + (message "Found at %d" (prop-match-beginning match))) + 'marker nil nil 3) +``` + +--- + +#### `tp-search` - Search All Matches + +```elisp +;; Buffer/string region +(tp-search START END PROPERTY &optional VALUE OBJECT) + +;; Entire string +(tp-search STRING PROPERTY &optional VALUE) +``` + +Search for all text with PROPERTY in a buffer/string range or entire string. + +Returns a list of (START END VALUE) for all matching regions. + +**Examples:** + +```elisp +;; Find all 'marker properties in buffer range +(tp-search 1 100 'marker) +;; => ((5 10 t) (20 25 t) ...) + +;; Find all 'type properties with value 'heading in string +(tp-search my-string 'type 'heading) +;; => ((0 10 heading) (50 60 heading) ...) + +;; Filter by value +(tp-search 1 100 'type 'heading) +``` + +--- + +#### `tp-search-do` - Apply Function to All Matches + +```elisp +;; Buffer/string region +(tp-search-do FUNCTION START END PROPERTY &optional VALUE OBJECT) + +;; Entire string +(tp-search-do FUNCTION STRING PROPERTY &optional VALUE) +``` + +Execute FUNCTION on all matches of PROPERTY in a buffer/string range or entire string. + +- **FUNCTION** receives two arguments: the match (list of START END VALUE) and OBJECT. +- Returns the number of matches processed. + +**Examples:** + +```elisp +;; Process all markers in buffer range +(tp-search-do + (lambda (match obj) + (message "Found at %d-%d with value %s" + (car match) (cadr match) (caddr match))) + 1 100 'marker) + +;; Process all headings in string +(tp-search-do + (lambda (match obj) + (upcase (substring obj (car match) (cadr match)))) + my-string 'type 'heading) ``` --- ### Query Functions -#### `tp-in` - Find Regions with Property - -```elisp -(tp-in PROPERTY &optional VALUE START END) -``` - -Get all regions with PROPERTY in current buffer. - -**Examples:** - -```elisp -;; Get all regions with 'marker property -(tp-in 'marker) -;; => ((1 5 (marker t ...)) (10 15 (marker t ...))) - -;; Filter by value -(tp-in 'type 'heading) -``` - ---- - -#### `tp-all` - Get All Propertized Regions - -```elisp -(tp-all &optional START END) -``` - -Get all regions with any text properties. - ---- - #### `tp-intervals` - Get Property Intervals ```elisp @@ -662,20 +696,54 @@ Get all text property intervals in a region. #### `tp-empty-p` - Check for Properties ```elisp -(tp-empty-p OBJECT) +(tp-empty-p &optional OBJECT) ``` Return t if OBJECT has no text properties. +- **OBJECT** can be a string or buffer; nil defaults to current buffer. + +**Examples:** + +```elisp +;; Check current buffer +(tp-empty-p) +(tp-empty-p nil) + +;; Check specific string +(tp-empty-p "plain string") ; => t +(tp-empty-p (propertize "styled" 'face 'bold)) ; => nil + +;; Check specific buffer +(tp-empty-p my-buffer) +``` + --- #### `tp-plist` - Get Merged Properties ```elisp +;; Buffer/string region (tp-plist START END &optional OBJECT) + +;; Entire string +(tp-plist STRING) ``` -Get a merged plist of all properties in a region. +Get a merged plist of all properties in a region or entire string. + +**Examples:** + +```elisp +;; Get properties from buffer region +(tp-plist 1 10) + +;; Get properties from string region +(tp-plist 0 5 my-string) + +;; Get properties from entire string +(tp-plist my-string) +``` --- diff --git a/README_CN.md b/README_CN.md index 309d9a9..3ff4492 100644 --- a/README_CN.md +++ b/README_CN.md @@ -85,20 +85,18 @@ tp.el 所有函数按类别组织的完整概览: #### 搜索和导航函数 | 函数 | 描述 | |------|------| -| [`tp-forward`](#tp-forward--tp-backward) | 向前搜索具有属性的文本 | -| [`tp-backward`](#tp-forward--tp-backward) | 向后搜索具有属性的文本 | -| [`tp-next`](#tp-next--tp-prev) | 获取下一个具有文本属性的位置 | -| [`tp-prev`](#tp-next--tp-prev) | 获取上一个具有文本属性的位置 | -| [`tp-goto-next`](#tp-goto-next--tp-goto-prev) | 移动光标到下一个具有属性的文本 | -| [`tp-goto-prev`](#tp-goto-next--tp-goto-prev) | 移动光标到上一个具有属性的文本 | -| [`tp-regions-map`](#tp-regions-map--tp-strings-map) | 对所有具有属性的区域应用函数 | -| [`tp-strings-map`](#tp-regions-map--tp-strings-map) | 对所有具有属性的字符串应用函数 | +| [`tp-search-forward`](#tp-search-forward--tp-search-backward) | text-property-search-forward 的原始包装 | +| [`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-search`](#tp-search---搜索所有匹配) | 在范围或字符串中搜索所有匹配的属性 | +| [`tp-search-do`](#tp-search-do---对所有匹配应用函数) | 对所有匹配的属性应用函数 | #### 查询函数 | 函数 | 描述 | |------|------| -| [`tp-in`](#tp-in---查找具有属性的区域) | 查找所有具有特定属性的区域 | -| [`tp-all`](#tp-all---获取所有带属性的区域) | 获取所有带属性的区域 | | [`tp-intervals`](#tp-intervals---获取属性区间) | 获取区域中的属性区间 | | [`tp-empty-p`](#tp-empty-p---检查属性) | 检查对象是否没有属性 | | [`tp-plist`](#tp-plist---获取合并的属性) | 获取所有属性的合并列表 | @@ -551,14 +549,31 @@ tp.el 所有函数按类别组织的完整概览: ### 搜索和导航函数 +#### `tp-search-forward` / `tp-search-backward` + +```elisp +(tp-search-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) +(tp-search-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) +``` + +Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的原始包装。 +这些是直接使用 prop-match 对象的底层搜索函数。 + +--- + #### `tp-forward` / `tp-backward` ```elisp -(tp-forward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) -(tp-backward PROPERTY &optional VALUE PREDICATE NOT-CURRENT) +(tp-forward PROPERTY &optional VALUE OBJECT N) +(tp-backward PROPERTY &optional VALUE OBJECT N) ``` -向前/向后搜索具有 PROPERTY 的文本。 +向前/向后搜索 N 次具有 PROPERTY 的文本。 + +- **N** 是搜索次数,默认为 1。 +- **VALUE** 是可选的匹配值。 +- **OBJECT** 可以是缓冲区;nil 默认为当前缓冲区。 +- 返回最后一次成功搜索的 prop-match 对象。 **示例:** @@ -568,86 +583,105 @@ tp.el 所有函数按类别组织的完整概览: ;; 查找下一个 'type 等于 'heading 的文本 (tp-forward 'type 'heading) + +;; 向前搜索 3 次 +(tp-forward 'marker nil nil 3) ``` --- -#### `tp-next` / `tp-prev` +#### `tp-forward-do` / `tp-backward-do` ```elisp -(tp-next &optional POINT PROPERTY VALUE) -(tp-prev &optional POINT PROPERTY VALUE) +(tp-forward-do FUNCTION PROPERTY &optional VALUE OBJECT N) +(tp-backward-do FUNCTION PROPERTY &optional VALUE OBJECT N) ``` -获取下一个/上一个具有文本属性的位置。 +向前/向后搜索 N 次具有 PROPERTY 的文本,并对每个匹配应用 FUNCTION。 ---- - -#### `tp-goto-next` / `tp-goto-prev` - -```elisp -(tp-goto-next &optional PROPERTY VALUE) -(tp-goto-prev &optional PROPERTY VALUE) -``` - -将光标移动到下一个/上一个具有 PROPERTY 的文本。 - ---- - -#### `tp-regions-map` / `tp-strings-map` - -```elisp -(tp-regions-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT) -(tp-strings-map FUNCTION PROPERTY &optional VALUE PREDICATE COLLECT) -``` - -对所有具有 PROPERTY 的区域/字符串应用函数。 +- **FUNCTION** 接收两个参数:prop-match 对象和 OBJECT。 +- **N** 是搜索次数,默认为 1。 +- 返回成功匹配的数量。 **示例:** ```elisp -;; 处理所有标记的文本 -(tp-strings-map - (lambda (str idx) - (message "找到: %s,索引 %d" str idx)) - 'marker) +;; 对下 3 个 marker 应用函数 +(tp-forward-do + (lambda (match obj) + (message "在 %d 处找到" (prop-match-beginning match))) + 'marker nil nil 3) +``` + +--- + +#### `tp-search` - 搜索所有匹配 + +```elisp +;; 缓冲区/字符串区域 +(tp-search START END PROPERTY &optional VALUE OBJECT) + +;; 整个字符串 +(tp-search STRING PROPERTY &optional VALUE) +``` + +在缓冲区/字符串范围或整个字符串中搜索所有具有 PROPERTY 的文本。 + +返回所有匹配区域的 (START END VALUE) 列表。 + +**示例:** + +```elisp +;; 在缓冲区范围内查找所有 'marker 属性 +(tp-search 1 100 'marker) +;; => ((5 10 t) (20 25 t) ...) + +;; 在字符串中查找所有值为 'heading 的 'type 属性 +(tp-search my-string 'type 'heading) +;; => ((0 10 heading) (50 60 heading) ...) + +;; 按值过滤 +(tp-search 1 100 'type 'heading) +``` + +--- + +#### `tp-search-do` - 对所有匹配应用函数 + +```elisp +;; 缓冲区/字符串区域 +(tp-search-do FUNCTION START END PROPERTY &optional VALUE OBJECT) + +;; 整个字符串 +(tp-search-do FUNCTION STRING PROPERTY &optional VALUE) +``` + +在缓冲区/字符串范围或整个字符串中对所有 PROPERTY 匹配执行 FUNCTION。 + +- **FUNCTION** 接收两个参数:匹配(START END VALUE 列表)和 OBJECT。 +- 返回处理的匹配数量。 + +**示例:** + +```elisp +;; 处理缓冲区范围内的所有 marker +(tp-search-do + (lambda (match obj) + (message "在 %d-%d 处找到,值为 %s" + (car match) (cadr match) (caddr match))) + 1 100 'marker) + +;; 处理字符串中的所有标题 +(tp-search-do + (lambda (match obj) + (upcase (substring obj (car match) (cadr match)))) + my-string 'type 'heading) ``` --- ### 查询函数 -#### `tp-in` - 查找具有属性的区域 - -```elisp -(tp-in PROPERTY &optional VALUE START END) -``` - -获取当前缓冲区中所有具有 PROPERTY 的区域。 - -**示例:** - -```elisp -;; 获取所有具有 'marker 属性的区域 -(tp-in 'marker) -;; => ((1 5 (marker t ...)) (10 15 (marker t ...))) - -;; 按值过滤 -(tp-in 'type 'heading) -``` - ---- - -#### `tp-all` - 获取所有带属性的区域 - -```elisp -(tp-all &optional START END) -``` - -获取所有具有任何文本属性的区域。 - ---- - #### `tp-intervals` - 获取属性区间 ```elisp @@ -661,20 +695,54 @@ tp.el 所有函数按类别组织的完整概览: #### `tp-empty-p` - 检查属性 ```elisp -(tp-empty-p OBJECT) +(tp-empty-p &optional OBJECT) ``` 如果 OBJECT 没有文本属性则返回 t。 +- **OBJECT** 可以是字符串或缓冲区;nil 默认为当前缓冲区。 + +**示例:** + +```elisp +;; 检查当前缓冲区 +(tp-empty-p) +(tp-empty-p nil) + +;; 检查特定字符串 +(tp-empty-p "plain string") ; => t +(tp-empty-p (propertize "styled" 'face 'bold)) ; => nil + +;; 检查特定缓冲区 +(tp-empty-p my-buffer) +``` + --- #### `tp-plist` - 获取合并的属性 ```elisp +;; 缓冲区/字符串区域 (tp-plist START END &optional OBJECT) + +;; 整个字符串 +(tp-plist STRING) ``` -获取区域中所有属性的合并属性列表。 +获取区域或整个字符串中所有属性的合并属性列表。 + +**示例:** + +```elisp +;; 从缓冲区区域获取属性 +(tp-plist 1 10) + +;; 从字符串区域获取属性 +(tp-plist 0 5 my-string) + +;; 从整个字符串获取属性 +(tp-plist my-string) +``` --- diff --git a/tp-tests.el b/tp-tests.el index 40a0a92..f11755d 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -119,6 +119,23 @@ (should (eq (plist-get props 'face) 'bold)) (should (equal (plist-get props 'help-echo) "test"))))) +(ert-deftest tp-test-plist-on-string () + "Test tp-plist works on entire string." + (let ((str (tp-set "Hello World" 'face 'bold 'help-echo "test"))) + (let ((props (tp-plist str))) + (should (eq (plist-get props 'face) 'bold)) + (should (equal (plist-get props 'help-echo) "test"))))) + +(ert-deftest tp-test-plist-on-string-range () + "Test tp-plist works on string range with object parameter." + (let ((str (copy-sequence "Hello World"))) + (tp-set 0 5 '(face bold) str) + (tp-set 6 11 '(help-echo "test") str) + (let ((props-start (tp-plist 0 5 str)) + (props-end (tp-plist 6 11 str))) + (should (eq (plist-get props-start 'face) 'bold)) + (should (equal (plist-get props-end 'help-echo) "test"))))) + ;;; ============================================================ ;;; Text Property Interval Tests ;;; ============================================================ @@ -128,6 +145,29 @@ (should (tp-empty-p "plain string")) (should-not (tp-empty-p (propertize "styled" 'face 'bold)))) +(ert-deftest tp-test-empty-p-with-nil () + "Test tp-empty-p with nil (current buffer)." + (tp-test-with-temp-buffer + (insert "Hello World") + ;; Empty buffer (no properties) + (should (tp-empty-p nil)) + (should (tp-empty-p)) + ;; Add properties + (tp-set 1 6 '(face bold)) + (should-not (tp-empty-p nil)) + (should-not (tp-empty-p)))) + +(ert-deftest tp-test-empty-p-with-buffer () + "Test tp-empty-p with explicit buffer object." + (tp-test-with-temp-buffer + (insert "Hello World") + (let ((buf (current-buffer))) + ;; Empty (no properties) + (should (tp-empty-p buf)) + ;; Add properties + (tp-set 1 6 '(face bold)) + (should-not (tp-empty-p buf))))) + (ert-deftest tp-test-intervals () "Test tp-intervals returns property intervals." (tp-test-with-temp-buffer @@ -517,6 +557,19 @@ (should match) (should (= (prop-match-beginning match) 7))))) +(ert-deftest tp-test-forward-with-n () + "Test tp-forward with N parameter." + (tp-test-with-temp-buffer + (insert "Hello World Test Again") + (tp-set 1 6 '(face bold)) + (tp-set 7 12 '(face italic)) + (tp-set 13 17 '(face bold)) + (goto-char 1) + (skip-unless (fboundp 'text-property-search-forward)) + ;; Search twice should find third match + (let ((match (tp-forward 'face nil nil 2))) + (should match)))) + (ert-deftest tp-test-backward () "Test tp-backward finds previous property." (tp-test-with-temp-buffer @@ -530,98 +583,102 @@ (should match) (should (= (prop-match-beginning match) 1))))) -(ert-deftest tp-test-next () - "Test tp-next returns next position with property." +(ert-deftest tp-test-forward-do () + "Test tp-forward-do applies function to matches." (tp-test-with-temp-buffer - (insert "Hello World") - (tp-set 7 12 '(face bold)) - (let ((pos (tp-next 1 'face))) - (should (= pos 7))))) - -(ert-deftest tp-test-prev () - "Test tp-prev returns previous position with property." - (tp-test-with-temp-buffer - (insert "Hello World") - (tp-set 1 6 '(face bold)) - (let ((pos (tp-prev 12 'face))) - (should (= pos 1))))) - -(ert-deftest tp-test-goto-next () - "Test tp-goto-next moves point." - (tp-test-with-temp-buffer - (insert "Hello World") - (tp-set 7 12 '(face bold)) + (insert "Hello World Test") + (tp-set 1 6 '(marker t)) + (tp-set 13 17 '(marker t)) (goto-char 1) - (tp-goto-next 'face) - (should (= (point) 7)))) + (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 2) + (should (= (length result) 2))))) -(ert-deftest tp-test-goto-prev () - "Test tp-goto-prev moves point." +(ert-deftest tp-test-backward-do () + "Test tp-backward-do applies function to matches." (tp-test-with-temp-buffer - (insert "Hello World") - (tp-set 1 6 '(face bold)) - (goto-char 12) - (tp-goto-prev 'face) - (should (= (point) 1)))) + (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 2) + (should (= (length result) 2))))) + +(ert-deftest tp-test-search-on-string () + "Test tp-search finds all matching properties in a string." + (let ((str (copy-sequence "Hello World Hello"))) + (tp-set 0 5 '(marker t) str) + (tp-set 12 17 '(marker t) str) + (let ((matches (tp-search str 'marker))) + (should (= (length matches) 2)) + (should (equal (car matches) '(0 5 t))) + (should (equal (cadr matches) '(12 17 t)))))) + +(ert-deftest tp-test-search-on-string-with-value () + "Test tp-search filters by value in a string." + (let ((str (copy-sequence "Hello World Hello"))) + (tp-set 0 5 '(type heading) str) + (tp-set 6 11 '(type paragraph) str) + (tp-set 12 17 '(type heading) str) + (let ((matches (tp-search str 'type 'heading))) + (should (= (length matches) 2)) + (should (equal (caddr (car matches)) 'heading)) + (should (equal (caddr (cadr matches)) 'heading))))) + +(ert-deftest tp-test-search-in-range () + "Test tp-search finds all matching properties in a buffer range." + (tp-test-with-temp-buffer + (insert "Hello World Hello") + (tp-set 1 6 '(marker t)) + (tp-set 13 18 '(marker t)) + (let ((matches (tp-search 1 18 'marker))) + (should (= (length matches) 2)) + (should (equal (car matches) '(1 6 t))) + (should (equal (cadr matches) '(13 18 t)))))) + +(ert-deftest tp-test-search-do-on-string () + "Test tp-search-do applies function to all matches in a string." + (let ((str (copy-sequence "Hello World Hello"))) + (tp-set 0 5 '(marker t) str) + (tp-set 12 17 '(marker t) str) + (let ((result nil)) + (tp-search-do + (lambda (match obj) + (push (car match) result)) + str 'marker) + (should (= (length result) 2)) + (should (member 0 result)) + (should (member 12 result))))) + +(ert-deftest tp-test-search-do-in-range () + "Test tp-search-do applies function to all matches in a buffer range." + (tp-test-with-temp-buffer + (insert "Hello World Hello") + (tp-set 1 6 '(marker t)) + (tp-set 13 18 '(marker t)) + (let ((result nil)) + (tp-search-do + (lambda (match obj) + (push (car match) result)) + 1 18 'marker) + (should (= (length result) 2)) + (should (member 1 result)) + (should (member 13 result))))) ;;; ============================================================ ;;; Utility Function Tests ;;; ============================================================ -(ert-deftest tp-test-in () - "Test tp-in finds regions with property." - (tp-test-with-temp-buffer - (insert "Hello World Test") - (tp-set 1 6 '(my-prop value1)) - (tp-set 7 12 '(my-prop value2)) - (let ((regions (tp-in 'my-prop))) - (should (= (length regions) 2))))) - -(ert-deftest tp-test-in-with-value () - "Test tp-in filters by value." - (tp-test-with-temp-buffer - (insert "Hello World Test") - (tp-set 1 6 '(my-prop value1)) - (tp-set 7 12 '(my-prop value2)) - (let ((regions (tp-in 'my-prop 'value1))) - (should (= (length regions) 1)) - (should (equal (car (car regions)) 1))))) - -(ert-deftest tp-test-all () - "Test tp-all returns all regions with properties." - (tp-test-with-temp-buffer - (insert "Hello World") - (tp-set 1 6 '(face bold)) - (tp-set 7 12 '(face italic)) - (let ((regions (tp-all))) - (should (>= (length regions) 2))))) - -(ert-deftest tp-test-regions-map () - "Test tp-regions-map applies function to regions." - (tp-test-with-temp-buffer - (insert "Hello World Hello") - (tp-set 1 6 '(marker t)) - (tp-set 13 18 '(marker t)) - (let ((result nil)) - (tp-regions-map - (lambda (start end idx) - (push (list start end idx) result)) - 'marker) - (should (= (length result) 2))))) - -(ert-deftest tp-test-strings-map () - "Test tp-strings-map applies function to strings." - (tp-test-with-temp-buffer - (insert "Hello World Hello") - (tp-set 1 6 '(marker t)) - (tp-set 13 18 '(marker t)) - (let ((result nil)) - (tp-strings-map - (lambda (str idx) - (push str result)) - 'marker) - (should (= (length result) 2)) - (should (member "Hello" result))))) +;; Tests for tp-search are in Search and Navigation Tests section above ;;; ============================================================ ;;; Alias Tests @@ -650,7 +707,7 @@ "Test operations on empty buffer." (tp-test-with-temp-buffer (should (null (tp-at 1))) - (should (null (tp-all))))) + (should (tp-empty-p)))) (ert-deftest tp-test-overlapping-regions () "Test overlapping property regions." diff --git a/tp.el b/tp.el index b3f0b11..c1f33c9 100644 --- a/tp.el +++ b/tp.el @@ -832,18 +832,39 @@ POINT defaults to current point. OBJECT defaults to current buffer." (text-properties-at (or point (point)) object)) -(defun tp-plist (start end &optional object) - "Get the property list of text at START to END in OBJECT. -Returns a plist of all properties in the region." - (let ((props nil) - (pos start)) - (while (< pos end) - (let ((current-props (tp-at pos object))) - (cl-loop for (key val) on current-props by #'cddr - do (unless (plist-member props key) - (setq props (plist-put props key val))))) - (setq pos (next-single-property-change pos nil object end))) - props)) +(defun tp-plist (start-or-string &optional end object) + "Get the property list of text in a region or string. + +This function supports two calling conventions: + +1. Buffer/string region: + (tp-plist START END &optional OBJECT) + +2. Entire string: + (tp-plist STRING) + +Returns a plist of all properties in the region or string." + (let (start finish obj) + (cond + ;; Entire string form: (tp-plist string) + ((stringp start-or-string) + (setq obj start-or-string + start 0 + finish (length start-or-string))) + ;; Region form: (tp-plist start end &optional object) + ((numberp start-or-string) + (setq start start-or-string + finish end + obj object))) + (let ((props nil) + (pos start)) + (while (< pos finish) + (let ((current-props (tp-at pos obj))) + (cl-loop for (key val) on current-props by #'cddr + do (unless (plist-member props key) + (setq props (plist-put props key val))))) + (setq pos (next-single-property-change pos nil obj finish))) + props))) ;;; Text property intervals ;; Note: Uses `object-intervals' which requires Emacs 28.1+ @@ -863,10 +884,18 @@ Uses `object-intervals' (Emacs 28.1+)." (t (error "Invalid format of object: %S" (type-of object)))))) -(defun tp-empty-p (object) +(defun tp-empty-p (&optional object) "Return t if OBJECT has no text properties. +OBJECT can be a string or buffer; nil defaults to current buffer. Uses `object-intervals' (Emacs 28.1+)." - (null (object-intervals object))) + (let ((obj (or object (current-buffer)))) + (cond + ((stringp obj) + (null (object-intervals obj))) + ((bufferp obj) + (with-current-buffer obj + (null (object-intervals (buffer-substring (point-min) (point-max)))))) + (t (error "Invalid object type: %S" (type-of obj)))))) (defun tp-intervals-map (function start end &optional object) "Apply FUNCTION to all intervals between START and END in OBJECT. @@ -1470,6 +1499,180 @@ VALUE, PREDICATE, and NOT-CURRENT work as in `text-property-search-forward'." VALUE, PREDICATE, and NOT-CURRENT work as in `text-property-search-backward'." (text-property-search-backward property value predicate not-current)) +(defun tp-forward (property &optional value object n) + "Search forward N times for text with PROPERTY. + +N is the number of searches, defaulting to 1. +VALUE is the optional value to match. +OBJECT can be a buffer; nil defaults to current buffer. + +Returns the prop-match object from the last successful search, +or nil if not found. + +Uses `tp-search-forward' internally." + (let ((count (or n 1)) + (result nil)) + (when object + (set-buffer object)) + (dotimes (_ count) + (setq result (tp-search-forward property value))) + result)) + +(defun tp-backward (property &optional value object n) + "Search backward N times for text with PROPERTY. + +N is the number of searches, defaulting to 1. +VALUE is the optional value to match. +OBJECT can be a buffer; nil defaults to current buffer. + +Returns the prop-match object from the last successful search, +or nil if not found. + +Uses `tp-search-backward' internally." + (let ((count (or n 1)) + (result nil)) + (when object + (set-buffer object)) + (dotimes (_ count) + (setq result (tp-search-backward property value))) + result)) + +(defun tp-forward-do (function property &optional value object n) + "Search forward N times for text with PROPERTY and apply FUNCTION to each match. + +FUNCTION receives two arguments: the prop-match object and OBJECT. +N is the number of searches, defaulting to 1. +VALUE is the optional value to match. +OBJECT can be a buffer; nil defaults to current buffer. + +Returns the number of successful matches." + (let ((count (or n 1)) + (matches 0) + (buf (or object (current-buffer)))) + (with-current-buffer buf + (dotimes (_ count) + (when-let ((match (tp-search-forward property value))) + (funcall function match buf) + (cl-incf matches)))) + matches)) + +(defun tp-backward-do (function property &optional value object n) + "Search backward N times for text with PROPERTY and apply FUNCTION to each match. + +FUNCTION receives two arguments: the prop-match object and OBJECT. +N is the number of searches, defaulting to 1. +VALUE is the optional value to match. +OBJECT can be a buffer; nil defaults to current buffer. + +Returns the number of successful matches." + (let ((count (or n 1)) + (matches 0) + (buf (or object (current-buffer)))) + (with-current-buffer buf + (dotimes (_ count) + (when-let ((match (tp-search-backward property value))) + (funcall function match buf) + (cl-incf matches)))) + matches)) + +(defun tp-search (start-or-string &optional end-or-property property-or-value value object) + "Search for all text with PROPERTY in a buffer/string range or entire string. + +This function supports two calling conventions: + +1. Buffer/string region: + (tp-search START END PROPERTY &optional VALUE OBJECT) + +2. Entire string: + (tp-search STRING PROPERTY &optional VALUE) + +Returns a list of prop-match objects for all matching regions. +Each prop-match object has beginning, end, and value information." + (cond + ;; Entire string form: (tp-search string property &optional value) + ((stringp start-or-string) + (let* ((str start-or-string) + (property end-or-property) + (value property-or-value) + (results nil) + (pos 0) + (len (length str))) + (while (< pos len) + (let ((prop-val (get-text-property pos property str))) + (if (and prop-val + (or (null value) + (equal prop-val value))) + ;; Find the extent of this property + (let ((next-change (or (next-single-property-change pos property str len) len))) + (push (list pos next-change prop-val) results) + (setq pos next-change)) + ;; No match, move to next change + (setq pos (or (next-single-property-change pos property str len) len))))) + (nreverse results))) + ;; Buffer/string region form: (tp-search start end property &optional value object) + ((numberp start-or-string) + (let* ((start start-or-string) + (end end-or-property) + (property property-or-value) + (value value) + (obj (or object (current-buffer))) + (results nil) + (pos start)) + (if (stringp obj) + ;; String object + (while (< pos end) + (let ((prop-val (get-text-property pos property obj))) + (if (and prop-val + (or (null value) + (equal prop-val value))) + (let ((next-change (or (next-single-property-change pos property obj end) end))) + (push (list pos next-change prop-val) results) + (setq pos next-change)) + (setq pos (or (next-single-property-change pos property obj end) end))))) + ;; Buffer object + (with-current-buffer obj + (while (< pos end) + (let ((prop-val (get-text-property pos property))) + (if (and prop-val + (or (null value) + (equal prop-val value))) + (let ((next-change (or (next-single-property-change pos property nil end) end))) + (push (list pos next-change prop-val) results) + (setq pos next-change)) + (setq pos (or (next-single-property-change pos property nil end) end))))))) + (nreverse results))) + (t (error "Invalid first argument: %S" start-or-string)))) + +(defun tp-search-do (function start-or-string &optional end-or-property property-or-value value object) + "Execute FUNCTION on all matches of PROPERTY in a buffer/string range or entire string. + +This function supports two calling conventions: + +1. Buffer/string region: + (tp-search-do FUNCTION START END PROPERTY &optional VALUE OBJECT) + +2. Entire string: + (tp-search-do FUNCTION STRING PROPERTY &optional VALUE) + +FUNCTION receives two arguments: the prop-match (list of START END VALUE) and OBJECT. +Returns the number of matches processed." + (let ((matches + (cond + ;; Entire string form + ((stringp start-or-string) + (tp-search start-or-string end-or-property property-or-value)) + ;; Buffer/string region form + ((numberp start-or-string) + (tp-search start-or-string end-or-property property-or-value value object)) + (t (error "Invalid first argument: %S" start-or-string)))) + (obj (cond + ((stringp start-or-string) start-or-string) + ((numberp start-or-string) (or object (current-buffer))) + (t nil)))) + (dolist (match matches) + (funcall function match obj)) + (length matches))) + ;;; Match and regexp functions (similar to ov-match and ov-regexp) (defun tp--match-apply (pattern properties apply-fn &optional object)