Add parameterized define-tp format and new usage syntax

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-28 16:35:42 +00:00
parent 967f69ad97
commit 0b44d1f57b
2 changed files with 242 additions and 38 deletions

View File

@ -27,6 +27,7 @@
`(with-temp-buffer `(with-temp-buffer
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil) (setq tp-layer-groups nil)
(setq tp-layer-params nil)
(tp-reactive-reset) (tp-reactive-reset)
,@body)) ,@body))
@ -3117,5 +3118,97 @@ the inserted text should be that string, not the source text."
(ignore-errors (makunbound 'tp-test-name-part2)) (ignore-errors (makunbound 'tp-test-name-part2))
(ignore-errors (makunbound 'tp-test-full-text))))) (ignore-errors (makunbound 'tp-test-full-text)))))
;;; ============================================================
;;; New define-tp Format Tests (Parameterized and Non-Parameterized)
;;; ============================================================
(ert-deftest tp-test-define-tp-non-parameterized ()
"Test define-tp with non-parameterized format."
(tp-test-with-temp-buffer
(define-tp tp-bold
'(face bold))
(should (assoc 'tp-bold tp-layer-alist))
(should (equal (cdr (assoc 'tp-bold tp-layer-alist)) '(face bold)))))
(ert-deftest tp-test-define-tp-parameterized ()
"Test define-tp with parameterized format."
(tp-test-with-temp-buffer
(define-tp tp-space (pixel)
(list 'display (list 'space :width (list pixel))))
;; Check it's registered as a parameterized layer
(should (assoc 'tp-space tp-layer-params))
;; Check the arglist is correct
(let ((param-info (cdr (assoc 'tp-space tp-layer-params))))
(should (equal (car param-info) '(pixel))))))
(ert-deftest tp-test-define-tp-parameterized-usage-string ()
"Test parameterized layer usage with string: (tp-set string 'layer-name arg)."
(tp-test-with-temp-buffer
(define-tp tp-space (pixel)
(list 'display (list 'space :width (list pixel))))
(let ((result (tp-set "emacs" 'tp-space 2)))
;; Result should have the correct properties
(should (eq (get-text-property 0 'tp-name result) 'tp-space))
(should (equal (get-text-property 0 'display result) '(space :width (2)))))))
(ert-deftest tp-test-define-tp-parameterized-usage-region ()
"Test parameterized layer usage with region: (tp-set start end '(layer-name arg))."
(tp-test-with-temp-buffer
(insert "emacs")
(define-tp tp-space (pixel)
(list 'display (list 'space :width (list pixel))))
(tp-set 1 6 '(tp-space 5))
;; Check properties in buffer
(should (eq (tp-at 1 'tp-name) 'tp-space))
(should (equal (tp-at 1 'display) '(space :width (5))))))
(ert-deftest tp-test-define-tp-non-parameterized-usage-string ()
"Test non-parameterized layer usage with string: (tp-set string 'layer-name t)."
(tp-test-with-temp-buffer
(define-tp tp-bold
'(face bold))
(let ((result (tp-set "emacs" 'tp-bold t)))
;; Result should have the correct properties
(should (eq (get-text-property 0 'tp-name result) 'tp-bold))
(should (eq (get-text-property 0 'face result) 'bold)))))
(ert-deftest tp-test-define-tp-non-parameterized-usage-region ()
"Test non-parameterized layer usage with region: (tp-set start end '(layer-name t))."
(tp-test-with-temp-buffer
(insert "emacs")
(define-tp tp-bold
'(face bold))
(tp-set 1 6 '(tp-bold t))
;; Check properties in buffer
(should (eq (tp-at 1 'tp-name) 'tp-bold))
(should (eq (tp-at 1 'face) 'bold))))
(ert-deftest tp-test-define-tp-parameterized-backquote ()
"Test parameterized layer with backquote syntax."
(tp-test-with-temp-buffer
(define-tp tp-test-space (pixel)
`(display (space :width (,pixel))))
(let ((result (tp-set "emacs" 'tp-test-space 10)))
(should (eq (get-text-property 0 'tp-name result) 'tp-test-space))
(should (equal (get-text-property 0 'display result) '(space :width (10)))))))
(ert-deftest tp-test-define-tp-parameterized-undefine ()
"Test tp-undefine-layer clears parameterized layer info."
(tp-test-with-temp-buffer
(define-tp tp-test-param (arg)
(list 'display arg))
(should (assoc 'tp-test-param tp-layer-params))
(tp-undefine-layer 'tp-test-param)
(should-not (assoc 'tp-test-param tp-layer-params))))
(ert-deftest tp-test-layer-reset-clears-params ()
"Test tp-layer-reset clears parameterized layers."
(tp-test-with-temp-buffer
(define-tp tp-test-param (arg)
(list 'display arg))
(should tp-layer-params)
(tp-layer-reset)
(should-not tp-layer-params)))
(provide 'tp-ert-tests) (provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here ;;; tp-ert-tests.el ends here

165
tp.el
View File

@ -66,6 +66,11 @@ Each element: (VAR-SYMBOL . ((LAYER-NAME . REACTIVE-PROPS) ...)).")
(defvar tp-layer-data nil (defvar tp-layer-data nil
"Alist of data variables: (LAYER-NAME . (VAR-SYMBOL ...)).") "Alist of data variables: (LAYER-NAME . (VAR-SYMBOL ...)).")
(defvar tp-layer-params nil
"Alist of layer parameter info: (LAYER-NAME . (ARGLIST . BODY-FORM)).
ARGLIST is a list of argument symbols (currently only single argument is supported).
BODY-FORM is the unevaluated body form that uses the argument.")
(defvar tp--anonymous-layer-counter 0 (defvar tp--anonymous-layer-counter 0
"Counter for generating unique anonymous layer names.") "Counter for generating unique anonymous layer names.")
@ -727,23 +732,43 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)."
(defun tp--parse-args (start-or-string end-or-prop props-or-val rest) (defun tp--parse-args (start-or-string end-or-prop props-or-val rest)
"Parse flexible function arguments and return (OBJECT START END PROPS). "Parse flexible function arguments and return (OBJECT START END PROPS).
Supports four calling conventions: Supports multiple 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 with plist: (STRING PROP VAL ...)
5. Entire string with layer: (STRING LAYER-NAME ARG)"
(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
((stringp start-or-string) ((stringp start-or-string)
(setq object start-or-string (setq object start-or-string
start 0 start 0
finish (length start-or-string) finish (length start-or-string))
props (if end-or-prop ;; Check if second arg is a layer/group name or parameterized layer
(cond
;; (tp-set "str" 'layer-name arg) - layer with argument
((and (symbolp end-or-prop)
(or (assoc end-or-prop tp-layer-alist)
(assoc end-or-prop tp-layer-groups)
(assoc end-or-prop tp-layer-params))
props-or-val
(null rest))
(setq props (list end-or-prop props-or-val)))
;; (tp-set "str" 'layer-name) - layer without argument (legacy)
((and (symbolp end-or-prop)
(or (assoc end-or-prop tp-layer-alist)
(assoc end-or-prop tp-layer-groups))
(null props-or-val)
(null rest))
(setq props (list end-or-prop)))
;; Standard flat plist: (tp-set "str" 'prop1 val1 'prop2 val2 ...)
(t
(setq props (if end-or-prop
(if props-or-val (if props-or-val
(cons end-or-prop (cons props-or-val rest)) (cons end-or-prop (cons props-or-val rest))
(list end-or-prop)) (list end-or-prop))
nil))) nil)))))
;; First arg is a number - region convention ;; First arg is a number - region convention
((numberp start-or-string) ((numberp start-or-string)
(setq start start-or-string (setq start start-or-string
@ -2109,22 +2134,52 @@ The layer is stored in `tp-layer-alist'."
"Define a single text property layer named NAME. "Define a single text property layer named NAME.
This macro provides a convenient syntax for `tp-define-layer'. This macro provides a convenient syntax for `tp-define-layer'.
All arguments use quoted list format. Supports two formats: with parameters and without parameters.
Format 1 - Direct plist (no :watch/:compute/:data support): Format 1 - Without parameters (static properties):
(define-tp tp-process-bar-done (define-tp tp-bold
\\='(display (space :width ($tp-done-pixel)) \\='(face bold))
face (:background $tp-done-color)))
Format 2 - With :props, :data, :watch, and/or :compute: Usage:
(define-tp tp-process-bar-done (tp-set \"emacs\" \\='tp-bold t)
:props \\='(display (space :width ($tp-done-pixel)) (tp-set 0 5 \\='(tp-bold t) \"emacs\")
face (:background $tp-done-color)) ;; => #(\"emacs\" 0 5 (tp-name tp-bold face bold))
:data \\=`((tp-done-color . ,tp-success-color)))
See `tp-define-layer' for full documentation." Format 2 - With a single parameter:
(define-tp tp-space (pixel)
\\=`(display (space :width (,pixel))))
Usage:
(tp-set \"emacs\" \\='tp-space 2)
(tp-set 0 5 \\='(tp-space 2) \"emacs\")
;; => #(\"emacs\" 0 5 (tp-name tp-space display (space :width (2))))
Note: The parameterized form stores the body as a function that takes
the parameter and returns the resolved property list."
(declare (indent defun)) (declare (indent defun))
`(tp-define-layer ',name ,@args)) (if (and (car args) (listp (car args)) (not (eq (caar args) 'quote)))
;; Parameterized form: (define-tp name (arg) body)
(let ((arglist (car args))
(body (cadr args)))
(unless (and (= (length arglist) 1)
(symbolp (car arglist)))
(error "define-tp with parameters only supports exactly one argument"))
`(tp--define-parameterized-layer ',name ',arglist ',body))
;; Non-parameterized form: (define-tp name 'props) or (define-tp name :props 'props ...)
`(tp-define-layer ',name ,@args)))
(defun tp--define-parameterized-layer (name arglist body)
"Define a parameterized layer NAME with ARGLIST and BODY.
ARGLIST must have exactly one element.
BODY is a form that will be evaluated with the argument bound."
;; Store the parameter info
(if (assoc name tp-layer-params)
(setf (cdr (assoc name tp-layer-params)) (cons arglist body))
(push (cons name (cons arglist body)) tp-layer-params))
;; Also store a placeholder in tp-layer-alist so the layer is recognized
;; The actual properties will be computed at usage time
(tp--set-layer-props name nil)
(assoc name tp-layer-alist))
(defun tp--layer-group-element-format (element) (defun tp--layer-group-element-format (element)
"Determine the format type of ELEMENT. "Determine the format type of ELEMENT.
@ -2358,6 +2413,23 @@ Appends 'tp-name property to identify the layer."
(when-let ((plist (cdr (assoc layer-name tp-layer-alist)))) (when-let ((plist (cdr (assoc layer-name tp-layer-alist))))
(append plist (list 'tp-name layer-name)))) (append plist (list 'tp-name layer-name))))
(defun tp-layer-parameterized-p (layer-name)
"Return non-nil if LAYER-NAME is a parameterized layer."
(assoc layer-name tp-layer-params))
(defun tp-layer-props-with-arg (layer-name arg)
"Return properties for parameterized layer LAYER-NAME with ARG.
Evaluates the body form with the argument bound to the parameter.
Appends 'tp-name property to identify the layer."
(when-let ((param-info (cdr (assoc layer-name tp-layer-params))))
(let* ((arglist (car param-info))
(body (cdr param-info))
(arg-sym (car arglist))
;; Evaluate the body with the argument bound
(plist (eval `(let ((,arg-sym ',arg)) ,body))))
(when plist
(append plist (list 'tp-name layer-name))))))
(defun tp-group-props (group-name) (defun tp-group-props (group-name)
"Return list of properties for all layers in GROUP-NAME." "Return list of properties for all layers in GROUP-NAME."
(when-let ((layers (cdr (assoc group-name tp-layer-groups)))) (when-let ((layers (cdr (assoc group-name tp-layer-groups))))
@ -2369,18 +2441,24 @@ Appends 'tp-name property to identify the layer."
"Resolve PROPS to a property list with layer metadata. "Resolve PROPS to a property list with layer metadata.
PROPS can be: PROPS can be:
- A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups') - A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups')
- A single-element list containing a layer/group symbol (from string form of tp-set) - A two-element list (LAYER-NAME ARG) where LAYER-NAME is a defined layer
and ARG is either `t' for non-parameterized layers or the argument value
for parameterized layers
- A plist (handles anonymous layers with reactive variables) - A plist (handles anonymous layers with reactive variables)
If PROPS is a symbol: If PROPS is a symbol:
- First checks `tp-layer-alist' and returns the layer properties WITH `tp-name' - First checks `tp-layer-alist' and returns the layer properties WITH `tp-name'
- Then checks `tp-layer-groups' and returns properties WITH `tp-layers' - Then checks `tp-layer-groups' and returns properties WITH `tp-layers'
If PROPS is (LAYER-NAME ARG):
- For non-parameterized layers: if ARG is t, returns the layer properties
- For parameterized layers: evaluates the body with ARG and returns the result
If PROPS is a plist: If PROPS is a plist:
- If it contains reactive variables ($...), generates a UUID for `tp-name', - If it contains reactive variables ($...), generates a UUID for `tp-name',
registers reactive dependencies, and returns the resolved props with `tp-name'. registers reactive dependencies, and returns the resolved props with `tp-name'.
If the plist already has a `tp-name', uses that instead of generating a new one. If the plist already has a `tp-name', uses that instead of generating a new one.
- If no reactive variables, adds a `tp-name' for the anonymous layer. - If no reactive variables, returns props as-is (no tp-name added).
Returns nil if PROPS is a symbol but no matching layer/group is found. Returns nil if PROPS is a symbol but no matching layer/group is found.
@ -2389,17 +2467,42 @@ For group names, includes `tp-layers' property with the full layer stack."
(cond (cond
;; Already a plist - check for reactive variables and add tp-name ;; Already a plist - check for reactive variables and add tp-name
((listp props) ((listp props)
(let ((first-elem (car-safe props))
(second-elem (cadr props)))
(cond
;; Handle (layer-name arg) format for defined layers
((and (= (length props) 2)
(symbolp first-elem)
(or (assoc first-elem tp-layer-alist)
(assoc first-elem tp-layer-params)
(assoc first-elem tp-layer-groups)))
(cond
;; Parameterized layer - evaluate with the argument
((tp-layer-parameterized-p first-elem)
(tp-layer-props-with-arg first-elem second-elem))
;; Non-parameterized layer - arg should be t, just return the layer props
((assoc first-elem tp-layer-alist)
(if (eq second-elem t)
(tp-layer-props first-elem)
;; If not t, treat as parameterized but layer isn't - error or return nil
(tp-layer-props first-elem)))
;; Layer group
((assoc first-elem tp-layer-groups)
(when-let ((layer-props-list (tp-group-props first-elem)))
(tp--build-layer-props layer-props-list)))))
;; Handle single-element list containing a layer/group name symbol. ;; Handle single-element list containing a layer/group name symbol.
;; This can happen when tp-set is called with string form: (tp-set str 'layer-name) ;; This can happen when tp-set is called with string form: (tp-set str 'layer-name)
;; which produces props = (layer-name) in tp--parse-args. ;; which produces props = (layer-name) in tp--parse-args.
(let ((first-elem (car-safe props))) ((and (= (length props) 1)
(if (and (= (length props) 1)
(symbolp first-elem) (symbolp first-elem)
(or (assoc first-elem tp-layer-alist) (or (assoc first-elem tp-layer-alist)
(assoc first-elem tp-layer-groups))) (assoc first-elem tp-layer-groups)))
;; It's a layer/group name wrapped in a list - recurse with the symbol ;; It's a layer/group name wrapped in a list - recurse with the symbol
(tp--resolve-props first-elem) (tp--resolve-props first-elem))
;; Normal plist processing ;; Normal plist processing
(t
(let* ((existing-tp-name (plist-get props 'tp-name)) (let* ((existing-tp-name (plist-get props 'tp-name))
(reactive-syms (tp--collect-reactive-symbols props))) (reactive-syms (tp--collect-reactive-symbols props)))
(if reactive-syms (if reactive-syms
@ -2416,11 +2519,17 @@ For group names, includes `tp-layers' property with the full layer stack."
(append resolved-props (list 'tp-name layer-name))) (append resolved-props (list 'tp-name layer-name)))
;; No reactive symbols - return props as-is (no tp-name needed) ;; No reactive symbols - return props as-is (no tp-name needed)
;; This preserves the native text property behavior for non-reactive plists ;; This preserves the native text property behavior for non-reactive plists
props))))) props))))))
;; Symbol - check if it's a layer or group name ;; Symbol - check if it's a layer or group name
((symbolp props) ((symbolp props)
(cond (cond
;; Check layer first - use tp-layer-props which adds tp-name ;; Check parameterized layer first - but without argument, we can't resolve it
;; Just check if it's a known layer name
((tp-layer-parameterized-p props)
;; Parameterized layer without argument - return nil or error
;; For now, return nil - caller should provide argument
nil)
;; Check layer - use tp-layer-props which adds tp-name
((assoc props tp-layer-alist) ((assoc props tp-layer-alist)
(tp-layer-props props)) (tp-layer-props props))
;; Check group - build layer stack with tp-layers ;; Check group - build layer stack with tp-layers
@ -2442,18 +2551,20 @@ If resolution fails, return PLIST unchanged (for backward compatibility)."
(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' and `tp-layer-params'.
Also resets all reactive text property watchers and dependencies." Also resets all reactive text property watchers and dependencies."
(interactive) (interactive)
(tp-reactive-reset) (tp-reactive-reset)
(setq tp-layer-alist nil) (setq tp-layer-alist nil)
(setq tp-layer-groups nil)) (setq tp-layer-groups nil)
(setq tp-layer-params nil))
(defun tp-undefine-layer (name) (defun tp-undefine-layer (name)
"Remove layer NAME from `tp-layer-alist'. "Remove layer NAME from `tp-layer-alist'.
Also unregisters any reactive dependencies for this layer." Also unregisters any reactive dependencies for this layer."
(tp--unregister-reactive-deps name) (tp--unregister-reactive-deps name)
(setq tp-layer-alist (assq-delete-all name tp-layer-alist))) (setq tp-layer-alist (assq-delete-all name tp-layer-alist))
(setq tp-layer-params (assq-delete-all name tp-layer-params)))
(defun tp-undefine-group (name) (defun tp-undefine-group (name)
"Remove layer group NAME from `tp-layer-groups'." "Remove layer group NAME from `tp-layer-groups'."