update test and readme
This commit is contained in:
Kinneyzhang
parent
f02a3d6ace
commit
02d1875330
114
README.md
114
README.md
@ -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
|
||||
|
||||
### Core Property Functions
|
||||
@ -1236,12 +1128,6 @@ For convenience, tp.el provides these aliases:
|
||||
| `tp-layer-group-properties` | `tp-group-props` |
|
||||
| `tp-layer-group-undefine` | `tp-group-undefine` |
|
||||
|
||||
### Deprecated Functions
|
||||
|
||||
| Function | Replacement | Notes |
|
||||
|----------|-------------|-------|
|
||||
| `tp-propertize` | `tp-set` | Use `tp-set` for new code |
|
||||
|
||||
---
|
||||
|
||||
## License
|
||||
|
||||
114
README_CN.md
114
README_CN.md
@ -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 参考
|
||||
|
||||
### 核心属性函数
|
||||
@ -1235,12 +1127,6 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
|
||||
| `tp-layer-group-properties` | `tp-group-props` |
|
||||
| `tp-layer-group-undefine` | `tp-group-undefine` |
|
||||
|
||||
### 已弃用函数
|
||||
|
||||
| 函数 | 替代 | 说明 |
|
||||
|------|------|------|
|
||||
| `tp-propertize` | `tp-set` | 新代码请使用 `tp-set` |
|
||||
|
||||
---
|
||||
|
||||
## 许可证
|
||||
|
||||
116
tp-tests.el
116
tp-tests.el
@ -34,39 +34,39 @@
|
||||
;;; ============================================================
|
||||
|
||||
(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
|
||||
(insert "Hello World")
|
||||
;; 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 3 'face) 'bold))
|
||||
(should (null (tp-get 7 'face)))
|
||||
;; 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 (equal (tp-get 7 'help-echo) "test"))))
|
||||
|
||||
(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
|
||||
(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 (equal (tp-get 1 'help-echo) "greeting"))))
|
||||
|
||||
(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
|
||||
(insert "Hello")
|
||||
(let ((result (tp-put 1 6 '(face bold))))
|
||||
(let ((result (tp-set 1 6 '(face bold))))
|
||||
(should (equal result '(1 . 6))))))
|
||||
|
||||
(ert-deftest tp-test-remove ()
|
||||
"Test tp-remove removes a specific property."
|
||||
(tp-test-with-temp-buffer
|
||||
(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))
|
||||
(tp-remove 1 6 'face)
|
||||
(should (null (tp-get 1 'face)))
|
||||
@ -76,7 +76,7 @@
|
||||
"Test tp-remove-list removes multiple properties."
|
||||
(tp-test-with-temp-buffer
|
||||
(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))
|
||||
(should (null (tp-get 1 'face)))
|
||||
(should (null (tp-get 1 'help-echo)))
|
||||
@ -86,8 +86,8 @@
|
||||
"Test tp-clear removes all properties."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-put 7 12 '(face italic))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(tp-set 7 12 '(face italic))
|
||||
(tp-clear 1 12)
|
||||
(should (null (tp-get 1 'face)))
|
||||
(should (null (tp-get 7 'face)))))
|
||||
@ -96,7 +96,7 @@
|
||||
"Test tp-clear defaults to entire buffer."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 12 '(face bold))
|
||||
(tp-set 1 12 '(face bold))
|
||||
(tp-clear)
|
||||
(should (null (tp-get 1 'face)))
|
||||
(should (null (tp-get 7 'face)))))
|
||||
@ -105,7 +105,7 @@
|
||||
"Test tp-at returns all properties at point."
|
||||
(tp-test-with-temp-buffer
|
||||
(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)))
|
||||
(should (eq (plist-get props 'face) 'bold))
|
||||
(should (equal (plist-get props 'help-echo) "test")))))
|
||||
@ -114,7 +114,7 @@
|
||||
"Test tp-at defaults to current point."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(goto-char 3)
|
||||
(should (eq (plist-get (tp-at) 'face) 'bold))))
|
||||
|
||||
@ -123,8 +123,8 @@
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
;; Put both properties on the same overlapping region for proper merging
|
||||
(tp-put 1 12 '(face bold))
|
||||
(tp-put 1 12 '(help-echo "test"))
|
||||
(tp-set 1 12 '(face bold))
|
||||
(tp-set 1 12 '(help-echo "test"))
|
||||
(let ((props (tp-plist 1 12)))
|
||||
(should (eq (plist-get props 'face) 'bold))
|
||||
(should (equal (plist-get props 'help-echo) "test")))))
|
||||
@ -142,8 +142,8 @@
|
||||
"Test tp-intervals returns property intervals."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-put 7 12 '(face italic))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(tp-set 7 12 '(face italic))
|
||||
(let ((intervals (tp-intervals 1 12)))
|
||||
(should (>= (length intervals) 2)))))
|
||||
|
||||
@ -473,28 +473,6 @@
|
||||
(tp-push-layer 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
|
||||
;;; ============================================================
|
||||
@ -541,7 +519,7 @@
|
||||
"Test tp-forward finds next property."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 7 12 '(face bold))
|
||||
(tp-set 7 12 '(face bold))
|
||||
(goto-char 1)
|
||||
;; text-property-search-forward may not exist in all Emacs versions
|
||||
(skip-unless (fboundp 'text-property-search-forward))
|
||||
@ -553,7 +531,7 @@
|
||||
"Test tp-backward finds previous property."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(goto-char 12)
|
||||
;; text-property-search-backward may not exist in all Emacs versions
|
||||
;; Skip test if function is not available
|
||||
@ -566,7 +544,7 @@
|
||||
"Test tp-next returns next position with property."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 7 12 '(face bold))
|
||||
(tp-set 7 12 '(face bold))
|
||||
(let ((pos (tp-next 1 'face)))
|
||||
(should (= pos 7)))))
|
||||
|
||||
@ -574,7 +552,7 @@
|
||||
"Test tp-prev returns previous position with property."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(let ((pos (tp-prev 12 'face)))
|
||||
(should (= pos 1)))))
|
||||
|
||||
@ -582,7 +560,7 @@
|
||||
"Test tp-goto-next moves point."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 7 12 '(face bold))
|
||||
(tp-set 7 12 '(face bold))
|
||||
(goto-char 1)
|
||||
(tp-goto-next 'face)
|
||||
(should (= (point) 7))))
|
||||
@ -591,7 +569,7 @@
|
||||
"Test tp-goto-prev moves point."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(goto-char 12)
|
||||
(tp-goto-prev 'face)
|
||||
(should (= (point) 1))))
|
||||
@ -604,8 +582,8 @@
|
||||
"Test tp-in finds regions with property."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World Test")
|
||||
(tp-put 1 6 '(my-prop value1))
|
||||
(tp-put 7 12 '(my-prop value2))
|
||||
(tp-set 1 6 '(my-prop value1))
|
||||
(tp-set 7 12 '(my-prop value2))
|
||||
(let ((regions (tp-in 'my-prop)))
|
||||
(should (= (length regions) 2)))))
|
||||
|
||||
@ -613,8 +591,8 @@
|
||||
"Test tp-in filters by value."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World Test")
|
||||
(tp-put 1 6 '(my-prop value1))
|
||||
(tp-put 7 12 '(my-prop value2))
|
||||
(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)))))
|
||||
@ -623,8 +601,8 @@
|
||||
"Test tp-all returns all regions with properties."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 6 '(face bold))
|
||||
(tp-put 7 12 '(face italic))
|
||||
(tp-set 1 6 '(face bold))
|
||||
(tp-set 7 12 '(face italic))
|
||||
(let ((regions (tp-all)))
|
||||
(should (>= (length regions) 2)))))
|
||||
|
||||
@ -632,8 +610,8 @@
|
||||
"Test tp-regions-map applies function to regions."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World Hello")
|
||||
(tp-put 1 6 '(marker t))
|
||||
(tp-put 13 18 '(marker t))
|
||||
(tp-set 1 6 '(marker t))
|
||||
(tp-set 13 18 '(marker t))
|
||||
(let ((result nil))
|
||||
(tp-regions-map
|
||||
(lambda (start end idx)
|
||||
@ -645,8 +623,8 @@
|
||||
"Test tp-strings-map applies function to strings."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World Hello")
|
||||
(tp-put 1 6 '(marker t))
|
||||
(tp-put 13 18 '(marker t))
|
||||
(tp-set 1 6 '(marker t))
|
||||
(tp-set 13 18 '(marker t))
|
||||
(let ((result nil))
|
||||
(tp-strings-map
|
||||
(lambda (str idx)
|
||||
@ -688,8 +666,8 @@
|
||||
"Test overlapping property regions."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "Hello World")
|
||||
(tp-put 1 8 '(prop1 val1))
|
||||
(tp-put 5 12 '(prop2 val2))
|
||||
(tp-set 1 8 '(prop1 val1))
|
||||
(tp-set 5 12 '(prop2 val2))
|
||||
(should (eq (tp-get 1 'prop1) 'val1))
|
||||
(should (null (tp-get 1 'prop2)))
|
||||
(should (eq (tp-get 6 'prop1) 'val1))
|
||||
@ -701,7 +679,7 @@
|
||||
"Test operations on single character."
|
||||
(tp-test-with-temp-buffer
|
||||
(insert "H")
|
||||
(tp-put 1 2 '(face bold))
|
||||
(tp-set 1 2 '(face bold))
|
||||
(should (eq (tp-get 1 'face) 'bold))))
|
||||
|
||||
(ert-deftest tp-test-layer-on-string ()
|
||||
@ -715,23 +693,23 @@
|
||||
;;; ============================================================
|
||||
|
||||
(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")))
|
||||
(tp-put 0 5 '(face bold) str)
|
||||
(tp-set 0 5 '(face bold) str)
|
||||
(should (eq (get-text-property 0 'face str) 'bold))
|
||||
(should (null (get-text-property 6 'face str)))))
|
||||
|
||||
(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"))
|
||||
(result (tp-put 0 5 '(face bold) str)))
|
||||
(result (tp-set 0 5 '(face bold) str)))
|
||||
(should (stringp result))
|
||||
(should (eq (get-text-property 0 'face result) 'bold))))
|
||||
|
||||
(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"))
|
||||
(result (tp-put str 'face 'bold 'help-echo "test")))
|
||||
(result (tp-set str 'face 'bold 'help-echo "test")))
|
||||
(should (stringp result))
|
||||
(should (eq (get-text-property 0 'face result) 'bold))
|
||||
(should (equal (get-text-property 0 'help-echo result) "test"))
|
||||
@ -763,7 +741,7 @@
|
||||
"Test tp-get with single position."
|
||||
(tp-test-with-temp-buffer
|
||||
(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 3 'face) 'bold))))
|
||||
|
||||
@ -772,7 +750,7 @@
|
||||
Returns list of (START END VALUE) intervals."
|
||||
(tp-test-with-temp-buffer
|
||||
(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 (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."
|
||||
(tp-test-with-temp-buffer
|
||||
(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)))
|
||||
(should (= (length intervals) 1))
|
||||
(let ((props (caddr (car intervals))))
|
||||
@ -791,7 +769,7 @@ Returns list of (START END VALUE) intervals."
|
||||
"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)
|
||||
(tp-set 0 5 '(face bold) str)
|
||||
(should (equal (tp-get 0 5 'face str) '((0 5 bold))))
|
||||
(should (null (tp-get 6 11 'face str)))))
|
||||
|
||||
|
||||
55
tp.el
55
tp.el
@ -231,9 +231,6 @@ Return the modified object (string) or region (START . END) for buffer."
|
||||
object
|
||||
(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)
|
||||
"Parse arguments for single-property functions like tp-set-face.
|
||||
Returns (OBJECT START END VALUE)."
|
||||
@ -1509,58 +1506,6 @@ OBJECT defaults to current buffer."
|
||||
(when-let ((intervals (tp-intervals start end object)))
|
||||
(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
|
||||
|
||||
(defun tp-forward (property &optional value predicate not-current)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user