From 932585da3fbbee3b519e2843375970f59bd578fa Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 14 Dec 2025 13:50:45 +0000 Subject: [PATCH] Fix tp-get to return intervals and tp-match/tp-regexp string parsing Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- README.md | 23 +++++++++++------ README_CN.md | 23 +++++++++++------ tp-tests.el | 70 ++++++++++++++++++++++++++++++++++++++-------------- tp.el | 66 ++++++++++++++++++++++++++++++++++--------------- 4 files changed, 128 insertions(+), 54 deletions(-) diff --git a/README.md b/README.md index f961084..346fbb8 100644 --- a/README.md +++ b/README.md @@ -294,6 +294,8 @@ Set only the display property, preserving other properties. Get property value(s) from position or range, with support for nested sub-properties. +For range queries, returns a list of `(START END VALUE)` intervals, allowing you to see all property values across the range. + ```elisp ;; Single position (tp-get POSITION PROPERTY) @@ -302,7 +304,7 @@ Get property value(s) from position or range, with support for nested sub-proper ;; Nested sub-property access (tp-get POSITION PROPERTY SUB-KEY ...) -;; Range - specific property +;; Range - specific property (returns list of intervals) (tp-get START END PROPERTY) (tp-get START END PROPERTY OBJECT) @@ -310,7 +312,7 @@ Get property value(s) from position or range, with support for nested sub-proper (tp-get START END '(PROPERTY) OBJECT) (tp-get START END '(PROPERTY SUB-KEY ...) OBJECT) -;; Range - all properties +;; Range - all properties (returns list of intervals) (tp-get START END) (tp-get START END OBJECT) @@ -334,18 +336,23 @@ Get property value(s) from position or range, with support for nested sub-proper ;; Get from string (0-indexed) (tp-get 0 'face my-string) ; => italic -;; Get from range -(tp-get 1 10 'face) ; => bold +;; Get from range - returns list of (START END VALUE) intervals +(tp-get 1 10 'face) ; => ((1 6 bold)) + +;; Get with multiple intervals +(tp-set 0 5 '(face bold) str) +(tp-set 12 17 '(face italic) str) +(tp-get 0 17 'face str) ; => ((0 5 bold) (12 17 italic)) ;; Get with property path as list -(tp-get 5 20 '(face :underline :style) my-string) +(tp-get 5 20 '(face :underline :style) my-string) ; => ((5 20 wave)) ;; Get all properties from range -(tp-get 1 10) ; => (face bold help-echo "test") +(tp-get 1 10) ; => ((1 6 (face bold help-echo "test"))) ;; Get from entire string -(tp-get "Hello World") ; => all properties -(tp-get "Hello World" 'face) ; => face value +(tp-get "Hello World") ; => all properties at position 0 +(tp-get "Hello World" 'face) ; => face value at position 0 (tp-get "Hello World" 'face :foreground) ; => foreground color ``` diff --git a/README_CN.md b/README_CN.md index ae204df..04defe7 100644 --- a/README_CN.md +++ b/README_CN.md @@ -293,6 +293,8 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义： 从位置或范围获取属性值，支持嵌套子属性访问。 +对于范围查询，返回 `(START END VALUE)` 区间列表，让你可以查看范围内所有的属性值。 + ```elisp ;; 单个位置 (tp-get POSITION PROPERTY) @@ -301,7 +303,7 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义： ;; 嵌套子属性访问 (tp-get POSITION PROPERTY SUB-KEY ...) -;; 范围 - 特定属性 +;; 范围 - 特定属性（返回区间列表） (tp-get START END PROPERTY) (tp-get START END PROPERTY OBJECT) @@ -309,7 +311,7 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义： (tp-get START END '(PROPERTY) OBJECT) (tp-get START END '(PROPERTY SUB-KEY ...) OBJECT) -;; 范围 - 所有属性 +;; 范围 - 所有属性（返回区间列表） (tp-get START END) (tp-get START END OBJECT) @@ -333,18 +335,23 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义： ;; 从字符串获取（0 索引） (tp-get 0 'face my-string) ; => italic -;; 从范围获取 -(tp-get 1 10 'face) ; => bold +;; 从范围获取 - 返回 (START END VALUE) 区间列表 +(tp-get 1 10 'face) ; => ((1 6 bold)) + +;; 获取多个区间 +(tp-set 0 5 '(face bold) str) +(tp-set 12 17 '(face italic) str) +(tp-get 0 17 'face str) ; => ((0 5 bold) (12 17 italic)) ;; 使用列表形式的属性路径 -(tp-get 5 20 '(face :underline :style) my-string) +(tp-get 5 20 '(face :underline :style) my-string) ; => ((5 20 wave)) ;; 获取范围内的所有属性 -(tp-get 1 10) ; => (face bold help-echo "test") +(tp-get 1 10) ; => ((1 6 (face bold help-echo "test"))) ;; 从整个字符串获取 -(tp-get "Hello World") ; => 所有属性 -(tp-get "Hello World" 'face) ; => face 值 +(tp-get "Hello World") ; => 位置 0 处的所有属性 +(tp-get "Hello World" 'face) ; => 位置 0 处的 face 值 (tp-get "Hello World" 'face :foreground) ; => 前景色 ``` diff --git a/tp-tests.el b/tp-tests.el index 3c4c7ae..314b0c0 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -767,27 +767,31 @@ (should (eq (tp-get 3 'face) 'bold)))) (ert-deftest tp-test-get-range-property () - "Test tp-get with range and specific property." + "Test tp-get with range and specific property. +Returns list of (START END VALUE) intervals." (tp-test-with-temp-buffer (insert "Hello World") (tp-put 1 6 '(face bold)) - (should (eq (tp-get 1 6 'face) 'bold)) + (should (equal (tp-get 1 6 'face) '((1 6 bold)))) (should (null (tp-get 7 12 'face))))) (ert-deftest tp-test-get-range-all-properties () - "Test tp-get with range returns all properties." + "Test tp-get with range returns all property intervals." (tp-test-with-temp-buffer (insert "Hello World") (tp-put 1 6 '(face bold help-echo "test")) - (let ((props (tp-get 1 6))) - (should (eq (plist-get props 'face) 'bold)) - (should (equal (plist-get props 'help-echo) "test"))))) + (let ((intervals (tp-get 1 6))) + (should (= (length intervals) 1)) + (let ((props (caddr (car intervals)))) + (should (eq (plist-get props 'face) 'bold)) + (should (equal (plist-get props 'help-echo) "test")))))) (ert-deftest tp-test-get-range-on-string () - "Test tp-get with range on string object." + "Test tp-get with range on string object. +Returns list of (START END VALUE) intervals." (let ((str (copy-sequence "Hello World"))) (tp-put 0 5 '(face bold) str) - (should (eq (tp-get 0 5 'face str) 'bold)) + (should (equal (tp-get 0 5 'face str) '((0 5 bold)))) (should (null (tp-get 6 11 'face str))))) ;;; ============================================================ @@ -1048,6 +1052,34 @@ (should (eq (get-text-property 4 'face str) 'bold)) (should (equal (get-text-property 4 'help-echo str) "original")))) +(ert-deftest tp-test-match-string-as-last-arg () + "Test tp-match with string as last argument." + (let ((str (copy-sequence "Hello World Hello"))) + (let ((result (tp-match "Hello" '(face bold) str))) + (should (stringp result)) + (should (eq (get-text-property 0 'face result) 'bold)) + (should (eq (get-text-property 12 'face result) 'bold)) + (should (null (get-text-property 6 'face result)))))) + +(ert-deftest tp-test-regexp-string-as-last-arg () + "Test tp-regexp with string as last argument." + (let ((str (copy-sequence "abc 123 def 456"))) + (let ((result (tp-regexp "[0-9]+" '(face italic) str))) + (should (stringp result)) + (should (eq (get-text-property 4 'face result) 'italic)) + (should (eq (get-text-property 12 'face result) 'italic)) + (should (null (get-text-property 0 'face result)))))) + +(ert-deftest tp-test-get-range-multiple-intervals () + "Test tp-get returns all property intervals in a range." + (let ((str (copy-sequence "Hello World Hello"))) + (tp-set 0 5 '(face bold) str) + (tp-set 12 17 '(face italic) str) + (let ((intervals (tp-get 0 17 'face str))) + (should (= (length intervals) 2)) + (should (equal (car intervals) '(0 5 bold))) + (should (equal (cadr intervals) '(12 17 italic)))))) + ;;; ============================================================ ;;; New API Tests - Issue 1: tp-add face prepending ;;; ============================================================ @@ -1153,23 +1185,25 @@ (should (equal (tp-get str 'face :box :line-width) 2)))) (ert-deftest tp-test-get-range-with-list-prop-path () - "Test tp-get with property path as list." + "Test tp-get with property path as list. +Returns list of (START END VALUE) intervals." (tp-test-with-temp-buffer (insert "Hello World") (put-text-property 1 6 'face '(:foreground "red" :underline (:style wave)) nil) - ;; Get with list path - (should (equal (tp-get 1 6 '(face)) '(:foreground "red" :underline (:style wave)))) - (should (equal (tp-get 1 6 '(face :foreground)) "red")) - (should (eq (tp-get 1 6 '(face :underline :style)) 'wave)))) + ;; Get with list path - returns intervals + (should (equal (tp-get 1 6 '(face)) '((1 6 (:foreground "red" :underline (:style wave)))))) + (should (equal (tp-get 1 6 '(face :foreground)) '((1 6 "red")))) + (should (equal (tp-get 1 6 '(face :underline :style)) '((1 6 wave)))))) (ert-deftest tp-test-get-range-with-list-prop-path-on-string () - "Test tp-get with property path as list on string." + "Test tp-get with property path as list on string. +Returns list of (START END VALUE) intervals." (let ((str (copy-sequence "Hello World"))) (put-text-property 0 5 'face '(:foreground "red" :underline (:style wave)) str) - ;; Get with list path and object - (should (equal (tp-get 0 5 '(face) str) '(:foreground "red" :underline (:style wave)))) - (should (equal (tp-get 0 5 '(face :foreground) str) "red")) - (should (eq (tp-get 0 5 '(face :underline :style) str) 'wave)))) + ;; Get with list path and object - returns intervals + (should (equal (tp-get 0 5 '(face) str) '((0 5 (:foreground "red" :underline (:style wave)))))) + (should (equal (tp-get 0 5 '(face :foreground) str) '((0 5 "red")))) + (should (equal (tp-get 0 5 '(face :underline :style) str) '((0 5 wave)))))) (provide 'tp-ert-tests) ;;; tp-ert-tests.el ends here diff --git a/tp.el b/tp.el index c0bc7e7..6990d23 100644 --- a/tp.el +++ b/tp.el @@ -543,27 +543,30 @@ OBJECT defaults to current buffer." ((or (bufferp (car rest-args)) (stringp (car rest-args))) (setq object (car rest-args))))) (if property - ;; Get specific property from range - return first non-nil value + ;; Get specific property from range - return list of (START END VALUE) for all intervals (let ((pos start) - (result nil)) - (while (and (< pos end) (null result)) - (let ((prop-value (get-text-property pos property object))) - (setq result (if sub-path - (tp--get-nested prop-value sub-path) - prop-value))) - (setq pos (next-single-property-change pos property object end))) - result) - ;; Get all properties from range - merge into plist - (let ((props nil) + (intervals nil)) + (while (< pos end) + (let* ((prop-value (get-text-property pos property object)) + (next-pos (or (next-single-property-change pos property object end) end)) + (value (if sub-path + (tp--get-nested prop-value sub-path) + prop-value))) + (when value + (push (list pos next-pos value) intervals)) + (setq pos next-pos))) + (nreverse intervals)) + ;; Get all properties from range - return list of (START END PLIST) intervals + (let ((intervals nil) (pos start) (obj (or object (current-buffer)))) (while (< pos end) - (let ((current-props (text-properties-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 end))) - props)))) + (let* ((current-props (text-properties-at pos obj)) + (next-pos (or (next-property-change pos obj end) end))) + (when current-props + (push (list pos next-pos current-props) intervals)) + (setq pos next-pos))) + (nreverse intervals))))) (t (error "Invalid arguments to tp-get")))) ;;; Fine-grained property manipulation for nested properties @@ -1223,7 +1226,10 @@ Returns modified object or list of regions." (defun tp--parse-match-args (args) "Parse match/regexp function ARGS. -Returns (OBJECT . PROPERTIES)." +Returns (OBJECT . PROPERTIES). +Handles two calling conventions: +1. (OBJECT PROPERTY VALUE ...) or (OBJECT \\='(PROPERTY VALUE ...)) +2. (\\='(PROPERTY VALUE ...) OBJECT) or (PROPERTY VALUE ... OBJECT)" (let (object properties) (cond ;; First arg is a string - it's the object @@ -1234,12 +1240,32 @@ Returns (OBJECT . PROPERTIES)." ((and args (bufferp (car args))) (setq object (car args) properties (cdr args))) + ;; First arg is a list (properties) and last arg might be object + ((and args (listp (car args))) + (let ((last-arg (car (last args)))) + (if (or (stringp last-arg) (bufferp last-arg)) + ;; Last arg is object: '(props) object + (setq object last-arg + properties (car args)) + ;; No object, just properties + (setq object nil + properties (car args))))) + ;; Check if last arg is an object (for flat property args) + ((and args (>= (length args) 2)) + (let ((last-arg (car (last args)))) + (if (or (stringp last-arg) (bufferp last-arg)) + ;; Last arg is object: prop val ... object + (setq object last-arg + properties (butlast args)) + ;; No object, all are properties + (setq object nil + properties args)))) ;; No object specified (t (setq object nil properties args))) - ;; Handle properties as a list - (when (listp (car-safe properties)) + ;; Handle properties as a list (normalize) + (when (and (listp (car-safe properties)) (= (length properties) 1)) (setq properties (car properties))) (cons object properties)))