feat: Allow text property APIs to accept layer/group names defined by define-tp/define-tp-group

- Add tp--resolve-props helper function to resolve layer/group names to property lists
- Modify tp--parse-args to handle layer name symbols for tp-set, tp-reset, tp-add
- Update tp-match-set, tp-match-reset, tp-match-add to accept layer names
- Update tp-regexp-set, tp-regexp-reset, tp-regexp-add to accept layer names
- Update docstrings to document the new functionality
- Add comprehensive tests for all affected functions

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-20 07:18:15 +00:00
parent fe92965178
commit 8e9b480d4c
2 changed files with 258 additions and 21 deletions

View File

@ -2042,5 +2042,169 @@ Returns list of (START END VALUE) intervals."
;; Cleanup ;; Cleanup
(makunbound 'tp-test-undef-color)))) (makunbound 'tp-test-undef-color))))
;;; ============================================================
;;; Layer Name in Property-Setting APIs Tests
;;; ============================================================
(ert-deftest tp-test-set-with-layer-name ()
"Test tp-set accepts a layer name defined by define-tp."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-define-layer my-style (face bold help-echo "tip"))
;; Use layer name instead of plist
(tp-set 1 6 'my-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "tip"))))
(ert-deftest tp-test-set-with-layer-name-on-string ()
"Test tp-set accepts a layer name on string."
(let ((str (copy-sequence "Hello World")))
(setq tp-layer-alist nil)
(setq tp-layer-groups nil)
(tp-define-layer my-style (face italic))
(tp-set 0 5 'my-style str)
(should (eq (get-text-property 0 'face str) 'italic))))
(ert-deftest tp-test-reset-with-layer-name ()
"Test tp-reset accepts a layer name defined by define-tp."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-set 1 6 '(mouse-face highlight))
(tp-define-layer my-style (face underline))
;; Use layer name - should completely replace
(tp-reset 1 6 'my-style)
(should (eq (tp-at 1 'face) 'underline))
(should (null (tp-at 1 'mouse-face)))))
(ert-deftest tp-test-add-with-layer-name ()
"Test tp-add accepts a layer name defined by define-tp."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-set 1 6 '(help-echo "existing"))
(tp-define-layer my-style (face bold))
;; Use layer name - should preserve existing properties
(tp-add 1 6 'my-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "existing"))))
(ert-deftest tp-test-match-set-with-layer-name ()
"Test tp-match-set accepts a layer name."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-define-layer match-style (face bold help-echo "matched"))
(tp-match-set "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "matched"))
(should (eq (tp-at 13 'face) 'bold))))
(ert-deftest tp-test-match-set-with-layer-name-on-string ()
"Test tp-match-set accepts a layer name on string."
(let ((str (copy-sequence "Hello World Hello")))
(setq tp-layer-alist nil)
(setq tp-layer-groups nil)
(tp-define-layer match-style (face italic))
(tp-match-set "Hello" 'match-style str)
(should (eq (get-text-property 0 'face str) 'italic))
(should (eq (get-text-property 12 'face str) 'italic))))
(ert-deftest tp-test-match-reset-with-layer-name ()
"Test tp-match-reset accepts a layer name."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-set 1 6 '(mouse-face highlight))
(tp-define-layer match-style (face bold))
(tp-match-reset "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold))
(should (null (tp-at 1 'mouse-face)))))
(ert-deftest tp-test-match-add-with-layer-name ()
"Test tp-match-add accepts a layer name."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-set 1 6 '(help-echo "original"))
(tp-define-layer match-style (face bold))
(tp-match-add "Hello" 'match-style)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "original"))))
(ert-deftest tp-test-regexp-set-with-layer-name ()
"Test tp-regexp-set accepts a layer name."
(tp-test-with-temp-buffer
(insert "abc 123 def 456")
(tp-define-layer number-style (face bold help-echo "number"))
(tp-regexp-set "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold))
(should (equal (tp-at 5 'help-echo) "number"))
(should (eq (tp-at 13 'face) 'bold))))
(ert-deftest tp-test-regexp-set-with-layer-name-on-string ()
"Test tp-regexp-set accepts a layer name on string."
(let ((str (copy-sequence "abc 123 def 456")))
(setq tp-layer-alist nil)
(setq tp-layer-groups nil)
(tp-define-layer number-style (face italic))
(tp-regexp-set "[0-9]+" 'number-style str)
(should (eq (get-text-property 4 'face str) 'italic))
(should (eq (get-text-property 12 'face str) 'italic))))
(ert-deftest tp-test-regexp-reset-with-layer-name ()
"Test tp-regexp-reset accepts a layer name."
(tp-test-with-temp-buffer
(insert "abc 123 def 456")
(tp-set 5 8 '(mouse-face highlight))
(tp-define-layer number-style (face bold))
(tp-regexp-reset "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold))
(should (null (tp-at 5 'mouse-face)))))
(ert-deftest tp-test-regexp-add-with-layer-name ()
"Test tp-regexp-add accepts a layer name."
(tp-test-with-temp-buffer
(insert "abc 123 def 456")
(tp-set 5 8 '(help-echo "original"))
(tp-define-layer number-style (face bold))
(tp-regexp-add "[0-9]+" 'number-style)
(should (eq (tp-at 5 'face) 'bold))
(should (equal (tp-at 5 'help-echo) "original"))))
(ert-deftest tp-test-set-with-group-name ()
"Test tp-set accepts a group name defined by define-tp-group."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-define-layer-group my-group
("style" . (face bold help-echo "grouped")))
;; Use group name - should use first layer's properties
(tp-set 1 6 'my-group)
(should (eq (tp-at 1 'face) 'bold))
(should (equal (tp-at 1 'help-echo) "grouped"))))
(ert-deftest tp-test-match-set-with-group-name ()
"Test tp-match-set accepts a group name."
(tp-test-with-temp-buffer
(insert "Hello World Hello")
(tp-define-layer-group my-group
("style" . (face italic)))
(tp-match-set "Hello" 'my-group)
(should (eq (tp-at 1 'face) 'italic))
(should (eq (tp-at 13 'face) 'italic))))
(ert-deftest tp-test-resolve-props-returns-nil-for-unknown ()
"Test tp--resolve-props returns nil for unknown layer name."
(tp-test-with-temp-buffer
(should (null (tp--resolve-props 'unknown-layer-name)))))
(ert-deftest tp-test-set-with-complex-layer ()
"Test tp-set with layer containing complex nested properties."
(tp-test-with-temp-buffer
(insert "Hello World")
(tp-define-layer complex-layer
(face (:foreground "red" :underline (:style wave))
help-echo "complex"))
(tp-set 1 6 'complex-layer)
(let ((face (tp-at 1 'face)))
(should (equal (plist-get face :foreground) "red"))
(should (equal (plist-get (plist-get face :underline) :style) 'wave)))
(should (equal (tp-at 1 'help-echo) "complex"))))
(provide 'tp-ert-tests) (provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here ;;; tp-ert-tests.el ends here

107
tp.el
View File

@ -248,7 +248,10 @@ Supports four calling conventions:
1. Buffer region: (START END PROPS) 1. Buffer region: (START END PROPS)
2. Buffer region with object: (START END PROPS OBJECT) 2. Buffer region with object: (START END PROPS OBJECT)
3. String region: (START END PROPS STRING) 3. String region: (START END PROPS STRING)
4. Entire string: (STRING PROP VAL ...)" 4. Entire string: (STRING PROP VAL ...)
PROPS can also be a symbol representing a layer or group name defined
by `define-tp' or `define-tp-group', which will be resolved to its properties."
(let (object start finish props) (let (object start finish props)
(cond (cond
;; First arg is a string - apply to entire string ;; First arg is a string - apply to entire string
@ -272,8 +275,11 @@ Supports four calling conventions:
(setq object nil (setq object nil
props props-or-val))) props props-or-val)))
(t (error "Invalid first argument: %S" start-or-string))) (t (error "Invalid first argument: %S" start-or-string)))
;; Handle properties as a list ;; Resolve layer/group name to properties if props is a symbol
(when (listp (car-safe props)) (when (symbolp props)
(setq props (or (tp--resolve-props props) props)))
;; Handle properties as a list (only if props is a list and its first element is also a list)
(when (and (listp props) (listp (car-safe props)))
(setq props (car props))) (setq props (car props)))
(list object start finish props))) (list object start finish props)))
@ -284,16 +290,22 @@ This function supports four calling conventions:
1. Current buffer: 1. Current buffer:
(tp-set START END \\='(PROPERTY VALUE ...)) (tp-set START END \\='(PROPERTY VALUE ...))
(tp-set START END LAYER-NAME)
2. Specific buffer: 2. Specific buffer:
(tp-set START END \\='(PROPERTY VALUE ...) BUFFER) (tp-set START END \\='(PROPERTY VALUE ...) BUFFER)
(tp-set START END LAYER-NAME BUFFER)
3. Specific string (0-indexed positions): 3. Specific string (0-indexed positions):
(tp-set START END \\='(PROPERTY VALUE ...) STRING) (tp-set START END \\='(PROPERTY VALUE ...) STRING)
(tp-set START END LAYER-NAME STRING)
4. Entire string: 4. Entire string:
(tp-set STRING PROPERTY VALUE ...) (tp-set STRING PROPERTY VALUE ...)
PROPS can also be a symbol representing a layer or group name defined
by `define-tp' or `define-tp-group', which will be resolved to its properties.
This replaces only the properties specified, preserving other properties. This replaces only the properties specified, preserving other properties.
Return the modified object (string) or region (START . END) for buffer." Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,props) (pcase-let ((`(,object ,start ,finish ,props)
@ -318,16 +330,22 @@ This function supports four calling conventions:
1. Current buffer: 1. Current buffer:
(tp-reset START END \\='(PROPERTY VALUE ...)) (tp-reset START END \\='(PROPERTY VALUE ...))
(tp-reset START END LAYER-NAME)
2. Specific buffer: 2. Specific buffer:
(tp-reset START END \\='(PROPERTY VALUE ...) BUFFER) (tp-reset START END \\='(PROPERTY VALUE ...) BUFFER)
(tp-reset START END LAYER-NAME BUFFER)
3. Specific string (0-indexed positions): 3. Specific string (0-indexed positions):
(tp-reset START END \\='(PROPERTY VALUE ...) STRING) (tp-reset START END \\='(PROPERTY VALUE ...) STRING)
(tp-reset START END LAYER-NAME STRING)
4. Entire string: 4. Entire string:
(tp-reset STRING PROPERTY VALUE ...) (tp-reset STRING PROPERTY VALUE ...)
PROPS can also be a symbol representing a layer or group name defined
by `define-tp' or `define-tp-group', which will be resolved to its properties.
Unlike `tp-set', this completely replaces all existing properties. Unlike `tp-set', this completely replaces all existing properties.
Return the modified object (string) or region (START . END) for buffer." Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,props) (pcase-let ((`(,object ,start ,finish ,props)
@ -415,16 +433,22 @@ This function supports four calling conventions:
1. Current buffer: 1. Current buffer:
(tp-add START END \\='(PROPERTY VALUE ...)) (tp-add START END \\='(PROPERTY VALUE ...))
(tp-add START END LAYER-NAME)
2. Specific buffer: 2. Specific buffer:
(tp-add START END \\='(PROPERTY VALUE ...) BUFFER) (tp-add START END \\='(PROPERTY VALUE ...) BUFFER)
(tp-add START END LAYER-NAME BUFFER)
3. Specific string (0-indexed positions): 3. Specific string (0-indexed positions):
(tp-add START END \\='(PROPERTY VALUE ...) STRING) (tp-add START END \\='(PROPERTY VALUE ...) STRING)
(tp-add START END LAYER-NAME STRING)
4. Entire string: 4. Entire string:
(tp-add STRING PROPERTY VALUE ...) (tp-add STRING PROPERTY VALUE ...)
PROPS can also be a symbol representing a layer or group name defined
by `define-tp' or `define-tp-group', which will be resolved to its properties.
Unlike `tp-set', this deeply merges nested properties. Unlike `tp-set', this deeply merges nested properties.
For example, \\='(face (:underline (:style wave))) will merge with For example, \\='(face (:underline (:style wave))) will merge with
existing face properties rather than replacing them entirely. existing face properties rather than replacing them entirely.
@ -1030,13 +1054,16 @@ Merges nested plists instead of replacing them."
PATTERN is a string (single pattern) or list of strings (multiple patterns). PATTERN is a string (single pattern) or list of strings (multiple patterns).
Each pattern will be matched and have properties applied. Each pattern will be matched and have properties applied.
PLIST is a property list like \\='(face bold help-echo \"tip\"). PLIST is a property list like \\='(face bold help-echo \"tip\"),
or a symbol representing a layer/group name defined by `define-tp'
or `define-tp-group'.
OBJECT is a buffer or string; nil means current buffer. OBJECT is a buffer or string; nil means current buffer.
Returns: Returns:
- For strings: the modified string - For strings: the modified string
- For buffers: list of (START . END) pairs for all matches." - For buffers: list of (START . END) pairs for all matches."
(tp--match-apply pattern plist #'tp-set object)) (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--match-apply pattern props #'tp-set object)))
(defun tp-match-reset (pattern plist &optional object) (defun tp-match-reset (pattern plist &optional object)
"Reset (completely replace) properties on all occurrences of PATTERN. "Reset (completely replace) properties on all occurrences of PATTERN.
@ -1044,14 +1071,17 @@ Returns:
(tp-match-reset PATTERN PLIST &optional OBJECT) (tp-match-reset PATTERN PLIST &optional OBJECT)
PATTERN is a string (single pattern) or list of strings (multiple patterns). PATTERN is a string (single pattern) or list of strings (multiple patterns).
PLIST is a property list like \\='(face bold help-echo \"tip\"). PLIST is a property list like \\='(face bold help-echo \"tip\"),
or a symbol representing a layer/group name defined by `define-tp'
or `define-tp-group'.
OBJECT is a buffer or string; nil means current buffer. OBJECT is a buffer or string; nil means current buffer.
Unlike `tp-match-set', this completely replaces all existing properties." Unlike `tp-match-set', this completely replaces all existing properties."
(tp--match-apply pattern plist (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--match-apply pattern props
(lambda (start end props obj) (lambda (start end props obj)
(set-text-properties start end props obj)) (set-text-properties start end props obj))
object)) object)))
(defun tp-match-add (pattern plist &optional object) (defun tp-match-add (pattern plist &optional object)
"Add/update properties on all occurrences of PATTERN. "Add/update properties on all occurrences of PATTERN.
@ -1059,11 +1089,14 @@ Unlike `tp-match-set', this completely replaces all existing properties."
(tp-match-add PATTERN PLIST &optional OBJECT) (tp-match-add PATTERN PLIST &optional OBJECT)
PATTERN is a string (single pattern) or list of strings (multiple patterns). PATTERN is a string (single pattern) or list of strings (multiple patterns).
PLIST is a property list like \\='(face bold help-echo \"tip\"). PLIST is a property list like \\='(face bold help-echo \"tip\"),
or a symbol representing a layer/group name defined by `define-tp'
or `define-tp-group'.
OBJECT is a buffer or string; nil means current buffer. OBJECT is a buffer or string; nil means current buffer.
Unlike `tp-match-set', this deeply merges nested properties." Unlike `tp-match-set', this deeply merges nested properties."
(tp--match-apply pattern plist #'tp--deep-merge-apply object)) (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--match-apply pattern props #'tp--deep-merge-apply object)))
(defun tp-regexp-set (pattern plist &optional object) (defun tp-regexp-set (pattern plist &optional object)
"Set properties on all matches of PATTERN (regexp). "Set properties on all matches of PATTERN (regexp).
@ -1072,13 +1105,16 @@ Unlike `tp-match-set', this deeply merges nested properties."
PATTERN is a string (single regexp) or list of strings (multiple regexps). PATTERN is a string (single regexp) or list of strings (multiple regexps).
Each pattern will be matched and have properties applied. Each pattern will be matched and have properties applied.
PLIST is a property list like \\='(face bold help-echo \"tip\"). PLIST is a property list like \\='(face bold help-echo \"tip\"),
or a symbol representing a layer/group name defined by `define-tp'
or `define-tp-group'.
OBJECT is a buffer or string; nil means current buffer. OBJECT is a buffer or string; nil means current buffer.
Returns: Returns:
- For strings: the modified string - For strings: the modified string
- For buffers: list of (START . END) pairs for all matches." - For buffers: list of (START . END) pairs for all matches."
(tp--regexp-apply pattern plist #'tp-set object)) (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--regexp-apply pattern props #'tp-set object)))
(defun tp-regexp-reset (pattern plist &optional object) (defun tp-regexp-reset (pattern plist &optional object)
"Reset (completely replace) properties on all regexp matches of PATTERN. "Reset (completely replace) properties on all regexp matches of PATTERN.
@ -1086,14 +1122,17 @@ Returns:
(tp-regexp-reset PATTERN PLIST &optional OBJECT) (tp-regexp-reset PATTERN PLIST &optional OBJECT)
PATTERN is a string (single regexp) or list of strings (multiple regexps). PATTERN is a string (single regexp) or list of strings (multiple regexps).
PLIST is a property list like \\='(face bold help-echo \"tip\"). PLIST is a property list like \\='(face bold help-echo \"tip\"),
or a symbol representing a layer/group name defined by `define-tp'
or `define-tp-group'.
OBJECT is a buffer or string; nil means current buffer. OBJECT is a buffer or string; nil means current buffer.
Unlike `tp-regexp-set', this completely replaces all existing properties." Unlike `tp-regexp-set', this completely replaces all existing properties."
(tp--regexp-apply pattern plist (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--regexp-apply pattern props
(lambda (start end props obj) (lambda (start end props obj)
(set-text-properties start end props obj)) (set-text-properties start end props obj))
object)) object)))
(defun tp-regexp-add (pattern plist &optional object) (defun tp-regexp-add (pattern plist &optional object)
"Add/update properties on all regexp matches of PATTERN. "Add/update properties on all regexp matches of PATTERN.
@ -1101,11 +1140,14 @@ Unlike `tp-regexp-set', this completely replaces all existing properties."
(tp-regexp-add PATTERN PLIST &optional OBJECT) (tp-regexp-add PATTERN PLIST &optional OBJECT)
PATTERN is a string (single regexp) or list of strings (multiple regexps). PATTERN is a string (single regexp) or list of strings (multiple regexps).
PLIST is a property list like \\='(face bold help-echo \"tip\"). PLIST is a property list like \\='(face bold help-echo \"tip\"),
or a symbol representing a layer/group name defined by `define-tp'
or `define-tp-group'.
OBJECT is a buffer or string; nil means current buffer. OBJECT is a buffer or string; nil means current buffer.
Unlike `tp-regexp-set', this deeply merges nested properties." Unlike `tp-regexp-set', this deeply merges nested properties."
(tp--regexp-apply pattern plist #'tp--deep-merge-apply object)) (let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--regexp-apply pattern props #'tp--deep-merge-apply object)))
;;; Search functions ;;; Search functions
@ -1911,6 +1953,37 @@ Appends 'tp-name property to identify the layer."
(tp-layer-props layer)) (tp-layer-props layer))
layers))) layers)))
(defun tp--resolve-props (props)
"Resolve PROPS to a property list.
PROPS can be:
- A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups')
- A plist (returned as-is)
If PROPS is a symbol:
- First checks `tp-layer-alist' and returns the layer properties
- Then checks `tp-layer-groups' and returns the first layer's properties
Unlike `tp-layer-props', this does NOT add the `tp-name' property,
making it suitable for use with basic property-setting APIs like
`tp-set', `tp-add', `tp-match-set', etc."
(cond
;; Already a plist - return as-is
((listp props) props)
;; Symbol - check if it's a layer or group name
((symbolp props)
(cond
;; Check layer first
((assoc props tp-layer-alist)
(cdr (assoc props tp-layer-alist)))
;; Check group (use first layer's properties)
((assoc props tp-layer-groups)
(when-let* ((layers (cdr (assoc props tp-layer-groups)))
(first-layer (car layers)))
(cdr (assoc first-layer tp-layer-alist))))
;; Not found - return nil (let caller decide how to handle)
(t nil)))
(t nil)))
(defun tp-layer-reset () (defun tp-layer-reset ()
"Reset all layer definitions. "Reset all layer definitions.
Clears both `tp-layer-alist' and `tp-layer-groups'. Clears both `tp-layer-alist' and `tp-layer-groups'.