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

Fix tp-add face prepending, tp-remove and tp-get string support, update docs

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-14 13:06:08 +00:00
parent 10e60a9408
commit 5994ce3a2a
4 changed files with 375 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
README.md
View File

@ -244,6 +244,11 @@ Add or update properties with deep merge support for nested plists.
(tp-set 1 10 '(face (:foreground "red")))
(tp-add 1 10 '(face (:background "blue")))
;; Result: face is (:foreground "red" :background "blue")
;; Face prepending - symbol faces are prepended to face list
(tp-set "Hello" 'face 'bold)
(tp-add "Hello" 'face 'shadow)
;; Result: face is (shadow bold)
```
---
@ -301,9 +306,18 @@ Get property value(s) from position or range, with support for nested sub-proper
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
;; Range with property path as list
(tp-get START END '(PROPERTY) OBJECT)
(tp-get START END '(PROPERTY SUB-KEY ...) OBJECT)
;; Range - all properties
(tp-get START END)
(tp-get START END OBJECT)
;; Entire string
(tp-get STRING)
(tp-get STRING PROPERTY)
(tp-get STRING PROPERTY SUB-KEY ...)
```
**Examples:**
@ -323,8 +337,16 @@ Get property value(s) from position or range, with support for nested sub-proper
;; Get from range
(tp-get 1 10 'face) ; => bold
;; Get with property path as list
(tp-get 5 20 '(face :underline :style) my-string)
;; Get all properties from range
(tp-get 1 10) ; => (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" 'face :foreground) ; => foreground color
```
---
@ -378,17 +400,22 @@ Get all text properties at POINT as a plist.
#### `tp-remove` - Remove Property
Remove a property or nested sub-property from a region.
Remove a property or nested sub-property from a region or entire string.
```elisp
;; Remove entire property
;; Remove entire property (buffer)
(tp-remove START END PROPERTY &optional OBJECT)
;; Remove sub-property
;; Remove sub-property (buffer)
(tp-remove START END '(PROPERTY SUB-KEY) &optional OBJECT)
;; Remove nested sub-properties
;; Remove nested sub-properties (buffer)
(tp-remove START END '(PROPERTY SUB-KEY (NESTED-KEYS...)) &optional OBJECT)
;; Remove from entire string
(tp-remove STRING PROP1 PROP2 ...)
(tp-remove STRING PROPERTY SUB-KEY)
(tp-remove STRING PROPERTY SUB-KEY '(NESTED-KEYS...))
```
**Examples:**
@ -404,6 +431,11 @@ Remove a property or nested sub-property from a region.
(tp-remove 1 10 '(face :underline (:style :position)))
;; Removes :style and :position from :underline
;; If :color exists in :underline, it's preserved
;; Remove from entire string
(tp-remove "Hello World" 'face 'help-echo) ; Remove multiple properties
(tp-remove "Hello World" 'face :underline) ; Remove sub-property
(tp-remove "Hello World" 'face :underline '(:style :position)) ; Remove nested
```
---

40
README_CN.md
View File

@ -243,6 +243,11 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
(tp-set 1 10 '(face (:foreground "red")))
(tp-add 1 10 '(face (:background "blue")))
;; 结果: face 是 (:foreground "red" :background "blue")
;; Face 前置 - 符号 face 会被添加到 face 列表的开头
(tp-set "Hello" 'face 'bold)
(tp-add "Hello" 'face 'shadow)
;; 结果: face 是 (shadow bold)
```
---
@ -300,9 +305,18 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
;; 范围 - 属性路径作为列表
(tp-get START END '(PROPERTY) OBJECT)
(tp-get START END '(PROPERTY SUB-KEY ...) OBJECT)
;; 范围 - 所有属性
(tp-get START END)
(tp-get START END OBJECT)
;; 整个字符串
(tp-get STRING)
(tp-get STRING PROPERTY)
(tp-get STRING PROPERTY SUB-KEY ...)
```
**示例：**
@ -322,8 +336,16 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
;; 从范围获取
(tp-get 1 10 'face) ; => bold
;; 使用列表形式的属性路径
(tp-get 5 20 '(face :underline :style) my-string)
;; 获取范围内的所有属性
(tp-get 1 10) ; => (face bold help-echo "test")
;; 从整个字符串获取
(tp-get "Hello World") ; => 所有属性
(tp-get "Hello World" 'face) ; => face 值
(tp-get "Hello World" 'face :foreground) ; => 前景色
```
---
@ -377,17 +399,22 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
#### `tp-remove` - 移除属性
从区域中移除属性或嵌套子属性。
从区域或整个字符串中移除属性或嵌套子属性。
```elisp
;; 移除整个属性
;; 移除整个属性（缓冲区）
(tp-remove START END PROPERTY &optional OBJECT)
;; 移除子属性
;; 移除子属性（缓冲区）
(tp-remove START END '(PROPERTY SUB-KEY) &optional OBJECT)
;; 移除嵌套子属性
;; 移除嵌套子属性（缓冲区）
(tp-remove START END '(PROPERTY SUB-KEY (NESTED-KEYS...)) &optional OBJECT)
;; 从整个字符串移除
(tp-remove STRING PROP1 PROP2 ...)
(tp-remove STRING PROPERTY SUB-KEY)
(tp-remove STRING PROPERTY SUB-KEY '(NESTED-KEYS...))
```
**示例：**
@ -403,6 +430,11 @@ tp.el 提供三个主要的属性设置函数，每个有不同的语义：
(tp-remove 1 10 '(face :underline (:style :position)))
;; 从 :underline 移除 :style 和 :position
;; 如果 :underline 中存在 :color，则保留
;; 从整个字符串移除
(tp-remove "Hello World" 'face 'help-echo) ; 移除多个属性
(tp-remove "Hello World" 'face :underline) ; 移除子属性
(tp-remove "Hello World" 'face :underline '(:style :position)) ; 移除嵌套
```
---

123
tp-tests.el
View File

@ -1048,5 +1048,128 @@
(should (eq (get-text-property 4 'face str) 'bold))
(should (equal (get-text-property 4 'help-echo str) "original"))))
;;; ============================================================
;;; New API Tests - Issue 1: tp-add face prepending
;;; ============================================================
(ert-deftest tp-test-add-face-prepend-symbol ()
"Test tp-add prepends face symbol to existing face."
(let ((str (copy-sequence "Hello")))
(tp-set 0 5 '(face bold) str)
(tp-add 0 5 '(face shadow) str)
(let ((face (get-text-property 0 'face str)))
;; New face should be prepended, creating a list
(should (equal face '(shadow bold))))))
(ert-deftest tp-test-add-face-prepend-to-list ()
"Test tp-add prepends face to existing face list."
(let ((str (copy-sequence "Hello")))
(tp-set 0 5 '(face (bold italic)) str)
(tp-add 0 5 '(face shadow) str)
(let ((face (get-text-property 0 'face str)))
;; New face should be prepended
(should (equal face '(shadow bold italic))))))
(ert-deftest tp-test-add-face-plist-merge ()
"Test tp-add merges face plist with existing face."
(let ((str (copy-sequence "Hello")))
(tp-set 0 5 '(face (:foreground "red")) str)
(tp-add 0 5 '(face (:background "blue")) str)
(let ((face (get-text-property 0 'face str)))
(should (equal (plist-get face :foreground) "red"))
(should (equal (plist-get face :background) "blue")))))
(ert-deftest tp-test-add-face-symbol-no-dup ()
"Test tp-add doesn't duplicate faces."
(let ((str (copy-sequence "Hello")))
(tp-set 0 5 '(face bold) str)
(tp-add 0 5 '(face bold) str)
(let ((face (get-text-property 0 'face str)))
;; Should not duplicate
(should (eq face 'bold)))))
;;; ============================================================
;;; New API Tests - Issue 2: tp-remove for strings
;;; ============================================================
(ert-deftest tp-test-remove-entire-string-single-prop ()
"Test tp-remove removes single property from entire string."
(let ((str (tp-set "Hello" 'face 'bold 'help-echo "test")))
(tp-remove str 'face)
(should (null (get-text-property 0 'face str)))
(should (equal (get-text-property 0 'help-echo str) "test"))))
(ert-deftest tp-test-remove-entire-string-multiple-props ()
"Test tp-remove removes multiple properties from entire string."
(let ((str (tp-set "Hello" 'face 'bold 'help-echo "test" 'mouse-face 'highlight)))
(tp-remove str 'face 'help-echo)
(should (null (get-text-property 0 'face str)))
(should (null (get-text-property 0 'help-echo str)))
(should (eq (get-text-property 0 'mouse-face str) 'highlight))))
(ert-deftest tp-test-remove-entire-string-sub-prop ()
"Test tp-remove removes sub-property from entire string."
(let ((str (copy-sequence "Hello")))
(put-text-property 0 5 'face '(:foreground "red" :underline t) str)
(tp-remove str 'face :underline)
(let ((face (get-text-property 0 'face str)))
(should (equal (plist-get face :foreground) "red"))
(should (null (plist-get face :underline))))))
(ert-deftest tp-test-remove-entire-string-nested-sub-prop ()
"Test tp-remove removes nested sub-properties from entire string."
(let ((str (copy-sequence "Hello")))
(put-text-property 0 5 'face '(:foreground "red" :underline (:style wave :color "blue")) str)
(tp-remove str 'face :underline '(:style))
(let* ((face (get-text-property 0 'face str))
(underline (plist-get face :underline)))
(should (equal (plist-get face :foreground) "red"))
(should (equal (plist-get underline :color) "blue"))
(should (null (plist-get underline :style))))))
;;; ============================================================
;;; New API Tests - Issue 3 & 4: tp-get for strings and new API
;;; ============================================================
(ert-deftest tp-test-get-entire-string-all-props ()
"Test tp-get returns all properties from entire string."
(let ((str (tp-set "Hello" 'face 'bold 'help-echo "test")))
(let ((props (tp-get str)))
(should (eq (plist-get props 'face) 'bold))
(should (equal (plist-get props 'help-echo) "test")))))
(ert-deftest tp-test-get-entire-string-single-prop ()
"Test tp-get returns single property from entire string."
(let ((str (tp-set "Hello" 'face 'bold 'help-echo "test")))
(should (eq (tp-get str 'face) 'bold))
(should (equal (tp-get str 'help-echo) "test"))))
(ert-deftest tp-test-get-entire-string-nested-prop ()
"Test tp-get returns nested property from entire string."
(let ((str (copy-sequence "Hello")))
(put-text-property 0 5 'face '(:foreground "red" :box (:color "blue" :line-width 2)) str)
(should (equal (tp-get str 'face :foreground) "red"))
(should (equal (tp-get str 'face :box :color) "blue"))
(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."
(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))))
(ert-deftest tp-test-get-range-with-list-prop-path-on-string ()
"Test tp-get with property path as list on string."
(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))))
(provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here

221
tp.el
View File

@ -289,6 +289,50 @@ NEW values override BASE values."
(t val))))))
result))
(defun tp--prepend-face (new-face existing-face)
"Prepend NEW-FACE to EXISTING-FACE for the face property.
Returns a face value where NEW-FACE takes precedence.
If NEW-FACE is a plist (like (:foreground \"red\")), deeply merge it.
If NEW-FACE is a symbol or list of faces, prepend it to create a face list."
(cond
;; No existing face - just use new face
((null existing-face) new-face)
;; New face is a plist - deep merge with existing
((and (listp new-face) (keywordp (car-safe new-face)))
(cond
((and (listp existing-face) (keywordp (car-safe existing-face)))
(tp--deep-merge-plist existing-face new-face))
;; Existing is a symbol or list of faces - wrap new plist and prepend
((symbolp existing-face)
(list new-face existing-face))
((listp existing-face)
(cons new-face existing-face))
(t new-face)))
;; New face is a symbol - prepend to existing
((symbolp new-face)
(cond
((symbolp existing-face)
(if (eq new-face existing-face)
new-face
(list new-face existing-face)))
((listp existing-face)
(if (member new-face existing-face)
existing-face
(cons new-face existing-face)))
(t new-face)))
;; New face is a list of faces - prepend to existing
((listp new-face)
(cond
((symbolp existing-face)
(if (member existing-face new-face)
new-face
(append new-face (list existing-face))))
((listp existing-face)
(append new-face
(cl-remove-if (lambda (f) (member f new-face)) existing-face)))
(t new-face)))
(t new-face)))
(defun tp-add (start-or-string &optional end-or-prop props-or-val &rest rest)
"Add or update text properties, preserving existing properties.
@ -310,6 +354,11 @@ Unlike `tp-set', this deeply merges nested properties.
For example, \\='(face (:underline (:style wave))) will merge with
existing face properties rather than replacing them entirely.
For the `face' property specifically, symbol faces are prepended to
the existing face list rather than replacing. For example:
(tp-add str \\='face \\='shadow) with existing face \\='bold
results in face value \\='(shadow bold).
Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,props)
(tp--parse-args start-or-string end-or-prop props-or-val rest)))
@ -323,6 +372,9 @@ Return the modified object (string) or region (START . END) for buffer."
do (let* ((current-val (plist-get current-props key))
(new-val
(cond
;; Handle face property specially - prepend faces
((eq key 'face)
(tp--prepend-face val current-val))
;; Both are plists - deep merge
((and (listp val) (keywordp (car-safe val))
(listp current-val) (keywordp (car-safe current-val)))
@ -368,7 +420,7 @@ Supports plists, alists, and special display property formats."
(t nil))))
(tp--get-nested next-value rest))))
(defun tp-get (pos-or-start &optional property-or-end &rest args)
(defun tp-get (pos-or-start-or-string &optional property-or-end &rest args)
"Get text property value(s) with support for nested sub-properties.
This function supports multiple calling conventions:
@ -383,25 +435,56 @@ This function supports multiple calling conventions:
(tp-get 5 \\='face :box :color)
(tp-get 5 \\='display \\='space :width)
3. Range, single property:
3. Range with property path as list:
(tp-get START END \\='(PROPERTY) OBJECT)
(tp-get START END \\='(PROPERTY SUB-KEY ...) OBJECT)
(tp-get 5 20 \\='(face) str-or-buffer-or-nil)
(tp-get 5 20 \\='(face :underline) str-or-buffer-or-nil)
(tp-get 5 20 \\='(face :underline :style) str-or-buffer-or-nil)
4. Range, single property:
(tp-get START END PROPERTY)
(tp-get START END PROPERTY OBJECT)
4. Range, nested sub-property:
5. Range, nested sub-property:
(tp-get START END PROPERTY SUB-KEY ...)
5. Range, all properties (returns plist):
6. Range, all properties (returns plist):
(tp-get START END)
(tp-get START END OBJECT)
7. Entire string, all properties:
(tp-get STRING)
8. Entire string, single property:
(tp-get STRING PROPERTY)
9. Entire string, nested sub-property:
(tp-get STRING PROPERTY SUB-KEY ...)
(tp-get str \\='face)
(tp-get str \\='face :underline)
(tp-get str \\='face :underline :style)
For buffers, positions are 1-indexed.
For strings, positions are 0-indexed.
OBJECT defaults to current buffer."
(cond
;; (tp-get POS PROP ...) or (tp-get POS PROP OBJECT) - single position
((and (numberp pos-or-start)
;; (tp-get STRING ...) - entire string
((stringp pos-or-start-or-string)
(let ((str pos-or-start-or-string))
(if (null property-or-end)
;; (tp-get str) - return all properties
(text-properties-at 0 str)
;; (tp-get str 'face ...) - get specific property with optional sub-path
(let* ((prop-value (get-text-property 0 property-or-end str))
(sub-path args))
(if sub-path
(tp--get-nested prop-value sub-path)
prop-value)))))
;; (tp-get POS PROP ...) or (tp-get POS PROP OBJECT) - single position with symbol property
((and (numberp pos-or-start-or-string)
(symbolp property-or-end))
(let* ((prop-value (get-text-property pos-or-start property-or-end nil))
(let* ((prop-value (get-text-property pos-or-start-or-string property-or-end nil))
;; Determine if last arg is object or sub-property path
(sub-path args)
(object nil))
@ -411,14 +494,14 @@ OBJECT defaults to current buffer."
(or (bufferp last) (stringp last))))
(setq object (car (last args)))
(setq sub-path (butlast args))
(setq prop-value (get-text-property pos-or-start property-or-end object)))
(setq prop-value (get-text-property pos-or-start-or-string property-or-end object)))
(if sub-path
(tp--get-nested prop-value sub-path)
prop-value)))
;; (tp-get START END ...) - range form
((and (numberp pos-or-start)
((and (numberp pos-or-start-or-string)
(numberp property-or-end))
(let* ((start pos-or-start)
(let* ((start pos-or-start-or-string)
(end property-or-end)
(rest-args args)
(property nil)
@ -426,21 +509,28 @@ OBJECT defaults to current buffer."
(object nil))
;; Parse remaining args
(when rest-args
(if (symbolp (car rest-args))
(progn
(setq property (car rest-args))
(setq rest-args (cdr rest-args))
;; Remaining args could be sub-path and/or object
(when rest-args
(if (or (bufferp (car (last rest-args)))
(stringp (car (last rest-args))))
(progn
(setq object (car (last rest-args)))
(setq sub-path (butlast rest-args)))
(setq sub-path rest-args))))
;; First arg is object (buffer/string)
(when (or (bufferp (car rest-args)) (stringp (car rest-args)))
(setq object (car rest-args)))))
(cond
;; Property path as list: (tp-get 5 20 '(face :underline) obj)
((listp (car rest-args))
(let ((prop-path (car rest-args)))
(setq property (car prop-path))
(setq sub-path (cdr prop-path))
(setq object (cadr rest-args))))
;; Property as symbol
((symbolp (car rest-args))
(setq property (car rest-args))
(setq rest-args (cdr rest-args))
;; Remaining args could be sub-path and/or object
(when rest-args
(if (or (bufferp (car (last rest-args)))
(stringp (car (last rest-args))))
(progn
(setq object (car (last rest-args)))
(setq sub-path (butlast rest-args)))
(setq sub-path rest-args))))
;; First arg is object (buffer/string)
((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
(let ((pos start)
@ -547,22 +637,9 @@ Returns the modified plist, or nil if empty after removal."
(cl-remf result key))
(if (null result) nil result)))
(defun tp-remove (start end property &optional object)
"Remove PROPERTY or sub-properties from text between START and END.
PROPERTY can be:
- A symbol: Remove entire property
(tp-remove 1 10 \\='face)
- A list (PROP SUB-KEY): Remove sub-property from PROP
(tp-remove 1 10 \\='(face :underline))
- A list (PROP SUB-KEY (NESTED-KEYS...)): Remove nested sub-properties
(tp-remove 1 10 \\='(face :underline (:style :position)))
This removes :style and :position from :underline, keeping other keys like :color.
If no keys remain in :underline after removal, :underline itself is removed.
OBJECT defaults to current buffer."
(defun tp--remove-property (start end property object)
"Internal function to remove PROPERTY from START to END in OBJECT.
PROPERTY can be a symbol or a list for nested removal."
(cond
;; Simple property removal
((symbolp property)
@ -601,6 +678,68 @@ OBJECT defaults to current buffer."
(remove-text-properties pos next-pos (list prop-name nil) object))))
(setq pos next-pos)))))))))
(defun tp-remove (start-or-string end-or-prop &optional prop-or-sub &rest rest)
"Remove properties from text.
This function supports multiple calling conventions:
1. Buffer region with property:
(tp-remove START END PROPERTY)
(tp-remove START END PROPERTY OBJECT)
2. Buffer region with nested property:
(tp-remove START END \\='(PROPERTY SUB-KEY))
(tp-remove START END \\='(PROPERTY SUB-KEY (NESTED-KEYS...)))
3. Entire string with properties to remove:
(tp-remove STRING PROP1 PROP2 ...)
(tp-remove \"Hello\" \\='face \\='help-echo)
4. Entire string with sub-property removal:
(tp-remove STRING PROPERTY SUB-KEY)
(tp-remove \"Hello\" \\='face :underline)
5. Entire string with nested sub-property removal:
(tp-remove STRING PROPERTY SUB-KEY \\='(NESTED-KEYS...))
(tp-remove \"Hello\" \\='face :underline \\='(:style :position))
Returns the modified string for string input, or nil for buffer operations."
(cond
;; First arg is a string - apply to entire string
((stringp start-or-string)
(let ((str start-or-string)
(start 0)
(end (length start-or-string)))
(cond
;; (tp-remove str 'face :underline '(:style :position)) - nested sub-property removal
((and (symbolp end-or-prop)
(keywordp prop-or-sub)
rest
(listp (car rest)))
(tp--remove-property start end (list end-or-prop prop-or-sub (car rest)) str))
;; (tp-remove str 'face :underline) - sub-property removal
((and (symbolp end-or-prop) (keywordp prop-or-sub))
(tp-remove-sub start end end-or-prop prop-or-sub str))
;; (tp-remove str 'face 'help-echo ...) - multiple properties
((symbolp end-or-prop)
(let ((props (cons end-or-prop (cons prop-or-sub rest))))
(dolist (prop props)
(when (symbolp prop)
(remove-text-properties start end (list prop nil) str)))))
;; (tp-remove str '(face :underline)) - nested property spec
((listp end-or-prop)
(tp--remove-property start end end-or-prop str)))
str))
;; First arg is a number - buffer region
((numberp start-or-string)
(let* ((start start-or-string)
(end end-or-prop)
(property prop-or-sub)
(object (car rest)))
(tp--remove-property start end property object)
nil))
(t (error "Invalid arguments to tp-remove"))))
(defun tp-remove-list (start end properties &optional object)
"Remove list of PROPERTIES from text between START and END in OBJECT.
PROPERTIES should be a list of property names."