diff --git a/README.md b/README.md index d428e7e..286cedb 100644 --- a/README.md +++ b/README.md @@ -994,7 +994,8 @@ Returns a list of (START END VALUE) for all matching regions. Apply FUNCTION to matched text for all matches of PROPERTY. -- **FUNCTION** receives the matched text as its only argument. The return value +- **FUNCTION** receives the matched text as its first argument, and optionally + the 0-based index of the current match as its second argument. The return value of FUNCTION replaces the matched text in the string or buffer. - Returns the number of matches processed. @@ -1018,7 +1019,19 @@ Apply FUNCTION to matched text for all matches of PROPERTY. (buffer-string)) ;; => "HELLO world TEST" -;; Custom transformation +;; Custom transformation with index +(let ((my-string (copy-sequence "aaa bbb ccc"))) + (tp-set 0 3 '(marker t) my-string) + (tp-set 4 7 '(marker t) my-string) + (tp-set 8 11 '(marker t) my-string) + (tp-search-map + (lambda (text idx) + (format "%d:%s" idx text)) + my-string 'marker) + my-string) +;; => "0:aaa1:bbb2:ccc" + +;; Custom transformation without index (let ((my-string (copy-sequence "hello world"))) (tp-set 0 5 '(marker t) my-string) (tp-search-map diff --git a/README_CN.md b/README_CN.md index 9652a15..9465ff5 100644 --- a/README_CN.md +++ b/README_CN.md @@ -991,7 +991,7 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 对所有 PROPERTY 匹配的文本应用 FUNCTION。 -- **FUNCTION** 接收匹配到的文本作为唯一参数。FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。 +- **FUNCTION** 接收匹配到的文本作为第一个参数,可选地接收当前匹配的 0 基索引作为第二个参数。FUNCTION 的返回值将替换字符串或缓冲区中的匹配文本。 - 返回处理的匹配数量。 **示例:** @@ -1014,7 +1014,19 @@ Emacs 的 `text-property-search-forward` 和 `text-property-search-backward` 的 (buffer-string)) ;; => "HELLO world TEST" -;; 自定义转换 +;; 使用索引的自定义转换 +(let ((my-string (copy-sequence "aaa bbb ccc"))) + (tp-set 0 3 '(marker t) my-string) + (tp-set 4 7 '(marker t) my-string) + (tp-set 8 11 '(marker t) my-string) + (tp-search-map + (lambda (text idx) + (format "%d:%s" idx text)) + my-string 'marker) + my-string) +;; => "0:aaa1:bbb2:ccc" + +;; 不使用索引的自定义转换 (let ((my-string (copy-sequence "hello world"))) (tp-set 0 5 '(marker t) my-string) (tp-search-map diff --git a/tp-tests.el b/tp-tests.el index 75dc5dc..ad48484 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -854,6 +854,52 @@ (should (equal (plist-get (plist-get props-0 'face) :background) "orange")) (should (equal (plist-get (plist-get props-12 'face) :background) "orange"))))) +(ert-deftest tp-test-search-map-with-idx () + "Test tp-search-map passes index to function when it accepts two arguments." + (let ((str (copy-sequence "aaa bbb ccc")) + (indices nil)) + (tp-set 0 3 '(marker t) str) + (tp-set 4 7 '(marker t) str) + (tp-set 8 11 '(marker t) str) + ;; Use a function that accepts idx and records the indices + (tp-search-map (lambda (txt idx) + (push idx indices) + (format "%d:%s" idx txt)) + str 'marker) + ;; Check indices were passed in order (reversed due to push) + (should (equal (reverse indices) '(0 1 2))) + ;; Check text was transformed with index + (should (equal (substring str 0 5) "0:aaa")) + (should (equal (substring str 4 9) "1:bbb")) + (should (equal (substring str 8 13) "2:ccc")))) + +(ert-deftest tp-test-search-map-with-idx-in-buffer () + "Test tp-search-map passes index to function in buffer range." + (tp-test-with-temp-buffer + (insert "aaa bbb ccc") + (tp-set 1 4 '(marker t)) + (tp-set 5 8 '(marker t)) + (tp-set 9 12 '(marker t)) + (let ((indices nil)) + (tp-search-map (lambda (txt idx) + (push idx indices) + (format "[%d]" idx)) + 1 12 'marker) + ;; Check indices were passed in order + (should (equal (reverse indices) '(0 1 2))) + ;; Check text was replaced with index markers + (should (string-match-p "\\[0\\]" (buffer-string))) + (should (string-match-p "\\[1\\]" (buffer-string))) + (should (string-match-p "\\[2\\]" (buffer-string)))))) + +(ert-deftest tp-test-search-map-backward-compat () + "Test tp-search-map still works with single-argument functions." + (let ((str (copy-sequence "hello world"))) + (tp-set 0 5 '(marker t) str) + ;; Use #'upcase which only takes one argument + (tp-search-map #'upcase str 'marker) + (should (equal (substring str 0 5) "HELLO")))) + ;;; ============================================================ ;;; Utility Function Tests ;;; ============================================================ diff --git a/tp.el b/tp.el index ad2d5b3..b7c9da1 100644 --- a/tp.el +++ b/tp.el @@ -1284,7 +1284,8 @@ This function supports two calling conventions: 2. Entire string: (tp-search-map FUNCTION STRING PROPERTY &optional VALUE) -FUNCTION receives a copy of the matched text as its only argument. +FUNCTION receives the matched text as its first argument, and optionally +the 0-based index of the current match as its second argument. FUNCTION can either: - Return a new/modified string to replace the matched text - Modify the text properties of the argument and return it @@ -1304,11 +1305,15 @@ Example: ;; Upcase all matched text (tp-search-map #\\='upcase my-string \\='marker) ;; 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)) str \\='marker) + ;; Use index to add numbering + (tp-search-map (lambda (txt idx) (format \"%d: %s\" idx txt)) str \\='marker)" (let ((obj (cond ((stringp start-or-string) start-or-string) ((numberp start-or-string) (or object (current-buffer))) - (t nil)))) + (t nil))) + (idx 0) + (arity (func-arity function))) (tp--search-do (lambda (match obj) (let* ((start (car match)) @@ -1316,7 +1321,10 @@ Example: (text (if (stringp obj) (substring obj start end) (buffer-substring start end))) - (new-text (funcall function text))) + (new-text (if (>= (cdr arity) 2) + (funcall function text idx) + (funcall function text)))) + (setq idx (1+ idx)) (when (stringp new-text) (if (stringp obj) ;; For strings: copy text content and properties separately