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

update test and readme

Browse Source
This commit is contained in:
Kinneyzhang 2025-12-15 00:44:50 +08:00
parent f02a3d6ace
commit 02d1875330
4 changed files with 47 additions and 352 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
README.md
View File

@ -54,114 +54,6 @@ Or with `use-package`:
--- ---
## Quick Start
### Setting Properties
tp.el provides three main functions for setting properties, each with different semantics:
```elisp
;; tp-set: Replace only specified properties, preserve others
(tp-set 1 10 '(face bold help-echo "Hello!"))
;; tp-reset: Completely replace ALL properties
(tp-reset 1 10 '(face bold)) ; Any other properties are removed
;; tp-add: Deep merge nested properties
(tp-add 1 10 '(face (:underline t))) ; Merges with existing face
```
All three functions support four calling conventions:
```elisp
;; On current buffer (properties as a list)
(tp-set 1 10 '(face bold help-echo "Hello!"))
;; On a specific buffer
(tp-set 1 10 '(face bold) some-buffer)
;; On a string with range (0-indexed)
(tp-set 0 5 '(face bold) "Hello World")
;; => #("Hello World" 0 5 (face bold))
;; On entire string (flat properties)
(tp-set "Hello World" 'face 'bold 'help-echo "test")
;; => #("Hello World" 0 11 (face bold help-echo "test"))
```
### Single-Property Setters
```elisp
;; Set only face property
(tp-set-face 1 10 'bold)
(tp-set-face "Hello" 'italic) ; entire string
;; Set only display property
(tp-set-display 1 10 '(space :width 10))
```
### Getting Properties
```elisp
;; Get specific property at position
(tp-get 5 'face) ; => bold
;; Get nested sub-property
(tp-get 5 'face :foreground) ; => "red"
(tp-get 5 'face :box :color) ; => "blue" (deeply nested)
;; 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
(tp-at 5) ; => (face bold help-echo "Hello!")
```
### Removing Properties
```elisp
;; Remove entire property
(tp-remove 1 10 'face)
;; Remove sub-property
(tp-remove 1 10 '(face :underline))
;; Remove nested sub-properties (keep others)
(tp-remove 1 10 '(face :underline (:style :position)))
;; Removes :style and :position from :underline, keeps :color if present
```
### Pattern Matching
```elisp
;; Apply properties to all occurrences of "TODO" in buffer
(tp-match "TODO" '(face warning))
;; Apply to string
(tp-match "world" "Hello world world" '(face bold))
;; => #("Hello world world" 6 11 (face bold) 12 17 (face bold))
;; Match with (PATTERN STRING) format
(tp-match '("world" "Hello world") '(face bold))
;; => #("Hello world" 6 11 (face bold))
;; Using regexp
(tp-regexp "\\b[0-9]+\\b" '(face font-lock-number-face))
;; Reset variants (replace ALL properties on matches)
(tp-match-reset "TODO" '(face warning))
(tp-regexp-reset "[0-9]+" '(face bold))
;; Add variants (deep merge properties on matches)
(tp-match-add "TODO" '(face (:underline t)))
(tp-regexp-add "[0-9]+" '(face (:weight bold)))
```
---
## API Reference ## API Reference
### Core Property Functions ### Core Property Functions
@ -1236,12 +1128,6 @@ For convenience, tp.el provides these aliases:
| `tp-layer-group-properties` | `tp-group-props` | | `tp-layer-group-properties` | `tp-group-props` |
| `tp-layer-group-undefine` | `tp-group-undefine` | | `tp-layer-group-undefine` | `tp-group-undefine` |
### Deprecated Functions
| Function | Replacement | Notes |
|----------|-------------|-------|
| `tp-propertize` | `tp-set` | Use `tp-set` for new code |
--- ---
## License ## License

114
README_CN.md
View File

@ -53,114 +53,6 @@
--- ---
## 快速开始
### 设置属性
tp.el 提供三个主要的属性设置函数，每个有不同的语义：
```elisp
;; tp-set: 只替换指定的属性，保留其他属性
(tp-set 1 10 '(face bold help-echo "Hello!"))
;; tp-reset: 完全替换所有属性
(tp-reset 1 10 '(face bold)) ; 其他任何属性都会被移除
;; tp-add: 深度合并嵌套属性
(tp-add 1 10 '(face (:underline t))) ; 与现有 face 合并
```
这三个函数都支持四种调用约定：
```elisp
;; 在当前缓冲区（属性作为列表）
(tp-set 1 10 '(face bold help-echo "Hello!"))
;; 在特定缓冲区
(tp-set 1 10 '(face bold) some-buffer)
;; 在字符串上（0 索引）
(tp-set 0 5 '(face bold) "Hello World")
;; => #("Hello World" 0 5 (face bold))
;; 在整个字符串上（平铺属性）
(tp-set "Hello World" 'face 'bold 'help-echo "test")
;; => #("Hello World" 0 11 (face bold help-echo "test"))
```
### 单属性设置器
```elisp
;; 只设置 face 属性
(tp-set-face 1 10 'bold)
(tp-set-face "Hello" 'italic) ; 整个字符串
;; 只设置 display 属性
(tp-set-display 1 10 '(space :width 10))
```
### 获取属性
```elisp
;; 获取特定位置的属性
(tp-get 5 'face) ; => bold
;; 获取嵌套子属性
(tp-get 5 'face :foreground) ; => "red"
(tp-get 5 'face :box :color) ; => "blue"（深度嵌套）
;; 获取范围内的特定属性
(tp-get 1 10 'face) ; => bold
;; 获取范围内的所有属性
(tp-get 1 10) ; => (face bold help-echo "Hello!")
;; 获取该位置的所有属性
(tp-at 5) ; => (face bold help-echo "Hello!")
```
### 移除属性
```elisp
;; 移除整个属性
(tp-remove 1 10 'face)
;; 移除子属性
(tp-remove 1 10 '(face :underline))
;; 移除嵌套子属性（保留其他）
(tp-remove 1 10 '(face :underline (:style :position)))
;; 从 :underline 中移除 :style 和 :position，如果存在 :color 则保留
```
### 模式匹配
```elisp
;; 将属性应用到缓冲区中所有 "TODO" 出现的位置
(tp-match "TODO" '(face warning))
;; 应用到字符串
(tp-match "world" "Hello world world" '(face bold))
;; => #("Hello world world" 6 11 (face bold) 12 17 (face bold))
;; 使用 (PATTERN STRING) 格式匹配
(tp-match '("world" "Hello world") '(face bold))
;; => #("Hello world" 6 11 (face bold))
;; 使用正则表达式
(tp-regexp "\\b[0-9]+\\b" '(face font-lock-number-face))
;; reset 变体（替换匹配处的所有属性）
(tp-match-reset "TODO" '(face warning))
(tp-regexp-reset "[0-9]+" '(face bold))
;; add 变体（深度合并匹配处的属性）
(tp-match-add "TODO" '(face (:underline t)))
(tp-regexp-add "[0-9]+" '(face (:weight bold)))
```
---
## API 参考 ## API 参考
### 核心属性函数 ### 核心属性函数
@ -1235,12 +1127,6 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
| `tp-layer-group-properties` | `tp-group-props` | | `tp-layer-group-properties` | `tp-group-props` |
| `tp-layer-group-undefine` | `tp-group-undefine` | | `tp-layer-group-undefine` | `tp-group-undefine` |
### 已弃用函数
| 函数 | 替代 | 说明 |
|------|------|------|
| `tp-propertize` | `tp-set` | 新代码请使用 `tp-set` |
--- ---
## 许可证 ## 许可证

116
tp-tests.el
View File

@ -34,39 +34,39 @@
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-put-and-get () (ert-deftest tp-test-put-and-get ()
"Test tp-put and tp-get basic functionality." "Test tp-set and tp-get basic functionality."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
;; Set a single property ;; Set a single property
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(should (eq (tp-get 1 'face) 'bold)) (should (eq (tp-get 1 'face) 'bold))
(should (eq (tp-get 3 'face) 'bold)) (should (eq (tp-get 3 'face) 'bold))
(should (null (tp-get 7 'face))) (should (null (tp-get 7 'face)))
;; Set multiple properties ;; Set multiple properties
(tp-put 7 12 '(face italic help-echo "test")) (tp-set 7 12 '(face italic help-echo "test"))
(should (eq (tp-get 7 'face) 'italic)) (should (eq (tp-get 7 'face) 'italic))
(should (equal (tp-get 7 'help-echo) "test")))) (should (equal (tp-get 7 'help-echo) "test"))))
(ert-deftest tp-test-put-with-list () (ert-deftest tp-test-put-with-list ()
"Test tp-put accepts properties as a list." "Test tp-set accepts properties as a list."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-put 1 6 '(face bold help-echo "greeting")) (tp-set 1 6 '(face bold help-echo "greeting"))
(should (eq (tp-get 1 'face) 'bold)) (should (eq (tp-get 1 'face) 'bold))
(should (equal (tp-get 1 'help-echo) "greeting")))) (should (equal (tp-get 1 'help-echo) "greeting"))))
(ert-deftest tp-test-put-returns-region () (ert-deftest tp-test-put-returns-region ()
"Test tp-put returns the modified region." "Test tp-set returns the modified region."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(let ((result (tp-put 1 6 '(face bold)))) (let ((result (tp-set 1 6 '(face bold))))
(should (equal result '(1 . 6)))))) (should (equal result '(1 . 6))))))
(ert-deftest tp-test-remove () (ert-deftest tp-test-remove ()
"Test tp-remove removes a specific property." "Test tp-remove removes a specific property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-put 1 6 '(face bold help-echo "test")) (tp-set 1 6 '(face bold help-echo "test"))
(should (eq (tp-get 1 'face) 'bold)) (should (eq (tp-get 1 'face) 'bold))
(tp-remove 1 6 'face) (tp-remove 1 6 'face)
(should (null (tp-get 1 'face))) (should (null (tp-get 1 'face)))
@ -76,7 +76,7 @@
"Test tp-remove-list removes multiple properties." "Test tp-remove-list removes multiple properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-put 1 6 '(face bold help-echo "test" mouse-face highlight)) (tp-set 1 6 '(face bold help-echo "test" mouse-face highlight))
(tp-remove-list 1 6 '(face help-echo)) (tp-remove-list 1 6 '(face help-echo))
(should (null (tp-get 1 'face))) (should (null (tp-get 1 'face)))
(should (null (tp-get 1 'help-echo))) (should (null (tp-get 1 'help-echo)))
@ -86,8 +86,8 @@
"Test tp-clear removes all properties." "Test tp-clear removes all properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(tp-put 7 12 '(face italic)) (tp-set 7 12 '(face italic))
(tp-clear 1 12) (tp-clear 1 12)
(should (null (tp-get 1 'face))) (should (null (tp-get 1 'face)))
(should (null (tp-get 7 'face))))) (should (null (tp-get 7 'face)))))
@ -96,7 +96,7 @@
"Test tp-clear defaults to entire buffer." "Test tp-clear defaults to entire buffer."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 12 '(face bold)) (tp-set 1 12 '(face bold))
(tp-clear) (tp-clear)
(should (null (tp-get 1 'face))) (should (null (tp-get 1 'face)))
(should (null (tp-get 7 'face))))) (should (null (tp-get 7 'face)))))
@ -105,7 +105,7 @@
"Test tp-at returns all properties at point." "Test tp-at returns all properties at point."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-put 1 6 '(face bold help-echo "test")) (tp-set 1 6 '(face bold help-echo "test"))
(let ((props (tp-at 1))) (let ((props (tp-at 1)))
(should (eq (plist-get props 'face) 'bold)) (should (eq (plist-get props 'face) 'bold))
(should (equal (plist-get props 'help-echo) "test"))))) (should (equal (plist-get props 'help-echo) "test")))))
@ -114,7 +114,7 @@
"Test tp-at defaults to current point." "Test tp-at defaults to current point."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(goto-char 3) (goto-char 3)
(should (eq (plist-get (tp-at) 'face) 'bold)))) (should (eq (plist-get (tp-at) 'face) 'bold))))
@ -123,8 +123,8 @@
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
;; Put both properties on the same overlapping region for proper merging ;; Put both properties on the same overlapping region for proper merging
(tp-put 1 12 '(face bold)) (tp-set 1 12 '(face bold))
(tp-put 1 12 '(help-echo "test")) (tp-set 1 12 '(help-echo "test"))
(let ((props (tp-plist 1 12))) (let ((props (tp-plist 1 12)))
(should (eq (plist-get props 'face) 'bold)) (should (eq (plist-get props 'face) 'bold))
(should (equal (plist-get props 'help-echo) "test"))))) (should (equal (plist-get props 'help-echo) "test")))))
@ -142,8 +142,8 @@
"Test tp-intervals returns property intervals." "Test tp-intervals returns property intervals."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(tp-put 7 12 '(face italic)) (tp-set 7 12 '(face italic))
(let ((intervals (tp-intervals 1 12))) (let ((intervals (tp-intervals 1 12)))
(should (>= (length intervals) 2))))) (should (>= (length intervals) 2)))))
@ -473,28 +473,6 @@
(tp-push-layer 1 6 'layer2) (tp-push-layer 1 6 'layer2)
(should (eq (tp-layer-top 1 6) 'layer2)))) (should (eq (tp-layer-top 1 6) 'layer2))))
;;; ============================================================
;;; Propertize String Tests
;;; ============================================================
(ert-deftest tp-test-propertize ()
"Test tp-propertize adds properties to string."
(let ((str (tp-propertize "Hello" 'face 'bold)))
(should (eq (get-text-property 0 'face str) 'bold))))
(ert-deftest tp-test-propertize-with-list ()
"Test tp-propertize accepts properties as list."
(let ((str (tp-propertize "Hello" '(face bold help-echo "test"))))
(should (eq (get-text-property 0 'face str) 'bold))
(should (equal (get-text-property 0 'help-echo str) "test"))))
(ert-deftest tp-test-propertize-with-region ()
"Test tp-propertize with object and region."
(let* ((str (copy-sequence "Hello World"))
(result (tp-propertize str 0 5 'face 'bold)))
(should (stringp result))
(should (eq (get-text-property 0 'face result) 'bold))))
;;; ============================================================ ;;; ============================================================
;;; Match and Regexp Tests ;;; Match and Regexp Tests
;;; ============================================================ ;;; ============================================================
@ -541,7 +519,7 @@
"Test tp-forward finds next property." "Test tp-forward finds next property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 7 12 '(face bold)) (tp-set 7 12 '(face bold))
(goto-char 1) (goto-char 1)
;; text-property-search-forward may not exist in all Emacs versions ;; text-property-search-forward may not exist in all Emacs versions
(skip-unless (fboundp 'text-property-search-forward)) (skip-unless (fboundp 'text-property-search-forward))
@ -553,7 +531,7 @@
"Test tp-backward finds previous property." "Test tp-backward finds previous property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(goto-char 12) (goto-char 12)
;; text-property-search-backward may not exist in all Emacs versions ;; text-property-search-backward may not exist in all Emacs versions
;; Skip test if function is not available ;; Skip test if function is not available
@ -566,7 +544,7 @@
"Test tp-next returns next position with property." "Test tp-next returns next position with property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 7 12 '(face bold)) (tp-set 7 12 '(face bold))
(let ((pos (tp-next 1 'face))) (let ((pos (tp-next 1 'face)))
(should (= pos 7))))) (should (= pos 7)))))
@ -574,7 +552,7 @@
"Test tp-prev returns previous position with property." "Test tp-prev returns previous position with property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(let ((pos (tp-prev 12 'face))) (let ((pos (tp-prev 12 'face)))
(should (= pos 1))))) (should (= pos 1)))))
@ -582,7 +560,7 @@
"Test tp-goto-next moves point." "Test tp-goto-next moves point."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 7 12 '(face bold)) (tp-set 7 12 '(face bold))
(goto-char 1) (goto-char 1)
(tp-goto-next 'face) (tp-goto-next 'face)
(should (= (point) 7)))) (should (= (point) 7))))
@ -591,7 +569,7 @@
"Test tp-goto-prev moves point." "Test tp-goto-prev moves point."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(goto-char 12) (goto-char 12)
(tp-goto-prev 'face) (tp-goto-prev 'face)
(should (= (point) 1)))) (should (= (point) 1))))
@ -604,8 +582,8 @@
"Test tp-in finds regions with property." "Test tp-in finds regions with property."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Test") (insert "Hello World Test")
(tp-put 1 6 '(my-prop value1)) (tp-set 1 6 '(my-prop value1))
(tp-put 7 12 '(my-prop value2)) (tp-set 7 12 '(my-prop value2))
(let ((regions (tp-in 'my-prop))) (let ((regions (tp-in 'my-prop)))
(should (= (length regions) 2))))) (should (= (length regions) 2)))))
@ -613,8 +591,8 @@
"Test tp-in filters by value." "Test tp-in filters by value."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Test") (insert "Hello World Test")
(tp-put 1 6 '(my-prop value1)) (tp-set 1 6 '(my-prop value1))
(tp-put 7 12 '(my-prop value2)) (tp-set 7 12 '(my-prop value2))
(let ((regions (tp-in 'my-prop 'value1))) (let ((regions (tp-in 'my-prop 'value1)))
(should (= (length regions) 1)) (should (= (length regions) 1))
(should (equal (car (car regions)) 1))))) (should (equal (car (car regions)) 1)))))
@ -623,8 +601,8 @@
"Test tp-all returns all regions with properties." "Test tp-all returns all regions with properties."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(tp-put 7 12 '(face italic)) (tp-set 7 12 '(face italic))
(let ((regions (tp-all))) (let ((regions (tp-all)))
(should (>= (length regions) 2))))) (should (>= (length regions) 2)))))
@ -632,8 +610,8 @@
"Test tp-regions-map applies function to regions." "Test tp-regions-map applies function to regions."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Hello") (insert "Hello World Hello")
(tp-put 1 6 '(marker t)) (tp-set 1 6 '(marker t))
(tp-put 13 18 '(marker t)) (tp-set 13 18 '(marker t))
(let ((result nil)) (let ((result nil))
(tp-regions-map (tp-regions-map
(lambda (start end idx) (lambda (start end idx)
@ -645,8 +623,8 @@
"Test tp-strings-map applies function to strings." "Test tp-strings-map applies function to strings."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World Hello") (insert "Hello World Hello")
(tp-put 1 6 '(marker t)) (tp-set 1 6 '(marker t))
(tp-put 13 18 '(marker t)) (tp-set 13 18 '(marker t))
(let ((result nil)) (let ((result nil))
(tp-strings-map (tp-strings-map
(lambda (str idx) (lambda (str idx)
@ -688,8 +666,8 @@
"Test overlapping property regions." "Test overlapping property regions."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 8 '(prop1 val1)) (tp-set 1 8 '(prop1 val1))
(tp-put 5 12 '(prop2 val2)) (tp-set 5 12 '(prop2 val2))
(should (eq (tp-get 1 'prop1) 'val1)) (should (eq (tp-get 1 'prop1) 'val1))
(should (null (tp-get 1 'prop2))) (should (null (tp-get 1 'prop2)))
(should (eq (tp-get 6 'prop1) 'val1)) (should (eq (tp-get 6 'prop1) 'val1))
@ -701,7 +679,7 @@
"Test operations on single character." "Test operations on single character."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "H") (insert "H")
(tp-put 1 2 '(face bold)) (tp-set 1 2 '(face bold))
(should (eq (tp-get 1 'face) 'bold)))) (should (eq (tp-get 1 'face) 'bold))))
(ert-deftest tp-test-layer-on-string () (ert-deftest tp-test-layer-on-string ()
@ -715,23 +693,23 @@
;;; ============================================================ ;;; ============================================================
(ert-deftest tp-test-put-on-string () (ert-deftest tp-test-put-on-string ()
"Test tp-put works on string objects." "Test tp-set works on string objects."
(let ((str (copy-sequence "Hello World"))) (let ((str (copy-sequence "Hello World")))
(tp-put 0 5 '(face bold) str) (tp-set 0 5 '(face bold) str)
(should (eq (get-text-property 0 'face str) 'bold)) (should (eq (get-text-property 0 'face str) 'bold))
(should (null (get-text-property 6 'face str))))) (should (null (get-text-property 6 'face str)))))
(ert-deftest tp-test-put-on-string-returns-string () (ert-deftest tp-test-put-on-string-returns-string ()
"Test tp-put returns the modified string." "Test tp-set returns the modified string."
(let* ((str (copy-sequence "Hello")) (let* ((str (copy-sequence "Hello"))
(result (tp-put 0 5 '(face bold) str))) (result (tp-set 0 5 '(face bold) str)))
(should (stringp result)) (should (stringp result))
(should (eq (get-text-property 0 'face result) 'bold)))) (should (eq (get-text-property 0 'face result) 'bold))))
(ert-deftest tp-test-put-entire-string () (ert-deftest tp-test-put-entire-string ()
"Test tp-put applies to entire string with flat properties." "Test tp-set applies to entire string with flat properties."
(let* ((str (copy-sequence "Hello")) (let* ((str (copy-sequence "Hello"))
(result (tp-put str 'face 'bold 'help-echo "test"))) (result (tp-set str 'face 'bold 'help-echo "test")))
(should (stringp result)) (should (stringp result))
(should (eq (get-text-property 0 'face result) 'bold)) (should (eq (get-text-property 0 'face result) 'bold))
(should (equal (get-text-property 0 'help-echo result) "test")) (should (equal (get-text-property 0 'help-echo result) "test"))
@ -763,7 +741,7 @@
"Test tp-get with single position." "Test tp-get with single position."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello") (insert "Hello")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(should (eq (tp-get 1 'face) 'bold)) (should (eq (tp-get 1 'face) 'bold))
(should (eq (tp-get 3 'face) 'bold)))) (should (eq (tp-get 3 'face) 'bold))))
@ -772,7 +750,7 @@
Returns list of (START END VALUE) intervals." Returns list of (START END VALUE) intervals."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold)) (tp-set 1 6 '(face bold))
(should (equal (tp-get 1 6 'face) '((1 6 bold)))) (should (equal (tp-get 1 6 'face) '((1 6 bold))))
(should (null (tp-get 7 12 'face))))) (should (null (tp-get 7 12 'face)))))
@ -780,7 +758,7 @@ Returns list of (START END VALUE) intervals."
"Test tp-get with range returns all property intervals." "Test tp-get with range returns all property intervals."
(tp-test-with-temp-buffer (tp-test-with-temp-buffer
(insert "Hello World") (insert "Hello World")
(tp-put 1 6 '(face bold help-echo "test")) (tp-set 1 6 '(face bold help-echo "test"))
(let ((intervals (tp-get 1 6))) (let ((intervals (tp-get 1 6)))
(should (= (length intervals) 1)) (should (= (length intervals) 1))
(let ((props (caddr (car intervals)))) (let ((props (caddr (car intervals))))
@ -791,7 +769,7 @@ Returns list of (START END VALUE) intervals."
"Test tp-get with range on string object. "Test tp-get with range on string object.
Returns list of (START END VALUE) intervals." Returns list of (START END VALUE) intervals."
(let ((str (copy-sequence "Hello World"))) (let ((str (copy-sequence "Hello World")))
(tp-put 0 5 '(face bold) str) (tp-set 0 5 '(face bold) str)
(should (equal (tp-get 0 5 'face str) '((0 5 bold)))) (should (equal (tp-get 0 5 'face str) '((0 5 bold))))
(should (null (tp-get 6 11 'face str))))) (should (null (tp-get 6 11 'face str)))))

55
tp.el
View File

@ -231,9 +231,6 @@ Return the modified object (string) or region (START . END) for buffer."
object object
(cons start finish)))) (cons start finish))))
(defalias 'tp-put 'tp-set
"Alias for `tp-set'.")
(defun tp--parse-single-prop-args (start-or-string end-or-val val-or-object rest) (defun tp--parse-single-prop-args (start-or-string end-or-val val-or-object rest)
"Parse arguments for single-property functions like tp-set-face. "Parse arguments for single-property functions like tp-set-face.
Returns (OBJECT START END VALUE)." Returns (OBJECT START END VALUE)."
@ -1509,58 +1506,6 @@ OBJECT defaults to current buffer."
(when-let ((intervals (tp-intervals start end object))) (when-let ((intervals (tp-intervals start end object)))
(plist-get (nth 2 (car intervals)) 'tp-name))) (plist-get (nth 2 (car intervals)) 'tp-name)))
;;; Propertize functions (deprecated - use tp-set instead)
(defun tp-propertize (object-or-string &rest args)
"Apply text properties to OBJECT.
This function is DEPRECATED. Use `tp-set' instead.
This function supports multiple calling conventions:
1. String only (create propertized string):
(tp-propertize STRING PROPERTY VALUE ...)
(tp-propertize STRING \\='(PROPERTY VALUE ...))
2. With region (apply to object):
(tp-propertize OBJECT START END PROPERTY VALUE ...)
(tp-propertize OBJECT START END \\='(PROPERTY VALUE ...))
When called with just a string and properties, returns a new
propertized string. When called with an object, start, and end,
applies properties to the region and returns the object.
PROPERTIES should be a plist of property-value pairs."
(declare (indent defun))
(cond
;; Called with just string and properties (no start/end)
;; Detect by checking if first arg is not a number (not a start position)
((and (stringp object-or-string)
(or (null args)
(not (numberp (car args)))))
(let ((properties args))
(when (listp (car-safe properties))
(setq properties (car properties)))
(if properties
(apply #'propertize object-or-string properties)
(copy-sequence object-or-string))))
;; Called with object, start, end, properties
((and (or (stringp object-or-string) (bufferp object-or-string))
(>= (length args) 2)
(numberp (car args))
(numberp (cadr args)))
(let ((object object-or-string)
(start (car args))
(end (cadr args))
(properties (cddr args)))
(when (listp (car-safe properties))
(setq properties (car properties)))
(tp-set start end properties object)
object)) ; Always return the object
(t (error "Invalid arguments to tp-propertize"))))
(make-obsolete 'tp-propertize 'tp-set "0.2.0")
;;; Search functions ;;; Search functions
(defun tp-forward (property &optional value predicate not-current) (defun tp-forward (property &optional value predicate not-current)