feat: forward Host attrs through Components
This commit is contained in:
Kinneyzhang
parent
7e8700113f
commit
68e0dd0676
@ -433,12 +433,13 @@ index key。
|
||||
- 声明只接受普通 symbol；
|
||||
- 每个 prop 对应同名 keyword，例如 `user` 对应 `:user`；
|
||||
- 未传 prop 的值为 nil；
|
||||
- 未声明 prop、重复 prop、奇数 plist 在调用边界报错；
|
||||
- 未声明为业务 prop、也不属于统一 Host schema 的名称在调用边界报错；
|
||||
- 重复 prop、重复 canonical Host property domain、奇数 plist 在调用边界报错；
|
||||
- props 在一次 render 中是只读 snapshot；
|
||||
- prop 更新不重新运行 setup，只触发依赖它的 render/patch；
|
||||
- `:key` 和 directive 不会进入 Component 业务 props；
|
||||
- Host 的 `:ref`、`:class`、`:id`、`:on-*`、`:use` 由 Host schema 解释；Component
|
||||
只有显式声明同名 prop 时才接收对应 keyword，不做隐式 forwarding；
|
||||
- Component 显式声明的同名属性优先归入业务 props；其他合法 Ebox style/layout 属性
|
||||
与 ETAF Host metadata 归入独立 attrs，并只透传到单一根 Host；
|
||||
- 第一版不增加另一套 required/default/type schema。需要校验时在 setup 或普通 helper
|
||||
中显式完成，后续只有真实重复证据才能扩展 prop declaration。
|
||||
|
||||
@ -453,12 +454,40 @@ index key。
|
||||
| --- | --- | --- | --- | --- |
|
||||
| `:if/:else-if/:else/:for` | DSL directive | DSL directive | DSL directive | 全部拒绝 |
|
||||
| `:key` | framework identity | framework identity | framework identity | 同一 identity 规则 |
|
||||
| Host schema property/metadata | 按 Host schema | 只有显式 prop 同名时才是业务 prop | 拒绝 | 按实际 TAG kind |
|
||||
| Host schema property/metadata | 按 Host schema | 显式同名 prop 消费，否则进入 root attrs | 拒绝 | 按实际 TAG kind |
|
||||
| declared Component prop | 不适用 | 接受 | 拒绝 | 按实际 TAG kind |
|
||||
|
||||
Component prop declaration 禁止 `key`、`if`、`else-if`、`else`、`for`。
|
||||
directive 在业务 prop 验证前剥离；`:key` 在 Component 调用前剥离。除此之外不按
|
||||
keyword 名称猜测 forwarding。
|
||||
directive 在业务 prop 验证前剥离；`:key` 单独进入 framework identity。剩余输入
|
||||
只通过统一 Ebox/ETAF Host schema 判定 attrs，不能由组件库复制属性白名单。
|
||||
|
||||
### 7.2 单根 Host attrs 透传
|
||||
|
||||
Component 调用输入规范化为四个互不重叠的域：
|
||||
|
||||
```text
|
||||
declared props | Host attrs | :key | slots
|
||||
```
|
||||
|
||||
attrs 遵守下面的不变量：
|
||||
|
||||
- 单一根 Host：attrs 应用到该 Host；
|
||||
- 单一根 Component：attrs 沿根 Component 链继续传递；若下游显式声明同名 prop，
|
||||
则由下游消费；
|
||||
- string 根：先规范化为 Text，再应用 attrs；
|
||||
- nil、slot projection 或 Fragment/多根结果：存在 attrs 时精确报错，不能猜目标；
|
||||
- `class` 合并并去重；
|
||||
- Ebox style/layout attrs 先按 canonical property domain 去重，调用方值覆盖组件视觉
|
||||
默认值；
|
||||
- `role`、`ref`、`disabled`、`:on-*` 等 Runtime metadata 若与根 Host 已有值冲突，
|
||||
精确报错；需要由 Component 管理的 metadata 应声明为业务 prop；
|
||||
- attrs 在调用方 Component 环境中求值，不能泄漏到被调用 Component 的 setup、
|
||||
`etaf-state` 或业务 props；
|
||||
- 实际根 Host 仍通过 `ebox-style-property-accepted-p` 验证适用域，例如 Text 根不能
|
||||
接收 Box padding。
|
||||
|
||||
这条规则对应前端的 single-root fallthrough attribute，但 ETAF 只接受已注册的
|
||||
Host schema 名称；任意未知 keyword 仍然是错误。
|
||||
|
||||
所有 Host、Component、Fragment、DSL `:for` item 与 `etaf-node` 使用同一 key
|
||||
契约：key 必须是非 nil symbol、integer 或 string；string 在 author boundary
|
||||
@ -1000,6 +1029,7 @@ grammar，也不要求 IR 保存 frontend provenance。
|
||||
| `(expr :value FORM)` | 当前实现 | 删除；只保留 `(expr FORM)` 文本插值。 |
|
||||
| `:if/:else-if/:else/:for` | 未实现 | 由 compiler lowering，Runtime 不接收 directive。 |
|
||||
| Component alias | 当前会参考 `fboundp` 自动生成 | 删除 load-order-dependent alias；只用准确 registry name。 |
|
||||
| 单根 Host attrs | 已实现最小纵向切片 | 继续迁移 etaf-ui，删除重复视觉 props 声明。 |
|
||||
| Host | 当前已有 text/box/fragment/row/column/flex/grid | 保持最小闭集。 |
|
||||
| props/slots/styles/reactivity/lifecycle | 已有主体能力 | 迁移到共同 ComponentDefinition，不复制实现。 |
|
||||
|
||||
@ -1020,7 +1050,8 @@ grammar，也不要求 IR 保存 frontend provenance。
|
||||
1. definition parser 精确拒绝混写、未知 clause、重复/保留 prop；
|
||||
2. DSL 与代码模式生成同一版本 typed View IR；
|
||||
3. 同名 Elisp function/variable 的新增、删除和加载顺序不改变 tag 语义；
|
||||
4. props、default/named slot、styles、Context、Theme、events、Behavior 全部等价；
|
||||
4. props、single-root attrs、default/named slot、styles、Context、Theme、events、Behavior
|
||||
全部等价；多根 attrs 精确拒绝；
|
||||
5. setup-once、prop update、mounted/updated/unmounted、Scope cleanup 等价；
|
||||
6. branch 与 keyed list 的 insert/delete/reorder 保留正确 identity；
|
||||
7. injected failure 完整恢复 generation、文本、文本属性、Range 与 lifecycle；
|
||||
|
||||
@ -53,21 +53,6 @@
|
||||
|
||||
(define-error 'etaf-renderer-error "ETAF rendering error")
|
||||
|
||||
(defconst etaf--semantic-props
|
||||
'(:class :id :role :disabled :tab-index :ref :use)
|
||||
"ETAF semantic properties that are not Ebox box properties.")
|
||||
|
||||
(defun etaf--aria-property-p (property)
|
||||
"Return non-nil when PROPERTY is in the ETAF aria namespace."
|
||||
(and (keywordp property)
|
||||
(string-prefix-p ":aria-" (symbol-name property))))
|
||||
|
||||
(defun etaf--semantic-property-p (property)
|
||||
"Return non-nil when PROPERTY belongs to ETAF Runtime metadata."
|
||||
(or (memq property etaf--semantic-props)
|
||||
(etaf--aria-property-p property)
|
||||
(etaf--event-property-p property)))
|
||||
|
||||
(defun etaf--behavior-source-p (value)
|
||||
"Return non-nil when VALUE has the public `:use' source grammar."
|
||||
(or (null value)
|
||||
@ -153,11 +138,6 @@
|
||||
nodes
|
||||
(ebox-tree-source-builder-snapshot etaf--ebox-source-builder nodes)))
|
||||
|
||||
(defun etaf--event-property-p (property)
|
||||
"Return non-nil when PROPERTY is an ETAF event callback property."
|
||||
(and (keywordp property)
|
||||
(string-prefix-p "on-" (substring (symbol-name property) 1))))
|
||||
|
||||
(defun etaf--generated-host-ref (props path &optional site-token)
|
||||
"Return PROPS' explicit Host reference or one generated for PATH.
|
||||
SITE-TOKEN replaces PATH as the generated call-site identity when non-nil."
|
||||
@ -612,12 +592,15 @@ multi-root forest; a single material root is returned unchanged."
|
||||
(defun etaf--render-component-call-pure (call path)
|
||||
"Render stateless CALL at PATH without a retained Runtime."
|
||||
(let* ((spec (etaf--component-call-spec call))
|
||||
(render (etaf--component-spec-render spec)))
|
||||
(render (etaf--component-spec-render spec))
|
||||
(props (etaf--resolve-property-plist
|
||||
(etaf--component-business-props call)))
|
||||
(attrs (etaf--resolve-property-plist
|
||||
(etaf--component-call-attrs call))))
|
||||
(when (etaf--component-spec-setup spec)
|
||||
(signal 'etaf-renderer-error
|
||||
(list "Stateful Component requires `etaf-mount'")))
|
||||
(let ((etaf--current-component-props
|
||||
(etaf--component-call-props call))
|
||||
(let ((etaf--current-component-props props)
|
||||
(etaf--current-component-slots
|
||||
(etaf--component-call-slots call))
|
||||
(etaf--component-phase 'render))
|
||||
@ -627,9 +610,11 @@ multi-root forest; a single material root is returned unchanged."
|
||||
(append path (list :component
|
||||
(etaf--component-spec-name spec)))))))
|
||||
(etaf--render-value-list
|
||||
(funcall render
|
||||
(etaf--component-call-props call)
|
||||
(etaf--component-call-slots call))
|
||||
(etaf--apply-component-attrs
|
||||
(etaf--validate-component-render-result
|
||||
(funcall render props (etaf--component-call-slots call))
|
||||
(etaf--component-spec-name spec))
|
||||
attrs (etaf--component-spec-name spec))
|
||||
(append path (list :component (etaf--component-spec-name spec))))))))
|
||||
|
||||
(defun etaf--render-value-list (value path)
|
||||
|
||||
@ -68,8 +68,8 @@
|
||||
|
||||
(cl-defstruct (etaf--semantic-component
|
||||
(:constructor etaf--semantic-component-create))
|
||||
semantic-id identity input-effect-id effect-id resource-key props slots
|
||||
input-props input-slots output-signature artifact-key
|
||||
semantic-id identity input-effect-id effect-id resource-key props attrs slots
|
||||
input-props input-attrs input-slots output-signature artifact-key
|
||||
path caller-style-stack input-deps deps
|
||||
parent-id caller-component-id child-ids raw-slot-reader-p
|
||||
publication-kind output-range-id
|
||||
@ -978,6 +978,7 @@ transaction from deciding whether the value changed."
|
||||
((etaf--semantic-component-p semantic)
|
||||
(list (etaf--semantic-component-composition-version semantic)
|
||||
(etaf--semantic-component-input-props semantic)
|
||||
(etaf--semantic-component-input-attrs semantic)
|
||||
(etaf--semantic-component-input-slots semantic)
|
||||
(etaf--semantic-component-context-deps semantic)
|
||||
(etaf--semantic-component-output-signature semantic)))
|
||||
@ -1378,12 +1379,14 @@ reading Runtime storage fields."
|
||||
(or (when-let* ((env (gethash component-id
|
||||
(etaf-runtime-candidate-component-envs runtime))))
|
||||
(list (copy-tree (plist-get env :props))
|
||||
(copy-tree (plist-get env :attrs))
|
||||
(copy-tree (plist-get env :slots))))
|
||||
(when-let* ((generation (etaf-runtime-current-generation runtime))
|
||||
(component
|
||||
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
|
||||
component-id)))
|
||||
(list (copy-tree (etaf--semantic-component-props component))
|
||||
(copy-tree (etaf--semantic-component-attrs component))
|
||||
(copy-tree (etaf--semantic-component-slots component)))))))
|
||||
|
||||
(defun etaf--context-frame-changed-keys (old new)
|
||||
@ -1853,17 +1856,6 @@ need to know how Behavior attributes are merged."
|
||||
(append (butlast path) (list :key key))
|
||||
path)))
|
||||
|
||||
(defun etaf--runtime-component-business-props (call)
|
||||
"Return CALL props without framework-owned identity metadata."
|
||||
(let ((tail (etaf--component-call-props call))
|
||||
result)
|
||||
(while tail
|
||||
(let ((key (pop tail))
|
||||
(value (pop tail)))
|
||||
(unless (eq key :key)
|
||||
(setq result (append result (list key value))))))
|
||||
result))
|
||||
|
||||
(defun etaf--runtime-owned-slots (slots)
|
||||
"Attach current caller ownership to unowned normalized SLOTS."
|
||||
(mapcar
|
||||
@ -1935,7 +1927,7 @@ need to know how Behavior attributes are merged."
|
||||
(funcall hook)))
|
||||
|
||||
(defun etaf--runtime-render-component-resource
|
||||
(runtime instance identity props slots path
|
||||
(runtime instance identity props attrs slots path
|
||||
&optional old-output-range-id old-publication-kind old-context-frame)
|
||||
"Render RUNTIME candidate IDENTITY from resource INSTANCE without mutation."
|
||||
(let* ((spec (etaf--component-instance-spec instance))
|
||||
@ -1992,6 +1984,9 @@ need to know how Behavior attributes are merged."
|
||||
(etaf--validate-component-render-result
|
||||
(funcall render-function props slots)
|
||||
(etaf--component-spec-name spec)))
|
||||
(rendered
|
||||
(etaf--apply-component-attrs
|
||||
rendered attrs (etaf--component-spec-name spec)))
|
||||
(transparent-p
|
||||
(and (not (eq old-publication-kind 'material))
|
||||
(etaf--runtime-transparent-output-p rendered)))
|
||||
@ -2258,8 +2253,9 @@ need to know how Behavior attributes are merged."
|
||||
(cl-incf (etaf-runtime-next-effect-id runtime))))
|
||||
(semantic-id (or (and old (etaf--semantic-component-semantic-id old))
|
||||
(cl-incf (etaf-runtime-next-semantic-id runtime))))
|
||||
(input-props (etaf--runtime-component-business-props call))
|
||||
props input-deps render-deps context-deps slot-retargeted-p)
|
||||
(input-props (etaf--component-business-props call))
|
||||
(input-attrs (etaf--component-call-attrs call))
|
||||
props attrs input-deps render-deps context-deps slot-retargeted-p)
|
||||
(unless (etaf-context-owner-id (etaf--component-instance-context instance))
|
||||
(setf (etaf-context-owner-id (etaf--component-instance-context instance))
|
||||
semantic-id))
|
||||
@ -2271,10 +2267,11 @@ need to know how Behavior attributes are merged."
|
||||
(lambda (source) (cl-pushnew source input-deps :test #'eq)))
|
||||
(etaf--active-effect nil)
|
||||
(etaf--render-phase-p t))
|
||||
(setq props
|
||||
(etaf--resolve-property-plist input-props)))
|
||||
(setq props (etaf--resolve-property-plist input-props)
|
||||
attrs (etaf--resolve-property-plist input-attrs)))
|
||||
(puthash semantic-id
|
||||
(list :identity identity :instance instance :props props :slots slots)
|
||||
(list :identity identity :instance instance
|
||||
:props props :attrs attrs :slots slots)
|
||||
(etaf-runtime-candidate-component-envs runtime))
|
||||
(when (and old
|
||||
(or etaf--rendering-component-effect-p
|
||||
@ -2292,6 +2289,8 @@ need to know how Behavior attributes are merged."
|
||||
(not slot-retargeted-p))
|
||||
(not (equal-including-properties
|
||||
props (etaf--semantic-component-props old)))
|
||||
(not (equal-including-properties
|
||||
attrs (etaf--semantic-component-attrs old)))
|
||||
(and (not slot-retargeted-p)
|
||||
(not (equal-including-properties
|
||||
slots (etaf--semantic-component-slots old))))))
|
||||
@ -2357,7 +2356,7 @@ need to know how Behavior attributes are merged."
|
||||
(etaf--render-phase-p t))
|
||||
(setq result
|
||||
(etaf--runtime-render-component-resource
|
||||
runtime instance identity props slots path
|
||||
runtime instance identity props attrs slots path
|
||||
(and old (etaf--semantic-component-output-range-id old))
|
||||
(and old (etaf--semantic-component-publication-kind old))
|
||||
(and old (etaf--semantic-component-context-frame old)))))
|
||||
@ -2389,8 +2388,10 @@ need to know how Behavior attributes are merged."
|
||||
:input-effect-id input-effect-id :effect-id effect-id
|
||||
:resource-key
|
||||
(copy-tree (etaf--component-instance-resource-key instance))
|
||||
:props (copy-tree props) :slots (copy-tree slots)
|
||||
:props (copy-tree props) :attrs (copy-tree attrs)
|
||||
:slots (copy-tree slots)
|
||||
:input-props (copy-tree input-props)
|
||||
:input-attrs (copy-tree input-attrs)
|
||||
:input-slots (copy-tree slots)
|
||||
:output-signature (copy-tree output-signature)
|
||||
:artifact-key (and (not transparent-p) effect-id)
|
||||
@ -4139,10 +4140,13 @@ removed inside the same rollback journal."
|
||||
(etaf--render-phase-p t))
|
||||
(let* ((props (etaf--resolve-property-plist
|
||||
(etaf--semantic-component-input-props semantic)))
|
||||
(attrs (etaf--resolve-property-plist
|
||||
(etaf--semantic-component-input-attrs semantic)))
|
||||
(slots (etaf--semantic-component-input-slots semantic))
|
||||
(candidate (copy-sequence semantic))
|
||||
(effect-id (etaf--semantic-component-input-effect-id semantic)))
|
||||
(setf (etaf--semantic-component-props candidate) (copy-tree props)
|
||||
(etaf--semantic-component-attrs candidate) (copy-tree attrs)
|
||||
(etaf--semantic-component-slots candidate) (copy-tree slots)
|
||||
(etaf--semantic-component-input-deps candidate) (nreverse deps))
|
||||
(puthash (etaf--semantic-component-identity semantic) candidate
|
||||
@ -4155,6 +4159,8 @@ removed inside the same rollback journal."
|
||||
(etaf-runtime-candidate-effects runtime))
|
||||
(unless (and (etaf--runtime-target-value-equal-p
|
||||
props (etaf--semantic-component-props semantic))
|
||||
(etaf--runtime-target-value-equal-p
|
||||
attrs (etaf--semantic-component-attrs semantic))
|
||||
(etaf--runtime-target-value-equal-p
|
||||
slots (etaf--semantic-component-slots semantic)))
|
||||
(etaf--runtime-enqueue-effect
|
||||
@ -4344,11 +4350,13 @@ removed inside the same rollback journal."
|
||||
(parent (and (etaf--semantic-component-p parent-record)
|
||||
(etaf--semantic-component-identity parent-record)))
|
||||
(props (etaf--semantic-component-props semantic))
|
||||
(attrs (etaf--semantic-component-attrs semantic))
|
||||
(slots (etaf--semantic-component-slots semantic))
|
||||
(builder (ebox-source-builder-create))
|
||||
deps context-deps result)
|
||||
(puthash (etaf--semantic-component-semantic-id semantic)
|
||||
(list :identity identity :instance instance :props props :slots slots)
|
||||
(list :identity identity :instance instance
|
||||
:props props :attrs attrs :slots slots)
|
||||
(etaf-runtime-candidate-component-envs runtime))
|
||||
(let ((etaf--current-component-identity parent)
|
||||
(etaf--current-component-semantic-id
|
||||
@ -4371,7 +4379,7 @@ removed inside the same rollback journal."
|
||||
(setq result
|
||||
(etaf--runtime-render-component-resource
|
||||
runtime instance identity
|
||||
props slots
|
||||
props attrs slots
|
||||
(etaf--semantic-component-path semantic)
|
||||
(etaf--semantic-component-output-range-id committed)
|
||||
(etaf--semantic-component-publication-kind committed)
|
||||
@ -4418,6 +4426,7 @@ removed inside the same rollback journal."
|
||||
(setf (etaf--semantic-component-output-signature candidate)
|
||||
(copy-tree output-signature)
|
||||
(etaf--semantic-component-props candidate) (copy-tree props)
|
||||
(etaf--semantic-component-attrs candidate) (copy-tree attrs)
|
||||
(etaf--semantic-component-slots candidate) (copy-tree slots)
|
||||
(etaf--semantic-component-deps candidate) (nreverse deps)
|
||||
(etaf--semantic-component-raw-slot-reader-p candidate)
|
||||
|
||||
208
etaf-view.el
208
etaf-view.el
@ -12,6 +12,7 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'ebox-style)
|
||||
|
||||
(define-error 'etaf-view-error "Invalid ETAF View")
|
||||
(define-error 'etaf-view-syntax-error "Invalid ETAF View syntax"
|
||||
@ -51,6 +52,7 @@
|
||||
"Internal Component invocation retained until rendering."
|
||||
spec
|
||||
props
|
||||
attrs
|
||||
slots)
|
||||
|
||||
(cl-defstruct (etaf--slot-input
|
||||
@ -79,6 +81,31 @@ this list merely to make a demo convenient.")
|
||||
(defconst etaf--directive-properties '(:if :else-if :else :for)
|
||||
"Compiler-owned DSL properties rejected by ordinary node construction.")
|
||||
|
||||
(defconst etaf--semantic-props
|
||||
'(:class :id :role :disabled :tab-index :ref :use)
|
||||
"ETAF Host metadata outside the Ebox style schema.")
|
||||
|
||||
(defun etaf--aria-property-p (property)
|
||||
"Return non-nil when PROPERTY is in the ETAF aria namespace."
|
||||
(and (keywordp property)
|
||||
(string-prefix-p ":aria-" (symbol-name property))))
|
||||
|
||||
(defun etaf--event-property-p (property)
|
||||
"Return non-nil when PROPERTY is an ETAF event callback property."
|
||||
(and (keywordp property)
|
||||
(string-prefix-p ":on-" (symbol-name property))))
|
||||
|
||||
(defun etaf--semantic-property-p (property)
|
||||
"Return non-nil when PROPERTY belongs to ETAF Runtime metadata."
|
||||
(or (memq property etaf--semantic-props)
|
||||
(etaf--aria-property-p property)
|
||||
(etaf--event-property-p property)))
|
||||
|
||||
(defun etaf--host-attribute-p (property)
|
||||
"Return non-nil when PROPERTY belongs to the shared Host attribute domain."
|
||||
(or (ebox-style-schema-id property)
|
||||
(etaf--semantic-property-p property)))
|
||||
|
||||
(defconst etaf--ordinary-elisp-heads
|
||||
'(and or not if when unless cond case pcase
|
||||
let let* letrec letrec* prog prog1 prog2 progn
|
||||
@ -187,6 +214,132 @@ disposing the old Runtime.")
|
||||
(push (etaf--resolve-property-value (pop tail)) copy))
|
||||
(nreverse copy)))
|
||||
|
||||
(defun etaf--property-domain-key (property)
|
||||
"Return PROPERTY's canonical Host-domain key."
|
||||
(or (ebox-style-canonical-name property) property))
|
||||
|
||||
(defun etaf--plist-set (props key value)
|
||||
"Return PROPS with KEY set to VALUE while preserving source order."
|
||||
(if (plist-member props key)
|
||||
(let ((copy (copy-sequence props)))
|
||||
(plist-put copy key value)
|
||||
copy)
|
||||
(append props (list key value))))
|
||||
|
||||
(defun etaf--plist-remove-domain (props property)
|
||||
"Return PROPS without any alias in PROPERTY's canonical domain."
|
||||
(let ((domain (etaf--property-domain-key property)))
|
||||
(cl-loop for (key value) on props by #'cddr
|
||||
unless (eq (etaf--property-domain-key key) domain)
|
||||
append (list key value))))
|
||||
|
||||
(defun etaf--class-tokens (value)
|
||||
"Return normalized class tokens from resolved VALUE."
|
||||
(cond
|
||||
((null value) nil)
|
||||
((stringp value) (split-string value "[[:space:]]+" t))
|
||||
((symbolp value) (list (symbol-name value)))
|
||||
((proper-list-p value)
|
||||
(cl-mapcan #'etaf--class-tokens value))
|
||||
(t
|
||||
(etaf--component-error "Invalid class value: %S" value))))
|
||||
|
||||
(defun etaf--merge-class-values (root-value caller-value)
|
||||
"Return stable union of ROOT-VALUE and CALLER-VALUE class tokens."
|
||||
(let (seen result)
|
||||
(dolist (token (append (etaf--class-tokens root-value)
|
||||
(etaf--class-tokens caller-value)))
|
||||
(unless (member token seen)
|
||||
(push token seen)
|
||||
(push token result)))
|
||||
(nreverse result)))
|
||||
|
||||
(defun etaf--merge-class-input (root-value caller-value)
|
||||
"Return a class value merging possibly lazy ROOT-VALUE and CALLER-VALUE."
|
||||
(etaf--merge-class-values
|
||||
(etaf--resolve-property-value root-value)
|
||||
(etaf--resolve-property-value caller-value)))
|
||||
|
||||
(defun etaf--merge-host-attrs (props attrs &optional tag component-name)
|
||||
"Merge caller ATTRS into root Host PROPS for TAG.
|
||||
Visual Ebox attributes override Component defaults. Class tokens merge.
|
||||
Conflicting Runtime metadata is rejected so fallthrough cannot silently alter
|
||||
Component semantics. COMPONENT-NAME labels diagnostics."
|
||||
(let ((result (copy-sequence props))
|
||||
(tail attrs))
|
||||
(while tail
|
||||
(let* ((key (pop tail))
|
||||
(value (pop tail))
|
||||
(style-p (not (null (ebox-style-schema-id key)))))
|
||||
(when (and tag style-p
|
||||
(not (ebox-style-property-accepted-p tag key)))
|
||||
(etaf--component-error
|
||||
"Component %S root Host %S rejects attribute %S"
|
||||
component-name tag key))
|
||||
(cond
|
||||
((eq key :class)
|
||||
(setq result
|
||||
(etaf--plist-set
|
||||
result :class
|
||||
(etaf--merge-class-input (plist-get result :class) value))))
|
||||
(style-p
|
||||
(setq result
|
||||
(append (etaf--plist-remove-domain result key)
|
||||
(list key value))))
|
||||
((plist-member result key)
|
||||
(etaf--component-error
|
||||
"Component %S root metadata %S conflicts with fallthrough"
|
||||
component-name key))
|
||||
(t
|
||||
(setq result (append result (list key value)))))))
|
||||
result))
|
||||
|
||||
(defun etaf--forward-component-attrs (call attrs component-name)
|
||||
"Return copied root Component CALL receiving caller ATTRS."
|
||||
(let* ((copy (copy-sequence call))
|
||||
(spec (etaf--component-call-spec call))
|
||||
(declared (mapcar #'etaf--component-prop-key
|
||||
(etaf--component-spec-props spec)))
|
||||
(props (copy-sequence (etaf--component-call-props call)))
|
||||
(forwarded (copy-sequence (etaf--component-call-attrs call)))
|
||||
(tail attrs))
|
||||
(while tail
|
||||
(let ((key (pop tail))
|
||||
(value (pop tail)))
|
||||
(if (memq key declared)
|
||||
(setq props (etaf--plist-set props key value))
|
||||
(setq forwarded
|
||||
(etaf--merge-host-attrs
|
||||
forwarded (list key value) nil component-name)))))
|
||||
(setf (etaf--component-call-props copy) props
|
||||
(etaf--component-call-attrs copy) forwarded)
|
||||
copy))
|
||||
|
||||
(defun etaf--apply-component-attrs (value attrs component-name)
|
||||
"Apply resolved fallthrough ATTRS to COMPONENT-NAME root VALUE."
|
||||
(if (null attrs)
|
||||
value
|
||||
(cond
|
||||
((stringp value)
|
||||
(etaf--view-node-create
|
||||
:name 'text :props (copy-sequence attrs) :children (list value)))
|
||||
((etaf--view-node-p value)
|
||||
(when (eq (etaf--view-node-name value) 'fragment)
|
||||
(etaf--component-error
|
||||
"Component %S has multiple roots; Host attrs have no target"
|
||||
component-name))
|
||||
(let ((copy (copy-sequence value)))
|
||||
(setf (etaf--view-node-props copy)
|
||||
(etaf--merge-host-attrs
|
||||
(etaf--view-node-props value) attrs
|
||||
(etaf--view-node-name value) component-name))
|
||||
copy))
|
||||
((etaf--component-call-p value)
|
||||
(etaf--forward-component-attrs value attrs component-name))
|
||||
(t
|
||||
(etaf--component-error
|
||||
"Component %S cannot apply Host attrs to %S" component-name value)))))
|
||||
|
||||
(defun etaf--compile-property-value (form)
|
||||
"Compile property FORM as a constant or a render-time thunk."
|
||||
(if (or (null form) (numberp form) (stringp form) (characterp form)
|
||||
@ -605,20 +758,39 @@ ordinary Elisp expressions. `(expr FORM)' is text interpolation only."
|
||||
name
|
||||
(etaf--keyword-for-name name)))
|
||||
|
||||
(defun etaf--validate-component-props (spec props)
|
||||
"Validate Component SPEC against evaluated property PLIST PROPS."
|
||||
(let ((allowed (append '(:key)
|
||||
(mapcar #'etaf--component-prop-key
|
||||
(etaf--component-spec-props spec))))
|
||||
(tail (etaf--validate-property-plist props)))
|
||||
(defun etaf--partition-component-input (spec props)
|
||||
"Partition SPEC input PROPS into business props and Host attrs.
|
||||
Return `(BUSINESS ATTRS)'. `:key' remains framework-owned input metadata."
|
||||
(let ((declared (mapcar #'etaf--component-prop-key
|
||||
(etaf--component-spec-props spec)))
|
||||
(tail (etaf--validate-property-plist props))
|
||||
(attr-domains (make-hash-table :test #'eq))
|
||||
business
|
||||
attrs)
|
||||
(while tail
|
||||
(let ((key (pop tail)))
|
||||
(pop tail)
|
||||
(unless (memq key allowed)
|
||||
(let ((key (pop tail))
|
||||
(value (pop tail)))
|
||||
(cond
|
||||
((or (eq key :key) (memq key declared))
|
||||
(setq business (append business (list key value))))
|
||||
((etaf--host-attribute-p key)
|
||||
(let ((domain (etaf--property-domain-key key)))
|
||||
(when (gethash domain attr-domains)
|
||||
(etaf--component-error
|
||||
"Duplicate Component Host attribute domain: %S" key))
|
||||
(puthash domain t attr-domains))
|
||||
(setq attrs (append attrs (list key value))))
|
||||
(t
|
||||
(etaf--component-error
|
||||
"Unknown prop %S for Component %S"
|
||||
key (etaf--component-spec-name spec)))))
|
||||
props))
|
||||
"Unknown prop or Host attribute %S for Component %S"
|
||||
key (etaf--component-spec-name spec))))))
|
||||
(list business attrs)))
|
||||
|
||||
(defun etaf--component-business-props (call)
|
||||
"Return CALL's declared business props without framework `:key'."
|
||||
(cl-loop for (key value) on (etaf--component-call-props call) by #'cddr
|
||||
unless (eq key :key)
|
||||
append (list key value)))
|
||||
|
||||
(defun etaf--typed-view-child-p (value)
|
||||
"Return non-nil when VALUE is one already validated View child."
|
||||
@ -728,14 +900,15 @@ alist from stable slot symbols to typed child lists."
|
||||
(when (plist-member props :key)
|
||||
(etaf--validate-key
|
||||
(etaf--resolve-property-value (plist-get props :key))))
|
||||
(etaf--view-node-create
|
||||
(etaf--view-node-create
|
||||
:name host-name
|
||||
:token token
|
||||
:props props
|
||||
:children children))
|
||||
((etaf--component-spec-p entry)
|
||||
(etaf--validate-component-props entry props)
|
||||
(let (default-children named-slots)
|
||||
(pcase-let* ((`(,business-props ,attrs)
|
||||
(etaf--partition-component-input entry props)))
|
||||
(let (default-children named-slots)
|
||||
(dolist (child children)
|
||||
(if (etaf--slot-input-p child)
|
||||
(progn
|
||||
@ -753,10 +926,11 @@ alist from stable slot symbols to typed child lists."
|
||||
"Component default slot has both children and an explicit input"))
|
||||
(etaf--component-call-create
|
||||
:spec entry
|
||||
:props props
|
||||
:props business-props
|
||||
:attrs attrs
|
||||
:slots (if default-children
|
||||
(cons (cons 'default default-children) named-slots)
|
||||
named-slots))))
|
||||
named-slots)))))
|
||||
(t
|
||||
(etaf--component-error "Unknown ETAF Host or Component: %S" name)))))
|
||||
|
||||
|
||||
@ -133,6 +133,33 @@
|
||||
(styles
|
||||
(".g6b-context-action" :background-color "#1F2937")))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-attr-leaf (&key label)
|
||||
:view
|
||||
(box :class '(leaf base) :color "#111111"
|
||||
(text (expr label))))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-attr-wrapper (&key label)
|
||||
:view
|
||||
(etaf-test-g6b-attr-leaf :label label))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-attr-fragment ()
|
||||
:view
|
||||
(fragment (text "One") (text "Two")))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-attr-text ()
|
||||
:view (text "Text"))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-attr-role ()
|
||||
:view (box :role 'button "Role"))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-attr-shape (&key split)
|
||||
:render
|
||||
(if split
|
||||
(etaf-node 'fragment nil
|
||||
(list (etaf-node 'text nil (list "One"))
|
||||
(etaf-node 'text nil (list "Two"))))
|
||||
(etaf-node 'box nil (list "Stable"))))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-dsl-panel ()
|
||||
:view
|
||||
(column :background-color "#203040" :padding-inline 1
|
||||
@ -565,5 +592,100 @@
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))))
|
||||
|
||||
(ert-deftest etaf-component-host-attrs-fall-through-one-root-chain ()
|
||||
"Undeclared Host attrs cross a root Component chain without entering props."
|
||||
(let ((buffer " *etaf-g6b-attrs*")
|
||||
(color (etaf-ref "#224466")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-view
|
||||
(etaf-test-g6b-attr-wrapper
|
||||
:label "Leaf" :class '(caller base)
|
||||
:color (etaf-value color) :padding-inline 2
|
||||
:ref 'g6b-attr-root))))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer))
|
||||
(instances (hash-table-values
|
||||
(etaf-runtime-instances runtime)))
|
||||
(props (etaf-runtime-host-props-for
|
||||
runtime 'g6b-attr-root)))
|
||||
(should (equal '("leaf" "base" "caller")
|
||||
(plist-get props :class)))
|
||||
(should (equal "#224466" (plist-get props :color)))
|
||||
(should (equal "#224466"
|
||||
(etaf-test-g6b--face-value
|
||||
(etaf-test-g6b--face-at buffer "Leaf")
|
||||
:foreground)))
|
||||
(should (= 2 (plist-get props :padding-inline)))
|
||||
(setf (etaf-value color) "#335577")
|
||||
(setq props (etaf-runtime-host-props-for
|
||||
runtime 'g6b-attr-root))
|
||||
(should (equal "#335577" (plist-get props :color)))
|
||||
(should (equal "#335577"
|
||||
(etaf-test-g6b--face-value
|
||||
(etaf-test-g6b--face-at buffer "Leaf")
|
||||
:foreground)))
|
||||
(should
|
||||
(cl-every
|
||||
(lambda (instance)
|
||||
(memq instance (hash-table-values
|
||||
(etaf-runtime-instances runtime))))
|
||||
instances))))
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))))
|
||||
|
||||
(ert-deftest etaf-component-host-attrs-reject-ambiguous-or-invalid-targets ()
|
||||
"Fallthrough fails closed for unknown, duplicate, conflicting, and multi-root input."
|
||||
(should-error
|
||||
(etaf-node 'etaf-test-g6b-attr-leaf (list :unknown-attr 1) nil)
|
||||
:type 'etaf-component-call-error)
|
||||
(should-error
|
||||
(etaf-node 'etaf-test-g6b-attr-leaf
|
||||
(list :bgcolor "red" :background-color "blue") nil)
|
||||
:type 'etaf-component-call-error)
|
||||
(dolist
|
||||
(entry
|
||||
`((" *etaf-g6b-attrs-fragment*"
|
||||
,(etaf-view (etaf-test-g6b-attr-fragment :color "red")))
|
||||
(" *etaf-g6b-attrs-text*"
|
||||
,(etaf-view (etaf-test-g6b-attr-text :padding 1)))
|
||||
(" *etaf-g6b-attrs-role*"
|
||||
,(etaf-view (etaf-test-g6b-attr-role :role 'navigation)))))
|
||||
(let ((buffer (car entry)))
|
||||
(unwind-protect
|
||||
(should-error (etaf-mount buffer (cadr entry))
|
||||
:type 'etaf-component-call-error)
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live))))))
|
||||
|
||||
(ert-deftest etaf-component-host-attrs-rollback-root-shape-failure ()
|
||||
"A later multi-root result cannot publish or retire the previous root."
|
||||
(let ((buffer " *etaf-g6b-attrs-rollback*")
|
||||
(split (etaf-ref nil)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-view
|
||||
(etaf-test-g6b-attr-shape
|
||||
:split (etaf-value split) :color "#224466"))))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer))
|
||||
(generation (etaf-runtime-current-generation runtime))
|
||||
(published (with-current-buffer buffer (buffer-string))))
|
||||
(should-error (setf (etaf-value split) t)
|
||||
:type 'etaf-component-call-error)
|
||||
(should (eq generation
|
||||
(etaf-runtime-current-generation runtime)))
|
||||
(should (equal-including-properties
|
||||
published (with-current-buffer buffer (buffer-string))))))
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))))
|
||||
|
||||
(provide 'etaf-component-frontends-tests)
|
||||
;;; etaf-component-frontends-tests.el ends here
|
||||
|
||||
Loading…
Reference in New Issue
Block a user