Add theme palette and reactive data contracts
This commit is contained in:
Kinneyzhang
parent
00918de9d4
commit
a0e0145639
4
Makefile
4
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
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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。
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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 都是可选能力，不是理解核心语法的前置条件。
|
||||
|
||||
@ -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)
|
||||
|
||||
126
etaf-context.el
126
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
|
||||
|
||||
69
etaf-data.el
69
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))
|
||||
|
||||
@ -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
|
||||
|
||||
104
etaf-runtime.el
104
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.
|
||||
|
||||
59
etaf-theme-tp.el
Normal file
59
etaf-theme-tp.el
Normal file
@ -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
|
||||
13
etaf-view.el
13
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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
27
tests/etaf-theme-tp-tests.el
Normal file
27
tests/etaf-theme-tp-tests.el
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user