Consolidate tp-layer-params into tp-layer-alist with unified structure
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
parent
c701a1ca75
commit
42c436494f
28
tp-tests.el
28
tp-tests.el
@ -27,7 +27,6 @@
|
|||||||
`(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))
|
||||||
|
|
||||||
@ -3128,7 +3127,11 @@ the inserted text should be that string, not the source text."
|
|||||||
(define-tp tp-bold ()
|
(define-tp tp-bold ()
|
||||||
'(face bold))
|
'(face bold))
|
||||||
(should (assoc 'tp-bold tp-layer-alist))
|
(should (assoc 'tp-bold tp-layer-alist))
|
||||||
(should (equal (cdr (assoc 'tp-bold tp-layer-alist)) '(face bold)))))
|
;; Unified structure: (LAYER-NAME nil BODY-FORM) where BODY-FORM is quoted
|
||||||
|
(let ((entry (cdr (assoc 'tp-bold tp-layer-alist))))
|
||||||
|
(should (= (length entry) 2))
|
||||||
|
(should (null (car entry))) ; arglist is nil
|
||||||
|
(should (equal (eval (cadr entry)) '(face bold))))))
|
||||||
|
|
||||||
(ert-deftest tp-test-define-tp-non-parameterized-usage-string ()
|
(ert-deftest tp-test-define-tp-non-parameterized-usage-string ()
|
||||||
"Test non-parameterized layer usage with string: (tp-set string 'layer-name t)."
|
"Test non-parameterized layer usage with string: (tp-set string 'layer-name t)."
|
||||||
@ -3156,11 +3159,13 @@ the inserted text should be that string, not the source text."
|
|||||||
(tp-test-with-temp-buffer
|
(tp-test-with-temp-buffer
|
||||||
(define-tp tp-space (pixel)
|
(define-tp tp-space (pixel)
|
||||||
(list 'display (list 'space :width (list pixel))))
|
(list 'display (list 'space :width (list pixel))))
|
||||||
;; Check it's registered as a parameterized layer
|
;; Check it's registered as a parameterized layer in tp-layer-alist
|
||||||
(should (assoc 'tp-space tp-layer-params))
|
(should (assoc 'tp-space tp-layer-alist))
|
||||||
;; Check the arglist is correct
|
(should (tp-layer-parameterized-p 'tp-space))
|
||||||
(let ((param-info (cdr (assoc 'tp-space tp-layer-params))))
|
;; Check the structure is correct (ARGLIST BODY-FORM)
|
||||||
(should (equal (car param-info) '(pixel))))))
|
(let ((entry (cdr (assoc 'tp-space tp-layer-alist))))
|
||||||
|
;; entry is (ARGLIST BODY-FORM)
|
||||||
|
(should (equal (car entry) '(pixel))))))
|
||||||
|
|
||||||
(ert-deftest tp-test-define-tp-parameterized-usage-string ()
|
(ert-deftest tp-test-define-tp-parameterized-usage-string ()
|
||||||
"Test parameterized layer usage with string: (tp-set string 'layer-name arg)."
|
"Test parameterized layer usage with string: (tp-set string 'layer-name arg)."
|
||||||
@ -3197,18 +3202,19 @@ the inserted text should be that string, not the source text."
|
|||||||
(tp-test-with-temp-buffer
|
(tp-test-with-temp-buffer
|
||||||
(define-tp tp-test-param (arg)
|
(define-tp tp-test-param (arg)
|
||||||
(list 'display arg))
|
(list 'display arg))
|
||||||
(should (assoc 'tp-test-param tp-layer-params))
|
(should (assoc 'tp-test-param tp-layer-alist))
|
||||||
|
(should (tp-layer-parameterized-p 'tp-test-param))
|
||||||
(tp-undefine-layer 'tp-test-param)
|
(tp-undefine-layer 'tp-test-param)
|
||||||
(should-not (assoc 'tp-test-param tp-layer-params))))
|
(should-not (assoc 'tp-test-param tp-layer-alist))))
|
||||||
|
|
||||||
(ert-deftest tp-test-layer-reset-clears-params ()
|
(ert-deftest tp-test-layer-reset-clears-params ()
|
||||||
"Test tp-layer-reset clears parameterized layers."
|
"Test tp-layer-reset clears parameterized layers."
|
||||||
(tp-test-with-temp-buffer
|
(tp-test-with-temp-buffer
|
||||||
(define-tp tp-test-param (arg)
|
(define-tp tp-test-param (arg)
|
||||||
(list 'display arg))
|
(list 'display arg))
|
||||||
(should tp-layer-params)
|
(should (assoc 'tp-test-param tp-layer-alist))
|
||||||
(tp-layer-reset)
|
(tp-layer-reset)
|
||||||
(should-not tp-layer-params)))
|
(should-not tp-layer-alist)))
|
||||||
|
|
||||||
(ert-deftest tp-test-layer-with-extra-props-string ()
|
(ert-deftest tp-test-layer-with-extra-props-string ()
|
||||||
"Test layer with extra native properties on string."
|
"Test layer with extra native properties on string."
|
||||||
|
|||||||
107
tp.el
107
tp.el
@ -66,11 +66,6 @@ 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.")
|
||||||
|
|
||||||
@ -751,8 +746,7 @@ Supports multiple calling conventions:
|
|||||||
;; (tp-set "str" 'layer-name arg ...) - layer with argument and optional extra props
|
;; (tp-set "str" 'layer-name arg ...) - layer with argument and optional extra props
|
||||||
((and (symbolp end-or-prop)
|
((and (symbolp end-or-prop)
|
||||||
(or (assoc end-or-prop tp-layer-alist)
|
(or (assoc end-or-prop tp-layer-alist)
|
||||||
(assoc end-or-prop tp-layer-groups)
|
(assoc end-or-prop tp-layer-groups))
|
||||||
(assoc end-or-prop tp-layer-params))
|
|
||||||
props-or-val)
|
props-or-val)
|
||||||
;; Build props: (layer-name arg extra-prop1 val1 ...)
|
;; Build props: (layer-name arg extra-prop1 val1 ...)
|
||||||
(setq props (cons end-or-prop (cons props-or-val rest))))
|
(setq props (cons end-or-prop (cons props-or-val rest))))
|
||||||
@ -2173,27 +2167,28 @@ it will be evaluated with the argument bound."
|
|||||||
(unless (listp arglist)
|
(unless (listp arglist)
|
||||||
(error "define-tp ARGLIST must be a list"))
|
(error "define-tp ARGLIST must be a list"))
|
||||||
(cond
|
(cond
|
||||||
;; Non-parameterized: empty arglist
|
;; Non-parameterized: empty arglist - store as (LAYER-NAME nil BODY-FORM)
|
||||||
((null arglist)
|
((null arglist)
|
||||||
`(tp-define-layer ',name ,body))
|
`(tp--define-layer-unified ',name nil ,body))
|
||||||
;; Parameterized: single argument
|
;; Parameterized: single argument - store as (LAYER-NAME ARGLIST BODY-FORM)
|
||||||
((and (= (length arglist) 1)
|
((and (= (length arglist) 1)
|
||||||
(symbolp (car arglist)))
|
(symbolp (car arglist)))
|
||||||
`(tp--define-parameterized-layer ',name ',arglist ',body))
|
`(tp--define-layer-unified ',name ',arglist ',body))
|
||||||
(t
|
(t
|
||||||
(error "define-tp ARGLIST must be empty or contain exactly one symbol"))))
|
(error "define-tp ARGLIST must be empty or contain exactly one symbol"))))
|
||||||
|
|
||||||
(defun tp--define-parameterized-layer (name arglist body)
|
(defun tp--define-layer-unified (name arglist body)
|
||||||
"Define a parameterized layer NAME with ARGLIST and BODY.
|
"Define a layer NAME with ARGLIST and BODY using unified structure.
|
||||||
ARGLIST must have exactly one element.
|
For non-parameterized layers, ARGLIST is nil and BODY is the evaluated plist.
|
||||||
BODY is a form that will be evaluated with the argument bound."
|
For parameterized layers, ARGLIST contains one symbol and BODY is the unevaluated form.
|
||||||
;; Store the parameter info
|
Stores the layer in `tp-layer-alist' with format: (LAYER-NAME ARGLIST BODY-FORM)."
|
||||||
(if (assoc name tp-layer-params)
|
;; Store in tp-layer-alist with unified format: (LAYER-NAME ARGLIST BODY-FORM)
|
||||||
(setf (cdr (assoc name tp-layer-params)) (cons arglist body))
|
;; For non-parameterized, quote the body so eval returns the plist
|
||||||
(push (cons name (cons arglist body)) tp-layer-params))
|
(let ((stored-body (if arglist body `',body)))
|
||||||
;; Also store a placeholder in tp-layer-alist so the layer is recognized
|
(let ((entry (list arglist stored-body)))
|
||||||
;; The actual properties will be computed at usage time
|
(if (assoc name tp-layer-alist)
|
||||||
(tp--set-layer-props name nil)
|
(setf (cdr (assoc name tp-layer-alist)) entry)
|
||||||
|
(push (cons name entry) tp-layer-alist))))
|
||||||
(assoc name tp-layer-alist))
|
(assoc name tp-layer-alist))
|
||||||
|
|
||||||
(defun tp--layer-group-element-format (element)
|
(defun tp--layer-group-element-format (element)
|
||||||
@ -2409,6 +2404,7 @@ See `tp-define-layer-group' for full documentation."
|
|||||||
(defun tp--set-layer-props (layer-name properties)
|
(defun tp--set-layer-props (layer-name properties)
|
||||||
"Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'.
|
"Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'.
|
||||||
If the layer already exists, updates its properties; otherwise creates it.
|
If the layer already exists, updates its properties; otherwise creates it.
|
||||||
|
Stores as (LAYER-NAME . PROPERTIES) for backward compatibility with reactive layers.
|
||||||
This is an internal function used by layer definition macros and reactive updates."
|
This is an internal function used by layer definition macros and reactive updates."
|
||||||
(if (assoc layer-name tp-layer-alist)
|
(if (assoc layer-name tp-layer-alist)
|
||||||
(setf (cdr (assoc layer-name tp-layer-alist)) properties)
|
(setf (cdr (assoc layer-name tp-layer-alist)) properties)
|
||||||
@ -2424,26 +2420,58 @@ This is an internal function used by group definition macros."
|
|||||||
|
|
||||||
(defun tp-layer-props (layer-name)
|
(defun tp-layer-props (layer-name)
|
||||||
"Return properties for layer LAYER-NAME from `tp-layer-alist'.
|
"Return properties for layer LAYER-NAME from `tp-layer-alist'.
|
||||||
Appends 'tp-name property to identify the layer."
|
Appends 'tp-name property to identify the layer.
|
||||||
(when-let ((plist (cdr (assoc layer-name tp-layer-alist))))
|
Handles two storage formats:
|
||||||
(append plist (list 'tp-name layer-name))))
|
1. Old format (from tp--set-layer-props): (LAYER-NAME . PLIST) - flat plist
|
||||||
|
2. Unified format (from define-tp): (LAYER-NAME ARGLIST BODY-FORM)
|
||||||
|
For parameterized layers (ARGLIST non-nil), returns nil - use `tp-layer-props-with-arg'."
|
||||||
|
(when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
|
||||||
|
(cond
|
||||||
|
;; Unified format: entry is (ARGLIST BODY-FORM) where first elem is nil or a list
|
||||||
|
;; Check: exactly 2 elements and first is nil or a list of symbols
|
||||||
|
((and (= (length entry) 2)
|
||||||
|
(or (null (car entry))
|
||||||
|
(and (listp (car entry))
|
||||||
|
(cl-every #'symbolp (car entry)))))
|
||||||
|
(let ((arglist (car entry))
|
||||||
|
(body (cadr entry)))
|
||||||
|
(if arglist
|
||||||
|
;; Parameterized - needs argument, return nil
|
||||||
|
nil
|
||||||
|
;; Non-parameterized - evaluate body and return props
|
||||||
|
(let ((plist (eval body)))
|
||||||
|
(when plist
|
||||||
|
(append plist (list 'tp-name layer-name)))))))
|
||||||
|
;; Old format: entry is just a flat plist
|
||||||
|
(t
|
||||||
|
(append entry (list 'tp-name layer-name))))))
|
||||||
|
|
||||||
(defun tp-layer-parameterized-p (layer-name)
|
(defun tp-layer-parameterized-p (layer-name)
|
||||||
"Return non-nil if LAYER-NAME is a parameterized layer."
|
"Return non-nil if LAYER-NAME is a parameterized layer.
|
||||||
(assoc layer-name tp-layer-params))
|
Parameterized layers are stored in unified format (LAYER-NAME ARGLIST BODY-FORM)
|
||||||
|
where ARGLIST is a non-nil list of argument symbols."
|
||||||
|
(when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
|
||||||
|
;; Unified format: entry is (ARGLIST BODY-FORM) with exactly 2 elements
|
||||||
|
;; and first element is a non-nil list of symbols
|
||||||
|
(and (= (length entry) 2)
|
||||||
|
(listp (car entry))
|
||||||
|
(not (null (car entry)))
|
||||||
|
(cl-every #'symbolp (car entry)))))
|
||||||
|
|
||||||
(defun tp-layer-props-with-arg (layer-name arg)
|
(defun tp-layer-props-with-arg (layer-name arg)
|
||||||
"Return properties for parameterized layer LAYER-NAME with ARG.
|
"Return properties for parameterized layer LAYER-NAME with ARG.
|
||||||
Evaluates the body form with the argument bound to the parameter.
|
Evaluates the body form with the argument bound to the parameter.
|
||||||
Appends 'tp-name property to identify the layer."
|
Appends 'tp-name property to identify the layer."
|
||||||
(when-let ((param-info (cdr (assoc layer-name tp-layer-params))))
|
(when-let ((entry (cdr (assoc layer-name tp-layer-alist))))
|
||||||
(let* ((arglist (car param-info))
|
;; entry is (ARGLIST BODY-FORM)
|
||||||
(body (cdr param-info))
|
(let ((arglist (car entry))
|
||||||
(arg-sym (car arglist))
|
(body (cadr entry)))
|
||||||
;; Evaluate the body with the argument bound
|
(when arglist ; Only for parameterized layers
|
||||||
(plist (eval `(let ((,arg-sym ',arg)) ,body))))
|
(let* ((arg-sym (car arglist))
|
||||||
(when plist
|
;; Evaluate the body with the argument bound
|
||||||
(append plist (list 'tp-name layer-name))))))
|
(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."
|
||||||
@ -2456,7 +2484,6 @@ Appends 'tp-name property to identify the layer."
|
|||||||
"Return non-nil if SYM is a defined layer, parameterized layer, or group name."
|
"Return non-nil if SYM is a defined layer, parameterized layer, or group name."
|
||||||
(and (symbolp sym)
|
(and (symbolp sym)
|
||||||
(or (assoc sym tp-layer-alist)
|
(or (assoc sym tp-layer-alist)
|
||||||
(assoc sym tp-layer-params)
|
|
||||||
(assoc sym tp-layer-groups))))
|
(assoc sym tp-layer-groups))))
|
||||||
|
|
||||||
(defun tp--expand-layer-in-plist (props)
|
(defun tp--expand-layer-in-plist (props)
|
||||||
@ -2620,20 +2647,18 @@ 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' and `tp-layer-params'.
|
Clears both `tp-layer-alist' and `tp-layer-groups'.
|
||||||
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'."
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user