From a0e014563990d9decf7c7b023d812f5c989c5e83 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 24 Aug 2026 02:08:53 +0800 Subject: [PATCH] Add theme palette and reactive data contracts --- Makefile | 4 +- docs/architecture.en.md | 10 +++ docs/architecture.zh.md | 8 +++ docs/user-guide.en.md | 34 ++++++++-- docs/user-guide.zh.md | 30 +++++++-- etaf-component.el | 40 +++++++++++ etaf-context.el | 126 +++++++++++++++++++++++++++++++---- etaf-data.el | 69 +++++++++++++++---- etaf-renderer.el | 5 ++ etaf-runtime.el | 104 ++++++++++++++++++++++------- etaf-theme-tp.el | 59 ++++++++++++++++ etaf-view.el | 13 +++- tests/etaf-data-tests.el | 49 ++++++++++++++ tests/etaf-tests.el | 73 ++++++++++++++++++++ tests/etaf-theme-tp-tests.el | 27 ++++++++ 15 files changed, 589 insertions(+), 62 deletions(-) create mode 100644 etaf-theme-tp.el create mode 100644 tests/etaf-theme-tp-tests.el diff --git a/Makefile b/Makefile index bbe6446..e99f6a0 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ EMACS ?= emacs LOAD_PATH = -L . -L examples -L ../ebox -L ../tp -L ../ecss -SOURCES = etaf-view.el etaf-component.el etaf-reactive.el etaf-context.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf.el +SOURCES = etaf-view.el etaf-component.el etaf-reactive.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf.el EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el -TESTS = tests/etaf-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-examples-tests.el +TESTS = tests/etaf-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el .PHONY: test compile load checkdoc docs-check check clean diff --git a/docs/architecture.en.md b/docs/architecture.en.md index 2750eec..22c3880 100644 --- a/docs/architecture.en.md +++ b/docs/architecture.en.md @@ -344,6 +344,16 @@ Keys are stable ordinary symbols. The nearest ancestor wins; a missing required (lambda () (etaf-view (slot))))) ``` +Palette resolution remains a Theme concern, not a UI catalog concern. Core +provides `etaf-theme-resolve-palette` for explicit light/dark semantic pairs; +the optional `etaf-theme-tp` file is the only bridge allowed to read TP's +renderer-level palette registry. `etaf-ui` consumes `:ui-*` semantic tokens and +does not depend on TP names or private Ebox/TP state. + +When a static Component rule needs one Theme value, use +`etaf-theme-token`; ETAF resolves the deferred token at the style boundary so +the rule remains static for retained Hosts. + Explicit Host props override Component styles, and Component styles override Theme defaults. Style ownership follows the Component that authored each View node. A nested Component is a style boundary: parent rules do not penetrate its internals. Caller-provided slot content is rendered with the caller scope, while a child's own fallback content remains in the child scope. diff --git a/docs/architecture.zh.md b/docs/architecture.zh.md index feff467..42a745a 100644 --- a/docs/architecture.zh.md +++ b/docs/architecture.zh.md @@ -343,6 +343,14 @@ key 使用稳定的普通 symbol。最近的祖先优先，缺失的 required ke (lambda () (etaf-view (slot))))) ``` +Palette 解析属于 Theme，而不是 UI 目录。core 提供 +`etaf-theme-resolve-palette` 来解析显式的亮/暗语义 pair；可选的 +`etaf-theme-tp` 文件是唯一可以读取 TP renderer-level palette registry 的桥接层。 +`etaf-ui` 只消费 `:ui-*` 语义 token，不依赖 TP 名称，也不访问 Ebox/TP 私有状态。 + +静态 Component 规则如果需要读取一个 Theme 值，应使用 `etaf-theme-token`； +ETAF 会在样式边界解析这个延迟 token，使 retained Host 仍然走静态样式路径。 + 显式 Host props 覆盖 Component styles，Component styles 覆盖 Theme defaults。 样式所有权跟随创建每个 View node 的 Component。嵌套 Component 是样式边界：父规则不会穿透其内部。调用者提供的 slot 内容使用 caller scope，子组件自有的 fallback 内容保留在 child scope。 diff --git a/docs/user-guide.en.md b/docs/user-guide.en.md index c498627..173dc8d 100644 --- a/docs/user-guide.en.md +++ b/docs/user-guide.en.md @@ -288,6 +288,18 @@ Theme is a Context convenience, not another runtime object: (lambda () (etaf-view (slot))))) ``` +For a light/dark application palette, keep the semantic roles in one palette +plist and resolve it explicitly with +`(etaf-theme-resolve-palette palette 'light)` or `'dark`. This keeps an app +Theme toggle independent from the Emacs frame. The optional `etaf-theme-tp` +adapter can translate TP palette registry entries into the same ETAF Theme +contract; `etaf-ui` and the core Runtime do not depend on TP palette names. + +Static Component styles can defer one value to the inherited Theme with +`(etaf-theme-token :token-key)`. ETAF resolves that token while lowering the +style scope, so repeated retained Hosts can reuse the static style path rather +than each carrying a dynamic inline property. + ## 8. Events, Actions, Behaviors, and focus One local event uses an `:on-*` property: @@ -441,7 +453,14 @@ The Component emits the next value; the caller owns the ref and supplies the cur (etaf-data-controller source :page-size 10 :auto-load t)) ``` -The controller exposes reactive refs through `etaf-data-items`, `etaf-data-status`, `etaf-data-error`, `etaf-data-total`, `etaf-data-query`, `etaf-data-page`, `etaf-data-page-size`, and `etaf-data-selection`. Use `etaf-data-load`, `etaf-data-reload`, `etaf-data-mutate`, `etaf-data-set-query`, `etaf-data-next-page`, `etaf-data-previous-page`, `etaf-data-select` (additive multi-select), `etaf-data-select-one` (exclusive single-select), and `etaf-data-stop` for operations. +The controller exposes reactive refs through `etaf-data-items`, `etaf-data-status`, `etaf-data-error`, `etaf-data-total`, `etaf-data-query`, `etaf-data-page`, `etaf-data-page-size`, and `etaf-data-selection`. Use `etaf-data-load`, `etaf-data-reload`, `etaf-data-mutate`, `etaf-data-set-query`, `etaf-data-next-page`, `etaf-data-previous-page`, `etaf-data-select` (additive multi-select), `etaf-data-select-one` (exclusive single-select), `etaf-data-selected-item`, and `etaf-data-stop` for operations. The imperative next/previous commands also reload a Controller whose `:auto-load` is nil; `:auto-load t` keeps reload ownership with the reactive effect. + +`etaf-data-controller` accepts `:item-key` for stable selected-row lookup. When +created inside a Component setup, its internal effect Scope is owned by the +current Component Scope automatically; pass `:owner-scope` when integrating a +controller with another explicit owner. `etaf-data-mutate` returns the source +mutation result after the reload succeeds, so a storage adapter can expose an +inserted id or change count without another application-specific channel. The official DataGrid is a normal Component: @@ -460,6 +479,11 @@ The official DataGrid is a normal Component: (etaf-data-mutate controller 'insert '(:id 3 :name "Alan")) ``` +For a selected record, use `(etaf-data-selected-item controller)` rather than +duplicating identity matching in every detail view. A source may return a +normalized mutation plist such as `(:operation insert :id 3 :changes 1 +:value ...)`; ETAF preserves that value while it refreshes the controller. + DataGrid requires `:row-key` to return a non-nil stable scalar for every row. It projects loading, error, empty, header, rows, and footer through ordinary Hosts and slots. It is not a second data or Component model. Storage is not tied to SQLite. A PostgreSQL, REST, file, or ORM integration should expose a concrete Data Source with the same contract. Such an integration is optional and does not change the ETAF user model. @@ -570,17 +594,17 @@ It depends only on Ebox. Use it when inspecting Ebox boxes and Grid layout; use | API family | Main entry points | Use it when | | --- | --- | --- | | View and Runtime | `etaf-view`, `etaf-render`, `etaf-mount`, `etaf-unmount`, `etaf-runtime-flush` | Build, render, mount, or explicitly flush an application | -| Components | `etaf-define-component`, `etaf-current-prop`, `etaf-current-slots` | Share a View or retain local state | +| Components | `etaf-define-component`, `etaf-current-prop`, `etaf-current-slots`, `etaf-component-set-styles`, `etaf-component-redefine-run` | Share a View, retain local state, style an authoring surface, or deliberately reload code | | Reactive state | `etaf-ref`, `etaf-value`, `etaf-set-value`, `etaf-computed` | Store or derive state | | Reactive effects | `etaf-watch`, `etaf-watch-effect`, `etaf-effect-scope`, `etaf-scope-run` | Observe state or synchronize external resources | | Lifecycle | `etaf-on-mounted`, `etaf-on-updated`, `etaf-on-unmounted` | Attach Component lifecycle work | -| Context | `etaf-provide`, `etaf-inject`, `etaf-theme-provide` | Share ambient dependencies through depth | +| Context | `etaf-provide`, `etaf-inject`, `etaf-theme-provide`, `etaf-theme-token`, `etaf-theme-resolve-palette`, `etaf-theme-current-mode` | Share ambient dependencies and resolve semantic Theme palettes | | Events and focus | `etaf-dispatch-event`, `etaf-activate`, `etaf-focus`, `etaf-focus-next`, `etaf-focus-previous`, `etaf-input-mode` | Enter interactive Runtime behavior | | Actions | `etaf-action-define`, `etaf-dispatch` | Name and reuse business mutations | | Behaviors | `etaf-behavior-create`, `etaf-define-behavior`, `etaf-current-behavior-context`, `etaf-focusable`, `etaf-toggleable` | Reuse non-visual interaction bundles | -| Data | `etaf-data-source`, `etaf-data-controller`, `etaf-data-memory-source`, `etaf-data-*` | Query, paginate, mutate, select, and stop data | +| Data | `etaf-data-source`, `etaf-data-controller`, `etaf-data-memory-source`, `etaf-data-*` | Query, paginate, mutate, select, resolve the selected item, and stop data | | Resource | `etaf-resource`, `etaf-resource-result`, `etaf-error-boundary-run` | Own loader state and cleanup | -| Official UI | `require 'etaf-ui`, `etaf-button`, `etaf-checkbox`, `etaf-label`, `etaf-panel`, `etaf-data-grid` | Use ready-made Components | +| Official UI | `require 'etaf-ui`, `etaf-button`, `etaf-checkbox`, `etaf-number-input`, `etaf-label`, `etaf-panel`, `etaf-data-grid` | Use ready-made Components | | Playground | `etaf-playground-open`, `etaf-playground-open-ui`, `etaf-playground-close`, `ebox-playground-open`, `ebox-playground-close` | Explore the corresponding layer interactively | Most applications need only `etaf-view`, `etaf-mount`, `etaf-define-component`, `etaf-ref`, and event callbacks at first. The remaining APIs are additive capabilities, not prerequisites for understanding the core grammar. diff --git a/docs/user-guide.zh.md b/docs/user-guide.zh.md index c55a5fc..5f11f3a 100644 --- a/docs/user-guide.zh.md +++ b/docs/user-guide.zh.md @@ -287,6 +287,16 @@ Theme 是 Context 的便捷形式，不是另一个 Runtime 对象： (lambda () (etaf-view (slot))))) ``` +如果应用有亮/暗两套 palette，应把语义 role 集中放在一份 palette plist 中， +再显式调用 `(etaf-theme-resolve-palette palette 'light)` 或 `'dark`。这样应用的 +Theme toggle 不依赖 Emacs frame。可选的 `etaf-theme-tp` adapter 可以把 TP 的 +palette registry 转换为同一份 ETAF Theme contract；`etaf-ui` 和 core Runtime +都不依赖 TP palette 名称。 + +静态 Component 样式可以用 `(etaf-theme-token :token-key)` 延迟读取继承的 +Theme。ETAF 会在 lowering 样式作用域时解析它，使重复的 retained Host 复用静态 +样式路径，而不是每个 Host 都携带一个动态 inline 属性。 + ## 8. 事件、Action、Behavior 与 focus 一次局部事件使用 `:on-*` 属性： @@ -440,7 +450,13 @@ Component 发出 next value；ref 由调用方拥有，并在下一次 render (etaf-data-controller source :page-size 10 :auto-load t)) ``` -Controller 通过 `etaf-data-items`、`etaf-data-status`、`etaf-data-error`、`etaf-data-total`、`etaf-data-query`、`etaf-data-page`、`etaf-data-page-size` 和 `etaf-data-selection` 暴露响应式 ref。操作使用 `etaf-data-load`、`etaf-data-reload`、`etaf-data-mutate`、`etaf-data-set-query`、`etaf-data-next-page`、`etaf-data-previous-page`、`etaf-data-select`（追加式多选）、`etaf-data-select-one`（互斥单选）和 `etaf-data-stop`。 +Controller 通过 `etaf-data-items`、`etaf-data-status`、`etaf-data-error`、`etaf-data-total`、`etaf-data-query`、`etaf-data-page`、`etaf-data-page-size` 和 `etaf-data-selection` 暴露响应式 ref。操作使用 `etaf-data-load`、`etaf-data-reload`、`etaf-data-mutate`、`etaf-data-set-query`、`etaf-data-next-page`、`etaf-data-previous-page`、`etaf-data-select`（追加式多选）、`etaf-data-select-one`（互斥单选）、`etaf-data-selected-item` 和 `etaf-data-stop`。当 Controller 的 `:auto-load` 为 nil 时，命令式的 next/previous 也会自动 reload；`:auto-load t` 时仍由 reactive effect 负责 reload，避免重复请求。 + +`etaf-data-controller` 支持用于稳定选中行查找的 `:item-key`。在 Component +setup 中创建时，它的内部 effect Scope 会自动归当前 Component Scope 所有；如果 +需要接入其他显式 owner，可以传入 `:owner-scope`。`etaf-data-mutate` 会在 reload +成功后返回 source 的变更结果，因此存储适配器可以直接暴露插入 id 或 changes， +不需要应用层再维护一条专用通道。 官方 DataGrid 是普通 Component： @@ -459,6 +475,10 @@ Controller 通过 `etaf-data-items`、`etaf-data-status`、`etaf-data-error`、` (etaf-data-mutate controller 'insert '(:id 3 :name "Alan")) ``` +详情视图应使用 `(etaf-data-selected-item controller)`，不要在每个页面重复写 +identity 匹配。source 可以返回类似 `(:operation insert :id 3 :changes 1 +:value ...)` 的规范化变更 plist；ETAF 会在刷新 controller 的同时保留这个结果。 + DataGrid 要求 `:row-key` 对每一行返回非 nil 的稳定标量。它通过普通 Host 和 slot 投影 loading、error、empty、header、rows 和 footer，不是第二种 data 或 Component 模型。 存储不绑定 SQLite。PostgreSQL、REST、文件或 ORM 集成都应该提供同样契约的具体 Data Source；它们是可选集成，不改变 ETAF 的用户模型。 @@ -569,17 +589,17 @@ Loader 错误会保存在 `etaf-resource-error`；cleanup/type 错误保持可 | API 家族 | 主要入口 | 何时使用 | | --- | --- | --- | | View 与 Runtime | `etaf-view`、`etaf-render`、`etaf-mount`、`etaf-unmount`、`etaf-runtime-flush` | 构建、渲染、挂载或显式 flush 应用 | -| Component | `etaf-define-component`、`etaf-current-prop`、`etaf-current-slots` | 复用 View 或保留局部状态 | +| Component | `etaf-define-component`、`etaf-current-prop`、`etaf-current-slots`、`etaf-component-set-styles`、`etaf-component-redefine-run` | 复用 View、保留局部状态、设置 authoring 样式或显式重载代码 | | 响应式状态 | `etaf-ref`、`etaf-value`、`etaf-set-value`、`etaf-computed` | 保存或派生状态 | | 响应式 effect | `etaf-watch`、`etaf-watch-effect`、`etaf-effect-scope`、`etaf-scope-run` | 观察状态或同步外部资源 | | 生命周期 | `etaf-on-mounted`、`etaf-on-updated`、`etaf-on-unmounted` | 绑定 Component 生命周期工作 | -| Context | `etaf-provide`、`etaf-inject`、`etaf-theme-provide` | 跨层级共享依赖 | +| Context | `etaf-provide`、`etaf-inject`、`etaf-theme-provide`、`etaf-theme-token`、`etaf-theme-resolve-palette`、`etaf-theme-current-mode` | 跨层级共享依赖并解析语义 Theme palette | | 事件与 focus | `etaf-dispatch-event`、`etaf-activate`、`etaf-focus`、`etaf-focus-next`、`etaf-focus-previous`、`etaf-input-mode` | 进入交互 Runtime | | Action | `etaf-action-define`、`etaf-dispatch` | 命名和复用业务变更 | | Behavior | `etaf-behavior-create`、`etaf-define-behavior`、`etaf-current-behavior-context`、`etaf-focusable`、`etaf-toggleable` | 复用非视觉交互 bundle | -| Data | `etaf-data-source`、`etaf-data-controller`、`etaf-data-memory-source`、`etaf-data-*` | 查询、分页、变更、选择和停止数据 | +| Data | `etaf-data-source`、`etaf-data-controller`、`etaf-data-memory-source`、`etaf-data-*` | 查询、分页、变更、选择、解析选中项和停止数据 | | Resource | `etaf-resource`、`etaf-resource-result`、`etaf-error-boundary-run` | 管理 loader 状态和 cleanup | -| 官方 UI | `require 'etaf-ui`、`etaf-button`、`etaf-checkbox`、`etaf-label`、`etaf-panel`、`etaf-data-grid` | 使用现成 Component | +| 官方 UI | `require 'etaf-ui`、`etaf-button`、`etaf-checkbox`、`etaf-number-input`、`etaf-label`、`etaf-panel`、`etaf-data-grid` | 使用现成 Component | | Playground | `etaf-playground-open`、`etaf-playground-open-ui`、`etaf-playground-close`、`ebox-playground-open`、`ebox-playground-close` | 探索对应层 | 大多数应用一开始只需要 `etaf-view`、`etaf-mount`、`etaf-define-component`、`etaf-ref` 和事件 callback。其余 API 都是可选能力，不是理解核心语法的前置条件。 diff --git a/etaf-component.el b/etaf-component.el index b888f2b..e509e30 100644 --- a/etaf-component.el +++ b/etaf-component.el @@ -68,6 +68,46 @@ The function is also useful to code that deliberately avoids that shorthand." (plist-get etaf--current-component-props (etaf--component-prop-key name))) +;;;###autoload +(defun etaf-component-set-styles (name styles) + "Replace the static style form for Component NAME with STYLES. + +STYLES must use the same `(styles (SELECTOR PROPERTY VALUE ...) ...)' +contract accepted by `etaf-define-component'. This small runtime authoring +hook is useful to tools which reload a stylesheet without redefining the +Component itself, such as a source/preview playground. The next mount or +render observes the replacement; existing mounted runtimes are not flushed +implicitly." + (let ((spec (and (boundp 'etaf--view-registry) + (gethash name etaf--view-registry)))) + (unless (and (symbolp name) (etaf--component-spec-p spec)) + (etaf--component-definition-error + "Unknown ETAF Component: %S" name)) + (etaf--validate-styles-form styles name) + (setf (etaf--component-spec-styles spec) styles) + styles)) + +(defun etaf-component-styles (name) + "Return the current static style form for Component NAME." + (let ((spec (and (boundp 'etaf--view-registry) + (gethash name etaf--view-registry)))) + (unless (and (symbolp name) (etaf--component-spec-p spec)) + (etaf--component-definition-error + "Unknown ETAF Component: %S" name)) + (etaf--component-spec-styles spec))) + +;;;###autoload +(defun etaf-component-redefine-run (function) + "Run FUNCTION while allowing intentional Component redefinition. + +Normal duplicate Component definitions remain errors. Authoring tools may +use this narrow public boundary after disposing the old Runtime, so hot reload +does not depend on ETAF's private registry flag." + (unless (functionp function) + (signal 'wrong-type-argument (list 'functionp function))) + (let ((etaf--allow-component-redefinition t)) + (funcall function))) + (defun etaf-current-slots () "Return the current Component's normalized slot alist." (setq etaf--raw-slot-read-p t) diff --git a/etaf-context.el b/etaf-context.el index df644fd..02e9193 100644 --- a/etaf-context.el +++ b/etaf-context.el @@ -24,6 +24,15 @@ (defvar etaf--current-context nil "Context table of the Component currently being evaluated.") +(defvar etaf--theme-defaults-cache + (make-hash-table :test #'eq :weakness 'key) + "Context-keyed cache of validated Theme default plists. + +Theme values are immutable for the duration of a render pass. Keeping the +validated copy by Context frame avoids rebuilding the same semantic palette +for every Host that reads one token, while weak keys let disposed Component +Contexts disappear with their Runtime.") + (defvar etaf--context-inject-recorder nil "Candidate-local function recording Context provider reads.") @@ -124,18 +133,27 @@ also accepted and remains tracked by the current render effect." ;;;###autoload (defun etaf-theme-defaults (&optional default) "Return inherited Theme property defaults, or DEFAULT when absent." - (let ((theme (etaf-inject 'theme default))) - (cond - ((or (etaf-ref-p theme) (etaf-computed-p theme)) - (let ((value (etaf-value theme))) - (if (and (proper-list-p value) - (zerop (% (length value) 2))) - (etaf--validate-theme-defaults value) - default))) - ((and (proper-list-p theme) - (zerop (% (length theme) 2))) - (etaf--validate-theme-defaults theme)) - (t default)))) + (let* ((theme (etaf-inject 'theme default)) + (value (if (or (etaf-ref-p theme) (etaf-computed-p theme)) + (etaf-value theme) + theme)) + (context etaf--current-context) + (cached (gethash context etaf--theme-defaults-cache))) + (if (and cached + (eq (plist-get cached :source) theme) + (eq (plist-get cached :value) value) + (equal (plist-get cached :default) default)) + (plist-get cached :validated) + (let ((validated + (if (and (proper-list-p value) + (zerop (% (length value) 2))) + (etaf--validate-theme-defaults value) + default))) + (puthash context + (list :source theme :value value :default default + :validated validated) + etaf--theme-defaults-cache) + validated)))) ;;;###autoload (defun etaf-theme-value (key &optional default) @@ -145,6 +163,90 @@ also accepted and remains tracked by the current render effect." (plist-get theme key) default))) +;;;###autoload +(defun etaf-theme-token (key &optional default) + "Return a deferred Theme token for a static Component style. + +KEY is resolved when ETAF lowers the Component's `:styles' declaration, so a +static rule can use the current inherited Theme without turning every retained +Host into an inline dynamic property. DEFAULT is used when KEY is absent. +The returned list is intentionally data, which also makes it safe to place +directly in a quoted `(styles ...)' form." + (unless (keywordp key) + (signal 'etaf-context-error + (list (format "Theme token keys must be keywords: %S" key)))) + (list 'etaf-theme-token key default)) + +;;;###autoload +(defun etaf-theme-token-p (value) + "Return non-nil when VALUE is a deferred ETAF Theme token." + (and (proper-list-p value) + (memq (length value) '(2 3)) + (eq (car value) 'etaf-theme-token) + (keywordp (nth 1 value)))) + +;;;###autoload +(defun etaf-theme-token-resolve (value) + "Resolve deferred Theme token VALUE, or return ordinary VALUE unchanged." + (if (etaf-theme-token-p value) + (etaf-theme-value (nth 1 value) (nth 2 value)) + value)) + +;;;###autoload +(defun etaf-theme-current-mode () + "Return the current frame color mode as `light' or `dark'. + +This is only the default mode for palette resolution. An application-owned +Theme toggle should pass its explicit mode to `etaf-theme-resolve-palette' +instead of changing the Emacs frame." + (if (eq (frame-parameter nil 'background-mode) 'dark) 'dark 'light)) + +(defun etaf--theme-resolve-color (value mode) + "Resolve one light/dark VALUE for MODE." + (cond + ((stringp value) value) + ((and (consp value) + (or (stringp (car value)) (null (car value))) + (or (stringp (cdr value)) (null (cdr value)))) + (if (eq mode 'dark) (cdr value) (car value))) + ((and (proper-list-p value) + (or (plist-member value :light) (plist-member value :dark))) + (if (eq mode 'dark) (plist-get value :dark) (plist-get value :light))) + ((null value) nil) + (t + (signal 'etaf-context-error + (list (format "Invalid ETAF palette color: %S" value)))))) + +;;;###autoload +(defun etaf-theme-resolve-palette (palette mode) + "Resolve semantic PALETTE token specs for explicit MODE. + +PALETTE is a keyword plist. Each value may be a color string, a +`(LIGHT . DARK)' pair, or a `(:light LIGHT :dark DARK)' plist. MODE is +`light' or `dark'. The result is an ordinary Theme plist suitable for +`etaf-theme-provide'. ETAF owns this semantic contract; a renderer-specific +palette package may adapt its own registry into this shape at the boundary." + (unless (memq mode '(light dark)) + (signal 'etaf-context-error + (list (format "Theme palette mode must be light or dark: %S" + mode)))) + (unless (and (proper-list-p palette) + (zerop (% (length palette) 2))) + (signal 'etaf-context-error + (list (format "Theme palette must be a keyword plist: %S" + palette)))) + (let (result) + (while palette + (let ((key (pop palette)) + (value (pop palette))) + (unless (keywordp key) + (signal 'etaf-context-error + (list (format "Theme palette key must be a keyword: %S" + key)))) + (setq result + (append result (list key (etaf--theme-resolve-color value mode)))))) + result)) + (provide 'etaf-context) ;;; etaf-context.el ends here diff --git a/etaf-data.el b/etaf-data.el index da444ce..d2a7650 100644 --- a/etaf-data.el +++ b/etaf-data.el @@ -36,7 +36,8 @@ selection request-id stopped-p - auto-load-p) + auto-load-p + item-key) (defun etaf-data-source (&rest capabilities) "Create a Data source from callable CAPABILITIES. @@ -236,16 +237,29 @@ and `reset'." ;;;###autoload (cl-defun etaf-data-controller - (source &key query (page 1) (page-size 20) selection auto-load name) + (source &key query (page 1) (page-size 20) selection auto-load name + item-key owner-scope) "Create a reactive Data Controller for SOURCE. QUERY, PAGE, PAGE-SIZE, result ITEMS, TOTAL, STATUS, ERROR, and SELECTION are stored in refs. When AUTO-LOAD is non-nil, the controller loads immediately and reloads after query or pagination refs change. NAME optionally labels the -controller for diagnostics." +controller for diagnostics. ITEM-KEY is a function used by +`etaf-data-selected-item' to match a selected identity to one loaded item. +When OWNER-SCOPE is supplied, or when a current ETAF Scope exists, the +controller's own child Scope is disposed with that owner; otherwise it keeps +the detached Scope behavior." (unless (etaf-data-source-p source) (signal 'wrong-type-argument (list 'etaf-data-source-p source))) - (let* ((scope (etaf-effect-scope :detached t :name (or name 'etaf-data))) + (unless (or (null item-key) (functionp item-key)) + (signal 'wrong-type-argument (list 'functionp item-key))) + (let* ((owner-scope (or owner-scope (etaf-current-effect-scope))) + (scope (if owner-scope + (etaf-scope-run + owner-scope + (lambda () + (etaf-effect-scope :name (or name 'etaf-data)))) + (etaf-effect-scope :detached t :name (or name 'etaf-data)))) (controller (etaf-data--controller-create :source source @@ -260,7 +274,8 @@ controller for diagnostics." :selection (etaf-ref (copy-sequence selection) :name 'etaf-data-selection) :request-id 0 - :auto-load-p auto-load))) + :auto-load-p auto-load + :item-key item-key))) (etaf-scope-run scope (lambda () @@ -317,18 +332,20 @@ controller for diagnostics." (defun etaf-data-mutate (controller operation payload) "Run source OPERATION with PAYLOAD, then reload CONTROLLER. -Errors are stored in the controller error ref and re-signaled." +Errors are stored in the controller error ref and re-signaled. Return the +source mutation result after the reload succeeds." (etaf-data--require-controller controller) (let ((request-id (1+ (etaf-data--controller-request-id controller)))) (setf (etaf-data--controller-request-id controller) request-id) (setf (etaf-value (etaf-data--controller-status controller)) 'loading) (setf (etaf-value (etaf-data--controller-error controller)) nil) (condition-case err - (progn - (funcall (etaf-data--source-function - (etaf-data--controller-source controller) :mutate t) - operation payload) - (etaf-data-load controller)) + (let ((result + (funcall (etaf-data--source-function + (etaf-data--controller-source controller) :mutate t) + operation payload))) + (etaf-data-load controller) + result) (error (etaf-data--apply-error controller request-id err) (signal (car err) (cdr err)))))) @@ -378,6 +395,21 @@ The status value is one of `idle', `loading', `success', or `error'." (etaf-data--controller-selection (etaf-data--require-controller controller))) +;;;###autoload +(defun etaf-data-selected-item (controller &optional item-key) + "Return the loaded item matching CONTROLLER's first selected identity. + +ITEM-KEY overrides the function supplied to `etaf-data-controller'. When no +key function is available, item identity is compared directly. Return nil +when the selection or current page has no matching item." + (let* ((controller (etaf-data--require-controller controller)) + (identity (car (etaf-value (etaf-data-selection controller)))) + (items (etaf-value (etaf-data-items controller))) + (key (or item-key (etaf-data--controller-item-key controller) + #'identity))) + (when identity + (cl-find identity items :key key :test #'equal)))) + ;;;###autoload (defun etaf-data-set-query (controller query) "Set CONTROLLER query to QUERY and return QUERY." @@ -396,14 +428,25 @@ The status value is one of `idle', `loading', `success', or `error'." ;;;###autoload (defun etaf-data-next-page (controller) "Move CONTROLLER to the next page and return the new page." + (setq controller (etaf-data--require-controller controller)) (let ((next (1+ (etaf-value (etaf-data-page controller))))) - (etaf-data-set-page controller next))) + (etaf-data-set-page controller next) + ;; An imperative pager must still refresh a Controller created with + ;; AUTO-LOAD nil. AUTO-LOAD t remains owned by its reactive effect, so + ;; this branch avoids a duplicate source request. + (unless (etaf-data--controller-auto-load-p controller) + (etaf-data-load controller)) + next)) ;;;###autoload (defun etaf-data-previous-page (controller) "Move CONTROLLER to the previous page and return the new page." + (setq controller (etaf-data--require-controller controller)) (let ((previous (max 1 (1- (etaf-value (etaf-data-page controller)))))) - (etaf-data-set-page controller previous))) + (etaf-data-set-page controller previous) + (unless (etaf-data--controller-auto-load-p controller) + (etaf-data-load controller)) + previous)) ;;;###autoload (cl-defun etaf-data-select (controller identity &optional (selected-p t)) diff --git a/etaf-renderer.el b/etaf-renderer.el index 0045ecd..e5119c5 100644 --- a/etaf-renderer.el +++ b/etaf-renderer.el @@ -34,6 +34,8 @@ (declare-function etaf--runtime-behavior-node "etaf-runtime" (runtime node path)) (declare-function etaf--runtime-register-host "etaf-runtime" (runtime props path)) (declare-function etaf-theme-defaults "etaf-context" (&optional default)) +(declare-function etaf-theme-token-p "etaf-context" (value)) +(declare-function etaf-theme-token-resolve "etaf-context" (value)) (define-error 'etaf-renderer-error "ETAF rendering error") @@ -134,6 +136,9 @@ not create another visual node category." (setq value (if (and (consp value) (eq (car value) 'quote)) (cadr value) value)) + (setq value (if (etaf-theme-token-p value) + (etaf-theme-token-resolve value) + value)) (unless (plist-get props key) (setq props (etaf--merge-property props key value)))))))) (etaf--view-node-create diff --git a/etaf-runtime.el b/etaf-runtime.el index 7e30547..ada2d7a 100644 --- a/etaf-runtime.el +++ b/etaf-runtime.el @@ -569,6 +569,52 @@ owning Component node." (etaf--semantic-inline-range-component-id semantic)))) (t nil))))) +(defun etaf--runtime-range-owned-by-rendered-component-p + (runtime generation semantic) + "Return non-nil when SEMANTIC is subsumed by a rendered Component. + +RUNTIME's candidate already contains the Component's freshly lowered output in +that case, so evaluating the old descendant Range again would duplicate work +and later be discarded before publication. Root-owned Ranges intentionally +return nil because they have no material Component owner to absorb them." + (let* ((component-id + (cond + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-component-id semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-consumer-component-id semantic)) + ((etaf--semantic-inline-range-p semantic) + (etaf--semantic-inline-range-component-id semantic)))) + (component (and component-id + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + component-id))) + (effect-id (cond + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-effect-id semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-effect-id semantic)) + ((etaf--semantic-inline-range-p semantic) + (etaf--semantic-inline-range-effect-id semantic)))) + (semantic-id (cond + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-semantic-id semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-semantic-id semantic)) + ((etaf--semantic-inline-range-p semantic) + (etaf--semantic-inline-range-semantic-id semantic)))) + (candidate-effects (etaf-runtime-candidate-effects runtime)) + (candidate-nodes (etaf-runtime-candidate-graph-nodes runtime))) + (and (etaf--semantic-component-p component) + (member (etaf--semantic-component-identity component) + (etaf-runtime-candidate-rendered-identities runtime)) + ;; A Component render only subsumes the old Range once it actually + ;; staged the replacement Range/effect. Context-owned direct Ranges + ;; can remain outside the Component render and must still evaluate + ;; to refresh their Context dependency edges. + (gethash effect-id candidate-effects) + (gethash semantic-id candidate-nodes)))) + (defun etaf--generation-source-effects (generation source) "Return current effect ids for SOURCE in GENERATION." (etaf--pvec-get (etaf-generation-source-effects generation) @@ -3518,6 +3564,13 @@ The candidate uses resolved VALUE, DEPS, and NODES." (cl-pushnew (cons (etaf-context-owner-id frame) key) context-deps :test #'equal))) (etaf--render-runtime runtime) + ;; Static style tokens are lowered in this second pass. Preserve + ;; only the owning Context frame needed by Theme resolution; the + ;; range semantic ids below already provide the runtime lowering + ;; identity, and the other Component bindings belong to the value + ;; normalization pass above. + (etaf--current-context + (etaf--semantic-component-context-frame component)) (etaf--current-component-semantic-id (etaf--semantic-range-component-id range)) (etaf--current-semantic-parent-id @@ -3924,29 +3977,34 @@ RENDERED-IDENTITIES names the Component render participants." (progn (etaf--runtime-record-effect-input-version runtime old effect-id) - (pcase (etaf--generation-effect-kind effect) - ('component-input - (etaf--runtime-evaluate-component-input runtime semantic)) - ('component-render - (unless (member (etaf--semantic-component-identity semantic) - (etaf-runtime-candidate-rendered-identities - runtime)) - (push (etaf--runtime-render-dirty-component runtime semantic) - changes))) - ((or 'range 'fragment) - (push (etaf--runtime-render-dirty-range runtime effect semantic) - range-changes)) - ('raw - (push (etaf--runtime-render-dirty-raw-range - runtime effect semantic) - range-changes)) - ('slot - (push (etaf--runtime-render-dirty-slot-range - runtime effect semantic) - range-changes)) - ('inline - (etaf--runtime-render-dirty-inline-range - runtime effect semantic)))) + (unless (and (memq (etaf--generation-effect-kind effect) + '(range fragment raw slot inline)) + (etaf--runtime-range-owned-by-rendered-component-p + runtime old base-semantic)) + (pcase (etaf--generation-effect-kind effect) + ('component-input + (etaf--runtime-evaluate-component-input runtime semantic)) + ('component-render + (unless (member (etaf--semantic-component-identity semantic) + (etaf-runtime-candidate-rendered-identities + runtime)) + (push (etaf--runtime-render-dirty-component runtime semantic) + changes))) + ((or 'range 'fragment) + (push (etaf--runtime-render-dirty-range + runtime effect semantic) + range-changes)) + ('raw + (push (etaf--runtime-render-dirty-raw-range + runtime effect semantic) + range-changes)) + ('slot + (push (etaf--runtime-render-dirty-slot-range + runtime effect semantic) + range-changes)) + ('inline + (etaf--runtime-render-dirty-inline-range + runtime effect semantic))))) ;; A route can deliver an effect queued by the previous generation ;; after that semantic subtree has already been removed. Retire the ;; effect from the next generation instead of evaluating a nil owner. diff --git a/etaf-theme-tp.el b/etaf-theme-tp.el new file mode 100644 index 0000000..627a12e --- /dev/null +++ b/etaf-theme-tp.el @@ -0,0 +1,59 @@ +;;; etaf-theme-tp.el --- Optional ETAF Theme adapter for TP palettes -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; TP owns low-level palette storage and frame-aware text-property helpers. +;; ETAF owns the semantic Theme contract. This optional adapter is the only +;; place where an application needs to bridge the two; etaf-ui and etaf core +;; do not depend on TP palette names. + +;;; Code: + +(require 'etaf-context) +(require 'tp-palette) + +;;;###autoload +(defmacro etaf-theme-define-palette (name &rest plist) + "Define a TP palette NAME from PLIST for the ETAF Theme adapter. + +The palette registry remains owned by TP; this wrapper keeps an application +from depending on the lower-level `tp-define-palette' spelling in its View or +Component modules." + (declare (indent defun)) + `(tp-define-palette ,name ,@plist)) + +;;;###autoload +(defun etaf-theme-from-tp-palettes (bindings mode) + "Return an ETAF Theme plist from TP palette BINDINGS in MODE. + +BINDINGS is a keyword plist whose values are `(PALETTE . CHANNEL)' pairs, +where PALETTE is a TP palette symbol and CHANNEL is `:fg', `:bg', or +`:border'. MODE is explicitly `light' or `dark'; the current Emacs frame is +never consulted, so an application Theme toggle remains independent of frame +appearance." + (unless (and (proper-list-p bindings) + (zerop (% (length bindings) 2))) + (signal 'etaf-context-error + (list "TP Theme bindings must be a keyword plist"))) + (let (theme) + (while bindings + (let ((token (pop bindings)) + (binding (pop bindings))) + (unless (and (keywordp token) + (consp binding) + (symbolp (car binding)) + (memq (cdr binding) '(:fg :bg :border))) + (signal 'etaf-context-error + (list (format "Invalid TP Theme binding: %S" + (cons token binding))))) + (setq theme + (append theme + (list token + (tp-palette-color-for-mode + (car binding) (cdr binding) mode)))))) + theme)) + +(provide 'etaf-theme-tp) +;;; etaf-theme-tp.el ends here diff --git a/etaf-view.el b/etaf-view.el index 6230eb9..a2aaa1b 100644 --- a/etaf-view.el +++ b/etaf-view.el @@ -93,6 +93,13 @@ this list merely to make a demo convenient.") (defvar etaf--view-registry (make-hash-table :test #'eq) "Registry of Hosts and Components used by structural View calls.") +(defvar etaf--allow-component-redefinition nil + "When non-nil, permit an explicit authoring tool to replace Components. + +Normal ETAF loading keeps duplicate definitions as errors. Tools such as a +source playground may bind this variable around an intentional reload after +disposing the old Runtime.") + (defvar etaf--current-component-props nil "Dynamic props of the Component currently being evaluated.") @@ -142,13 +149,15 @@ form, or core Host. A collision receives a semantic `-view' alias." (etaf--component-error "Component %S conflicts with a core Host" name)) (when (and existing (not (eq existing etaf--host-marker)) - (not (eq existing spec))) + (not (eq existing spec)) + (not etaf--allow-component-redefinition)) (etaf--component-error "Component %S is already registered" name))) (puthash name spec etaf--view-registry) (when-let ((alias (etaf--component-alias name))) (let ((existing (gethash alias etaf--view-registry))) - (when (and existing (not (eq existing spec))) + (when (and existing (not (eq existing spec)) + (not etaf--allow-component-redefinition)) (etaf--component-error "Component alias %S is already registered" alias))) (puthash alias spec etaf--view-registry)) diff --git a/tests/etaf-data-tests.el b/tests/etaf-data-tests.el index 721384e..6ebb0d0 100644 --- a/tests/etaf-data-tests.el +++ b/tests/etaf-data-tests.el @@ -68,6 +68,21 @@ (should (equal '(1 3) (etaf-data-test--ids controller)))) (etaf-data-stop controller)))) +(ert-deftest etaf-data-imperative-pagination-reloads-without-auto-load () + "Public pager commands reload Controllers that opt out of AUTO-LOAD." + (let* ((source (etaf-data-memory-source etaf-data-test-records + :id-key :id)) + (controller (etaf-data-controller source :page-size 2))) + (unwind-protect + (progn + (etaf-data-load controller) + (should (equal '(1 2) (etaf-data-test--ids controller))) + (should (= 2 (etaf-data-next-page controller))) + (should (equal '(3 4) (etaf-data-test--ids controller))) + (should (= 1 (etaf-data-previous-page controller))) + (should (equal '(1 2) (etaf-data-test--ids controller)))) + (etaf-data-stop controller)))) + (ert-deftest etaf-data-source-page-normalization-does-not-reload-twice () "Avoid a second reload when source results normalize page refs." (let* ((load-count 0) @@ -176,6 +191,40 @@ (should-not (etaf-value (etaf-data-selection controller)))) (etaf-data-stop controller)))) +(ert-deftest etaf-data-selected-item-resolves-the-current-identity () + "Resolve a selected identity to the loaded item through the public helper." + (let* ((source (etaf-data-memory-source etaf-data-test-records :id-key :id)) + (controller (etaf-data-controller + source :item-key (lambda (record) (plist-get record :id)) + :auto-load t))) + (unwind-protect + (progn + (etaf-data-select-one controller 3) + (should (equal "Alan" + (plist-get (etaf-data-selected-item controller) + :name))) + (etaf-data-select-one controller 99) + (should-not (etaf-data-selected-item controller))) + (etaf-data-stop controller)))) + +(ert-deftest etaf-data-controller-is-owned-by-current-scope () + "Dispose a controller created in a Scope when its owner Scope stops." + (let ((disposed 0) + controller + (scope (etaf-effect-scope :detached t :name 'etaf-data-owner-test))) + (etaf-scope-run + scope + (lambda () + (setq controller + (etaf-data-controller + (etaf-data-source + :load (lambda (_query _page _page-size) + (list :items nil :total 0)) + :dispose (lambda () (cl-incf disposed))))))) + (should (etaf-data-controller-p controller)) + (etaf-scope-stop scope) + (should (= 1 disposed)))) + (ert-deftest etaf-data-stop-disposes-source-and-controller () "Stop controller lifecycle resources and reject later operations." (let* ((dispose-count 0) diff --git a/tests/etaf-tests.el b/tests/etaf-tests.el index 39284cd..5e164d5 100644 --- a/tests/etaf-tests.el +++ b/tests/etaf-tests.el @@ -850,6 +850,15 @@ (etaf-theme-provide '(:color "theme-color" :bgcolor "theme-bg")) (lambda () (etaf-view (text :color nil "Themed"))))) +(etaf-define-component etaf-test-themed-style-token () + "Resolve a deferred Theme token from a static Component style." + :styles + (styles ("&" :color (etaf-theme-token :color))) + :setup + (progn + (etaf-theme-provide '(:color "token-color")) + (lambda () (etaf-view (text "Token"))))) + (etaf-define-component etaf-test-stateful (&key label) "Render a retained counter for Runtime tests." :setup @@ -1359,6 +1368,41 @@ (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-theme-token-resolves-static-component-style () + "Resolve a Theme token without turning the Host property inline." + (let ((buffer-name " *etaf-theme-token-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-themed-style-token))) + (should (equal "token-color" + (ebox-get + (etaf-runtime-root-node + (etaf-runtime-for-buffer buffer-name)) + :color)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) + (kill-buffer buffer))))) + +(ert-deftest etaf-theme-resolves-explicit-light-dark-palette () + "Resolve semantic palette pairs without coupling Theme to a renderer." + (should + (equal '(:ink "#172033" :paper "#F7F3EA") + (etaf-theme-resolve-palette + '(:ink ("#172033" . "#F4F7FF") + :paper (:light "#F7F3EA" :dark "#111827")) + 'light))) + (should + (equal '(:ink "#F4F7FF" :paper "#111827") + (etaf-theme-resolve-palette + '(:ink ("#172033" . "#F4F7FF") + :paper (:light "#F7F3EA" :dark "#111827")) + 'dark))) + (should-error + (etaf-theme-resolve-palette '(:ink "red") 'sepia) + :type 'etaf-context-error)) + (ert-deftest etaf-text-supports-inline-propertized-runs () "Lower nested text Hosts to one Ebox content surface with text properties." (let* ((node (etaf-render @@ -1821,6 +1865,35 @@ Event composition is a Runtime contract, not a UI-library helper contract." (should (plist-get condition :path)) (should (= 3 (length (plist-get condition :path)))))))) +(ert-deftest etaf-runtime-skips-descendant-range-under-rendered-component () + "A freshly rendered Component absorbs its old descendant Range effect." + (let* ((component + (etaf--semantic-component-create + :semantic-id 7 :identity '(parent-component))) + (range + (etaf--semantic-range-create + :semantic-id 8 :effect-id 8 :component-id 7 :parent-id 7)) + (generation + (etaf--generation-create + :generation-id 1 + :semantic-nodes (etaf--pvec-put + (etaf--pvec-put nil 7 component) 8 range))) + (runtime + (etaf--runtime-create + :candidate-rendered-identities '((parent-component)) + :candidate-effects (make-hash-table :test #'eql) + :candidate-graph-nodes (make-hash-table :test #'eql)))) + (puthash 8 + (etaf--generation-effect-create + :effect-id 8 :kind 'range :semantic-id 8) + (etaf-runtime-candidate-effects runtime)) + (puthash 8 range (etaf-runtime-candidate-graph-nodes runtime)) + (should (etaf--runtime-range-owned-by-rendered-component-p + runtime generation range)) + (setf (etaf-runtime-candidate-rendered-identities runtime) nil) + (should-not (etaf--runtime-range-owned-by-rendered-component-p + runtime generation range)))) + (ert-deftest etaf-view-raw-ebox-is-an-explicit-backend-escape () "Lower a public Ebox node only through the explicit raw escape." (let ((node diff --git a/tests/etaf-theme-tp-tests.el b/tests/etaf-theme-tp-tests.el new file mode 100644 index 0000000..955d6cb --- /dev/null +++ b/tests/etaf-theme-tp-tests.el @@ -0,0 +1,27 @@ +;;; etaf-theme-tp-tests.el --- Optional TP Theme adapter tests -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +(require 'ert) +(require 'etaf-theme-tp) + +(ert-deftest etaf-theme-tp-adapter-resolves-explicit-mode () + "Bridge TP palettes into semantic ETAF Theme tokens." + (let ((tp-palette-alist tp-palette-alist)) + (etaf-theme-define-palette etaf-test-adapter-status + :fg ("#111111" . "#EEEEEE") + :bg ("#FFFFFF" . "#222222")) + (should + (equal '(:ink "#111111" :paper "#FFFFFF") + (etaf-theme-from-tp-palettes + '(:ink (etaf-test-adapter-status . :fg) + :paper (etaf-test-adapter-status . :bg)) + 'light))) + (should + (equal '(:ink "#EEEEEE" :paper "#222222") + (etaf-theme-from-tp-palettes + '(:ink (etaf-test-adapter-status . :fg) + :paper (etaf-test-adapter-status . :bg)) + 'dark))))) + +;;; etaf-theme-tp-tests.el ends here