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

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

Browse Source 
- 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

164
tp-tests.el
View File

@ -2042,5 +2042,169 @@ Returns list of (START END VALUE) intervals."
;; Cleanup
(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)
;;; tp-ert-tests.el ends here

115
tp.el
View File

@ -248,7 +248,10 @@ Supports four calling conventions:
1. Buffer region: (START END PROPS)
2. Buffer region with object: (START END PROPS OBJECT)
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)
(cond
;; First arg is a string - apply to entire string
@ -272,8 +275,11 @@ Supports four calling conventions:
(setq object nil
props props-or-val)))
(t (error "Invalid first argument: %S" start-or-string)))
;; Handle properties as a list
(when (listp (car-safe props))
;; Resolve layer/group name to properties if props is a symbol
(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)))
(list object start finish props)))
@ -284,16 +290,22 @@ This function supports four calling conventions:
1. Current buffer:
(tp-set START END \\='(PROPERTY VALUE ...))
(tp-set START END LAYER-NAME)
2. Specific buffer:
(tp-set START END \\='(PROPERTY VALUE ...) BUFFER)
(tp-set START END LAYER-NAME BUFFER)
3. Specific string (0-indexed positions):
(tp-set START END \\='(PROPERTY VALUE ...) STRING)
(tp-set START END LAYER-NAME STRING)
4. Entire string:
(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.
Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,props)
@ -318,16 +330,22 @@ This function supports four calling conventions:
1. Current buffer:
(tp-reset START END \\='(PROPERTY VALUE ...))
(tp-reset START END LAYER-NAME)
2. Specific buffer:
(tp-reset START END \\='(PROPERTY VALUE ...) BUFFER)
(tp-reset START END LAYER-NAME BUFFER)
3. Specific string (0-indexed positions):
(tp-reset START END \\='(PROPERTY VALUE ...) STRING)
(tp-reset START END LAYER-NAME STRING)
4. Entire string:
(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.
Return the modified object (string) or region (START . END) for buffer."
(pcase-let ((`(,object ,start ,finish ,props)
@ -415,16 +433,22 @@ This function supports four calling conventions:
1. Current buffer:
(tp-add START END \\='(PROPERTY VALUE ...))
(tp-add START END LAYER-NAME)
2. Specific buffer:
(tp-add START END \\='(PROPERTY VALUE ...) BUFFER)
(tp-add START END LAYER-NAME BUFFER)
3. Specific string (0-indexed positions):
(tp-add START END \\='(PROPERTY VALUE ...) STRING)
(tp-add START END LAYER-NAME STRING)
4. Entire string:
(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.
For example, \\='(face (:underline (:style wave))) will merge with
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).
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.
Returns:
- For strings: the modified string
- 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)
"Reset (completely replace) properties on all occurrences of PATTERN.
@ -1044,14 +1071,17 @@ Returns:
(tp-match-reset PATTERN PLIST &optional OBJECT)
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.
Unlike `tp-match-set', this completely replaces all existing properties."
(tp--match-apply pattern plist
(lambda (start end props obj)
(set-text-properties start end props obj))
object))
(let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--match-apply pattern props
(lambda (start end props obj)
(set-text-properties start end props obj))
object)))
(defun tp-match-add (pattern plist &optional object)
"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)
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.
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)
"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).
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.
Returns:
- For strings: the modified string
- 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)
"Reset (completely replace) properties on all regexp matches of PATTERN.
@ -1086,14 +1122,17 @@ Returns:
(tp-regexp-reset PATTERN PLIST &optional OBJECT)
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.
Unlike `tp-regexp-set', this completely replaces all existing properties."
(tp--regexp-apply pattern plist
(lambda (start end props obj)
(set-text-properties start end props obj))
object))
(let ((props (if (symbolp plist) (or (tp--resolve-props plist) plist) plist)))
(tp--regexp-apply pattern props
(lambda (start end props obj)
(set-text-properties start end props obj))
object)))
(defun tp-regexp-add (pattern plist &optional object)
"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)
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.
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
@ -1911,6 +1953,37 @@ Appends 'tp-name property to identify the layer."
(tp-layer-props layer))
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 ()
"Reset all layer definitions.
Clears both `tp-layer-alist' and `tp-layer-groups'.