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

Add enhanced tp-get with range support and fine-grained property functions

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-13 10:02:54 +00:00
parent 2fce83315b
commit c285fb20eb
4 changed files with 403 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
README.md
View File

@ -57,27 +57,50 @@ Or with `use-package`:
### Setting Properties ### Setting Properties
```elisp ```elisp
;; On current buffer ;; On current buffer (properties as a list)
(tp-put 1 10 'face 'bold 'help-echo "Hello!") (tp-put 1 10 '(face bold help-echo "Hello!"))
;; On a string ;; On a specific buffer
(tp-put "Hello World" 0 5 'face 'bold) (tp-put 1 10 '(face bold) some-buffer)
;; On a string with range (0-indexed)
(tp-put 0 5 '(face bold) "Hello World")
;; => #("Hello World" 0 5 (face bold)) ;; => #("Hello World" 0 5 (face bold))
;; Using a property list ;; On entire string (flat properties)
(tp-put 1 10 '(face bold help-echo "test")) (tp-put "Hello World" 'face 'bold 'help-echo "test")
;; => #("Hello World" 0 11 (face bold help-echo "test"))
``` ```
### Getting Properties ### Getting Properties
```elisp ```elisp
;; Get specific property ;; Get specific property at position
(tp-get 5 'face) ; => bold (tp-get 5 'face) ; => bold
;; Get specific property from range
(tp-get 1 10 'face) ; => bold
;; Get all properties from range
(tp-get 1 10) ; => (face bold help-echo "Hello!")
;; Get all properties at point ;; Get all properties at point
(tp-at 5) ; => (face bold help-echo "Hello!") (tp-at 5) ; => (face bold help-echo "Hello!")
``` ```
### Fine-grained Property Manipulation
```elisp
;; Get sub-property from face
(tp-get-sub 1 'face :foreground) ; => "red"
;; Set sub-property on face
(tp-put-sub 1 6 'face :foreground "blue")
;; Remove sub-property from face
(tp-remove-sub 1 6 'face :foreground)
```
### Pattern Matching ### Pattern Matching
```elisp ```elisp
@ -103,47 +126,101 @@ Or with `use-package`:
Set text properties on a string or buffer region. Set text properties on a string or buffer region.
```elisp ```elisp
;; Buffer (current buffer) ;; Current buffer (properties as a list)
(tp-put START END PROPERTY VALUE ...)
(tp-put START END '(PROPERTY VALUE ...)) (tp-put START END '(PROPERTY VALUE ...))
;; String or Buffer object ;; Specific buffer or string
(tp-put OBJECT START END PROPERTY VALUE ...) (tp-put START END '(PROPERTY VALUE ...) OBJECT)
(tp-put OBJECT START END '(PROPERTY VALUE ...))
;; Entire string (flat properties)
(tp-put STRING PROPERTY VALUE ...)
``` ```
**Examples:** **Examples:**
```elisp ```elisp
;; Set face on buffer region ;; Set face on buffer region
(tp-put 1 10 'face 'bold) ; => (1 . 10) (tp-put 1 10 '(face bold)) ; => (1 . 10)
;; Set multiple properties ;; Set multiple properties
(tp-put 1 10 'face 'bold 'help-echo "Click me") (tp-put 1 10 '(face bold help-echo "Click me"))
;; Set properties on a string ;; Set on specific buffer
(setq my-string (tp-put "Hello World" 0 5 'face 'italic)) (tp-put 1 10 '(face italic) my-buffer)
;; Set properties on a string (0-indexed)
(setq my-string (tp-put 0 5 '(face italic) "Hello World"))
;; => #("Hello World" 0 5 (face italic)) ;; => #("Hello World" 0 5 (face italic))
;; Properties as a list ;; Set properties on entire string
(tp-put 1 10 '(face bold mouse-face highlight)) (tp-put "Hello" 'face 'bold 'mouse-face 'highlight)
;; => #("Hello" 0 5 (face bold mouse-face highlight))
``` ```
--- ---
#### `tp-get` - Get Property Value #### `tp-get` - Get Property Value
```elisp Get property value(s) from position or range.
(tp-get POSITION PROPERTY &optional OBJECT)
```
Get the value of PROPERTY at POSITION. ```elisp
;; Single position
(tp-get POSITION PROPERTY)
(tp-get POSITION PROPERTY OBJECT)
;; Range - specific property
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
;; Range - all properties
(tp-get START END)
(tp-get START END OBJECT)
```
**Examples:** **Examples:**
```elisp ```elisp
(tp-get 5 'face) ; Get from current buffer ;; Get from current buffer
(tp-get 0 'face my-string) ; Get from string (tp-get 5 'face) ; => bold
;; Get from string (0-indexed)
(tp-get 0 'face my-string) ; => italic
;; Get from range
(tp-get 1 10 'face) ; => bold
;; Get all properties from range
(tp-get 1 10) ; => (face bold help-echo "test")
```
---
#### Fine-grained Property Functions
For manipulating sub-properties within complex properties like `face` or `display`:
```elisp
;; Get sub-property
(tp-get-sub POSITION PROPERTY SUB-PROPERTY &optional OBJECT)
;; Set sub-property
(tp-put-sub START END PROPERTY SUB-PROPERTY VALUE &optional OBJECT)
;; Remove sub-property
(tp-remove-sub START END PROPERTY SUB-PROPERTY &optional OBJECT)
```
**Examples:**
```elisp
;; Get :foreground from face
(tp-get-sub 1 'face :foreground) ; => "red"
;; Set :weight on face
(tp-put-sub 1 6 'face :weight 'bold)
;; Remove :background from face
(tp-remove-sub 1 6 'face :background)
``` ```
--- ---

125
README_CN.md
View File

@ -56,27 +56,50 @@
### 设置属性 ### 设置属性
```elisp ```elisp
;; 在当前缓冲区 ;; 在当前缓冲区（属性作为列表）
(tp-put 1 10 'face 'bold 'help-echo "Hello!") (tp-put 1 10 '(face bold help-echo "Hello!"))
;; 在字符串上 ;; 在特定缓冲区
(tp-put "Hello World" 0 5 'face 'bold) (tp-put 1 10 '(face bold) some-buffer)
;; 在字符串上（0 索引）
(tp-put 0 5 '(face bold) "Hello World")
;; => #("Hello World" 0 5 (face bold)) ;; => #("Hello World" 0 5 (face bold))
;; 使用属性列表 ;; 在整个字符串上（平铺属性）
(tp-put 1 10 '(face bold help-echo "test")) (tp-put "Hello World" 'face 'bold 'help-echo "test")
;; => #("Hello World" 0 11 (face bold help-echo "test"))
``` ```
### 获取属性 ### 获取属性
```elisp ```elisp
;; 获取特定属性 ;; 获取特定位置的属性
(tp-get 5 'face) ; => bold (tp-get 5 'face) ; => bold
;; 获取范围内的特定属性
(tp-get 1 10 'face) ; => bold
;; 获取范围内的所有属性
(tp-get 1 10) ; => (face bold help-echo "Hello!")
;; 获取该位置的所有属性 ;; 获取该位置的所有属性
(tp-at 5) ; => (face bold help-echo "Hello!") (tp-at 5) ; => (face bold help-echo "Hello!")
``` ```
### 细粒度属性操作
```elisp
;; 获取 face 的子属性
(tp-get-sub 1 'face :foreground) ; => "red"
;; 设置 face 的子属性
(tp-put-sub 1 6 'face :foreground "blue")
;; 移除 face 的子属性
(tp-remove-sub 1 6 'face :foreground)
```
### 模式匹配 ### 模式匹配
```elisp ```elisp
@ -102,47 +125,101 @@
在字符串或缓冲区区域上设置文本属性。 在字符串或缓冲区区域上设置文本属性。
```elisp ```elisp
;; 缓冲区（当前缓冲区） ;; 当前缓冲区（属性作为列表）
(tp-put START END PROPERTY VALUE ...)
(tp-put START END '(PROPERTY VALUE ...)) (tp-put START END '(PROPERTY VALUE ...))
;; 字符串或缓冲区对象 ;; 特定缓冲区或字符串
(tp-put OBJECT START END PROPERTY VALUE ...) (tp-put START END '(PROPERTY VALUE ...) OBJECT)
(tp-put OBJECT START END '(PROPERTY VALUE ...))
;; 整个字符串（平铺属性）
(tp-put STRING PROPERTY VALUE ...)
``` ```
**示例：** **示例：**
```elisp ```elisp
;; 在缓冲区区域设置 face ;; 在缓冲区区域设置 face
(tp-put 1 10 'face 'bold) ; => (1 . 10) (tp-put 1 10 '(face bold)) ; => (1 . 10)
;; 设置多个属性 ;; 设置多个属性
(tp-put 1 10 'face 'bold 'help-echo "Click me") (tp-put 1 10 '(face bold help-echo "Click me"))
;; 在字符串上设置属性 ;; 在特定缓冲区设置
(setq my-string (tp-put "Hello World" 0 5 'face 'italic)) (tp-put 1 10 '(face italic) my-buffer)
;; 在字符串上设置属性（0 索引）
(setq my-string (tp-put 0 5 '(face italic) "Hello World"))
;; => #("Hello World" 0 5 (face italic)) ;; => #("Hello World" 0 5 (face italic))
;; 属性作为列表 ;; 在整个字符串上设置属性
(tp-put 1 10 '(face bold mouse-face highlight)) (tp-put "Hello" 'face 'bold 'mouse-face 'highlight)
;; => #("Hello" 0 5 (face bold mouse-face highlight))
``` ```
--- ---
#### `tp-get` - 获取属性值 #### `tp-get` - 获取属性值
```elisp 从位置或范围获取属性值。
(tp-get POSITION PROPERTY &optional OBJECT)
```
获取 POSITION 位置的 PROPERTY 值。 ```elisp
;; 单个位置
(tp-get POSITION PROPERTY)
(tp-get POSITION PROPERTY OBJECT)
;; 范围 - 特定属性
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
;; 范围 - 所有属性
(tp-get START END)
(tp-get START END OBJECT)
```
**示例：** **示例：**
```elisp ```elisp
(tp-get 5 'face) ; 从当前缓冲区获取 ;; 从当前缓冲区获取
(tp-get 0 'face my-string) ; 从字符串获取 (tp-get 5 'face) ; => bold
;; 从字符串获取（0 索引）
(tp-get 0 'face my-string) ; => italic
;; 从范围获取
(tp-get 1 10 'face) ; => bold
;; 获取范围内的所有属性
(tp-get 1 10) ; => (face bold help-echo "test")
```
---
#### 细粒度属性函数
用于操作复杂属性（如 `face` 或 `display`）内的子属性：
```elisp
;; 获取子属性
(tp-get-sub POSITION PROPERTY SUB-PROPERTY &optional OBJECT)
;; 设置子属性
(tp-put-sub START END PROPERTY SUB-PROPERTY VALUE &optional OBJECT)
;; 移除子属性
(tp-remove-sub START END PROPERTY SUB-PROPERTY &optional OBJECT)
```
**示例：**
```elisp
;; 获取 face 的 :foreground
(tp-get-sub 1 'face :foreground) ; => "red"
;; 设置 face 的 :weight
(tp-put-sub 1 6 'face :weight 'bold)
;; 移除 face 的 :background
(tp-remove-sub 1 6 'face :background)
``` ```
--- ---

75
tp-tests.el
View File

@ -754,5 +754,80 @@
(should (stringp result)) (should (stringp result))
(should (eq (get-text-property 0 'face result) 'bold))))) (should (eq (get-text-property 0 'face result) 'bold)))))
;;; ============================================================
;;; Enhanced tp-get Tests
;;; ============================================================
(ert-deftest tp-test-get-single-position ()
"Test tp-get with single position."
(tp-test-with-temp-buffer
(insert "Hello")
(tp-put 1 6 '(face bold))
(should (eq (tp-get 1 'face) 'bold))
(should (eq (tp-get 3 'face) 'bold))))
(ert-deftest tp-test-get-range-property ()
"Test tp-get with range and specific property."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-put 1 6 '(face bold))
(should (eq (tp-get 1 6 'face) 'bold))
(should (null (tp-get 7 12 'face)))))
(ert-deftest tp-test-get-range-all-properties ()
"Test tp-get with range returns all properties."
(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")))))
(ert-deftest tp-test-get-range-on-string ()
"Test tp-get with range on string object."
(let ((str (copy-sequence "Hello World")))
(tp-put 0 5 '(face bold) str)
(should (eq (tp-get 0 5 'face str) 'bold))
(should (null (tp-get 6 11 'face str)))))
;;; ============================================================
;;; Fine-grained Property Manipulation Tests
;;; ============================================================
(ert-deftest tp-test-get-sub-property ()
"Test tp-get-sub retrieves sub-property from face."
(tp-test-with-temp-buffer
(insert "Hello")
(put-text-property 1 6 'face '(:foreground "red" :weight bold))
(should (equal (tp-get-sub 1 'face :foreground) "red"))
(should (eq (tp-get-sub 1 'face :weight) 'bold))
(should (null (tp-get-sub 1 'face :background)))))
(ert-deftest tp-test-put-sub-property ()
"Test tp-put-sub sets sub-property on face."
(tp-test-with-temp-buffer
(insert "Hello")
(tp-put-sub 1 6 'face :foreground "blue")
(should (equal (tp-get-sub 1 'face :foreground) "blue"))
;; Add another sub-property
(tp-put-sub 1 6 'face :weight 'bold)
(should (eq (tp-get-sub 1 'face :weight) 'bold))
(should (equal (tp-get-sub 1 'face :foreground) "blue"))))
(ert-deftest tp-test-remove-sub-property ()
"Test tp-remove-sub removes sub-property from face."
(tp-test-with-temp-buffer
(insert "Hello")
(put-text-property 1 6 'face '(:foreground "red" :weight bold))
(tp-remove-sub 1 6 'face :foreground)
(should (null (tp-get-sub 1 'face :foreground)))
(should (eq (tp-get-sub 1 'face :weight) 'bold))))
(ert-deftest tp-test-sub-property-on-string ()
"Test fine-grained property manipulation on strings."
(let ((str (copy-sequence "Hello")))
(tp-put-sub 0 5 'face :foreground "green" str)
(should (equal (tp-get-sub 0 'face :foreground str) "green"))))
(provide 'tp-ert-tests) (provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here ;;; tp-ert-tests.el ends here

129
tp.el
View File

@ -163,10 +163,133 @@ Return the modified object (string) or region (START . END) for buffer."
(defalias 'tp-set 'tp-put (defalias 'tp-set 'tp-put
"Alias for `tp-put'.") "Alias for `tp-put'.")
(defun tp-get (position property &optional object) (defun tp-get (pos-or-start &optional property-or-end &rest args)
"Get the value of PROPERTY at POSITION in OBJECT. "Get text property value(s).
This function supports multiple calling conventions:
1. Single position, single property:
(tp-get POSITION PROPERTY)
(tp-get POSITION PROPERTY OBJECT)
2. Range, single property:
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
3. Range, all properties (returns plist):
(tp-get START END)
(tp-get START END OBJECT)
For buffers, positions are 1-indexed.
For strings, positions are 0-indexed.
OBJECT defaults to current buffer." OBJECT defaults to current buffer."
(get-text-property position property object)) (cond
;; (tp-get POS PROP) or (tp-get POS PROP OBJECT) - single position
((and (numberp pos-or-start)
(symbolp property-or-end))
(let ((object (car args)))
(get-text-property pos-or-start property-or-end object)))
;; (tp-get START END ...) - range form
((and (numberp pos-or-start)
(numberp property-or-end))
(let* ((start pos-or-start)
(end property-or-end)
(property (car args))
(object (cadr args)))
(if property
;; Get specific property from range - return first non-nil value
(let ((pos start)
(result nil))
(while (and (< pos end) (null result))
(setq result (get-text-property pos property object))
(setq pos (next-single-property-change pos property object end)))
result)
;; Get all properties from range - merge into plist
(let ((props 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))))
(t (error "Invalid arguments to tp-get"))))
;;; Fine-grained property manipulation for nested properties
(defun tp-get-sub (position property sub-property &optional object)
"Get SUB-PROPERTY from PROPERTY at POSITION in OBJECT.
For example, get :foreground from a face property.
OBJECT defaults to current buffer."
(let ((prop-value (get-text-property position property object)))
(cond
;; Property is a plist (e.g., (:foreground \"red\" :weight bold))
((and (listp prop-value) (keywordp (car prop-value)))
(plist-get prop-value sub-property))
;; Property is an alist
((and (listp prop-value) (consp (car prop-value)))
(cdr (assoc sub-property prop-value)))
;; Property is a list of face specs
((listp prop-value)
(cl-loop for spec in prop-value
when (and (listp spec) (keywordp (car spec)))
thereis (plist-get spec sub-property)))
(t nil))))
(defun tp-put-sub (start end property sub-property value &optional object)
"Set SUB-PROPERTY of PROPERTY to VALUE from START to END in OBJECT.
Merges the sub-property into the existing property value.
For example, set :foreground of a face property.
OBJECT defaults to current buffer."
(let* ((pos start))
(while (< pos end)
(let* ((current-value (get-text-property pos property object))
(next-pos (or (next-single-property-change pos property object end) end))
(new-value
(cond
;; No existing value - create new plist
((null current-value)
(list sub-property value))
;; Existing plist
((and (listp current-value) (keywordp (car current-value)))
(plist-put (copy-sequence current-value) sub-property value))
;; Existing symbol (e.g., 'bold) - convert to list and add
((symbolp current-value)
(list current-value sub-property value))
;; Other list - wrap and add
((listp current-value)
(append current-value (list sub-property value)))
(t (list sub-property value)))))
(put-text-property pos next-pos property new-value object)
(setq pos next-pos))))
(if (stringp object)
object
(cons start end)))
(defun tp-remove-sub (start end property sub-property &optional object)
"Remove SUB-PROPERTY from PROPERTY between START and END in OBJECT.
For example, remove :foreground from a face property.
OBJECT defaults to current buffer."
(let* ((pos start))
(while (< pos end)
(let* ((current-value (get-text-property pos property object))
(next-pos (or (next-single-property-change pos property object end) end))
(new-value
(cond
;; Plist - remove the sub-property
((and (listp current-value) (keywordp (car current-value)))
(let ((result (copy-sequence current-value)))
(cl-remf result sub-property)
(if result result nil)))
;; Other types - leave unchanged
(t current-value))))
(if new-value
(put-text-property pos next-pos property new-value object)
(remove-text-properties pos next-pos (list property nil) object))
(setq pos next-pos))))
nil)
(defun tp-remove (start end property &optional object) (defun tp-remove (start end property &optional object)
"Remove PROPERTY from text between START and END in OBJECT. "Remove PROPERTY from text between START and END in OBJECT.