From 68e0dd06764bcaade784cb40d39c16181fcb2190 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sat, 29 Aug 2026 01:02:49 +0800 Subject: [PATCH] feat: forward Host attrs through Components --- docs/proposals/component-definition.zh.md | 45 ++++- etaf-renderer.el | 37 ++-- etaf-runtime.el | 55 +++--- etaf-view.el | 208 ++++++++++++++++++++-- tests/etaf-component-frontends-tests.el | 122 +++++++++++++ 5 files changed, 394 insertions(+), 73 deletions(-) diff --git a/docs/proposals/component-definition.zh.md b/docs/proposals/component-definition.zh.md index d835351..bbd1ed7 100644 --- a/docs/proposals/component-definition.zh.md +++ b/docs/proposals/component-definition.zh.md @@ -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； diff --git a/etaf-renderer.el b/etaf-renderer.el index 7d5d840..e6717df 100644 --- a/etaf-renderer.el +++ b/etaf-renderer.el @@ -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) diff --git a/etaf-runtime.el b/etaf-runtime.el index b101831..fc9ff0f 100644 --- a/etaf-runtime.el +++ b/etaf-runtime.el @@ -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) diff --git a/etaf-view.el b/etaf-view.el index cbb35e3..1025ef2 100644 --- a/etaf-view.el +++ b/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))))) diff --git a/tests/etaf-component-frontends-tests.el b/tests/etaf-component-frontends-tests.el index 2114194..46b09d9 100644 --- a/tests/etaf-component-frontends-tests.el +++ b/tests/etaf-component-frontends-tests.el @@ -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