From 591e2a2ead963c02bae89a1ae59402cfab712343 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sun, 6 Sep 2026 11:24:19 +0800 Subject: [PATCH] feat: support reusable table cells and adaptive columns --- README.md | 152 ++++- README.zh-CN.md | 135 ++++- etaf-ui-basic.el | 30 +- etaf-ui-data.el | 144 ++--- etaf-ui-table.el | 189 +++--- scripts/etaf-ui-m0a-inventory.el | 4 +- tests/etaf-ui-button-commit-tests.el | 76 +++ tests/etaf-ui-cell-tests.el | 706 +++++++++++++++++++++++ tests/etaf-ui-docs-tests.el | 85 +++ tests/etaf-ui-pagination-commit-tests.el | 241 ++++++++ tests/etaf-ui-table-adaptive-tests.el | 274 +++++++++ tests/etaf-ui-tests.el | 21 +- 12 files changed, 1807 insertions(+), 250 deletions(-) create mode 100644 tests/etaf-ui-button-commit-tests.el create mode 100644 tests/etaf-ui-cell-tests.el create mode 100644 tests/etaf-ui-docs-tests.el create mode 100644 tests/etaf-ui-pagination-commit-tests.el create mode 100644 tests/etaf-ui-table-adaptive-tests.el diff --git a/README.md b/README.md index c2acd68..f6d71dd 100644 --- a/README.md +++ b/README.md @@ -2,27 +2,43 @@ `etaf-ui` is the official ETAF Component catalog. It is a normal optional package above `etaf`; it does not add a second Control or Widget model. Button, Checkbox, Label, Panel, and DataGrid are all ordinary Components with the same View, props, slots, events, and Data contracts. + +Use the exact registered names `etaf-panel`, `etaf-label`, `etaf-button`, and +`etaf-checkbox` in every View. Evaluate this complete example in a lexical-binding +`.el` file, then switch to `*etaf-preferences*` to use its controls. + + ```elisp +;;; -*- lexical-binding: t; -*- (require 'etaf-ui) -(let ((done (etaf-ref nil))) - (etaf-view - (panel :title "Account" - (slot :name 'header - (button :label "Save" :ref 'save-button - :on-press (lambda () (message "saved")))) - (label :text "Preferences") - (checkbox :checked (etaf-value done) :label "Done" - :ref 'done-checkbox - :on-change (lambda (next) - (setf (etaf-value done) next)))))) +(etaf-define-component demo-preferences () + :setup (list (etaf-ref nil) (etaf-ref "Unsaved")) + :render + (let* ((state (etaf-state)) + (done (car state)) + (saved (cadr state))) + (etaf-view + (etaf-panel :title "Account" + (slot :name 'header + (etaf-button :label "Save" :ref 'save-button + :on-press (lambda () + (setf (etaf-value saved) "Saved")))) + (etaf-label :text (etaf-value saved)) + (etaf-checkbox :checked (etaf-value done) :label "Done" + :ref 'done-checkbox + :on-change (lambda (next) + (setf (etaf-value done) next))) + (text (expr (if (etaf-value done) "Complete" "Pending"))))))) + +(etaf-mount "*etaf-preferences*" (etaf-view (demo-preferences))) ``` -In `.etaf` files use the short registered tags (`panel`, `label`, `button`, -`checkbox`, and `data-grid`) for structure. The companion `.el` file owns -reactive values, Actions, Behaviors, and callbacks; keep the `etaf-view` tree -made from those same short tags. Canonical `etaf-*` names remain the Elisp -definition and API names. +Core does not automatically load `.etaf` files. The optional Playground reads +inert structural source and explicitly loads its registered Elisp companion; +that file format does not create shorter Component aliases. Local callbacks +need no named Action. Components receive props and slots through the same API +as application-defined Components. Button and Checkbox are controlled Components. `etaf-button` accepts `:label`, `:on-press`, `:disabled`, `:ref`, and the small presentation set @@ -67,9 +83,25 @@ no callback, pointer activation, or tab stop. The Runtime owns composition of an explicit `:on-*` callback with a Behavior callback; the UI package only declares the control and its visual state. -Spacing is owned by the parent layout, not by Button. Put adjacent controls in -a `row`/`flex` with an explicit horizontal `:gap`; this keeps each control's -mouse-face and hit range semantically separate. +The parent owns spacing: use `(row :item-gap 1 ...)` or +`(column :item-gap 1 ...)`; `flex` and `grid` use `:gap`. In particular, migrate +`row :gap` to `row :item-gap`. Keep an explicit gap between adjacent controls +so each has a separate hover and hit range. + +Root event forwarding appends the business action, inner-to-outer wrapper +callbacks, then Behaviors in declaration order. For Checkbox, adding +`:on-press` does not replace its `:on-change` conversion. Errors stop the chain; +each declaration runs once. Wrapper `:use` lists concatenate and duplicate +Behavior names are rejected before installation. + +Disabled inputs combine with OR; outer nil cannot enable an internally disabled +control. Disabled dispatch and focus signal `etaf-event-error`; disabled cell +controls block pointer activation from falling through to their parent row. +Disabled input Behaviors are not installed. A conflicting fallthrough `:role` +or owned aria state, such as `:aria-checked`, is an input error; accessible +`:aria-label` and `:aria-description` remain caller-overridable. See the +[interaction and migration rules](../etaf/docs/user-guide.en.md#interaction-migration) +for the complete contract. `etaf-label` accepts `:text`, `:class`, `:color`, `:bgcolor`, `:font-weight`, `:width`, `:border`, `:padding`, and `:ref`. @@ -90,7 +122,7 @@ separate from forwarded Host attributes: | `etaf-number-input` | `:value`, `:label`, `:on-change`, `:disabled`, `:min`, `:max` | | `etaf-table` | `:columns`, `:rows`, `:row-key`, `:row-ref`, `:on-row-press`, `:row-selected-p` | | `etaf-data-grid` | `:controller`, `:columns`, `:row-key`, `:on-row-press`, `:row-ref`, `:row-selected-p`, `:loading-label`, `:error-label`, `:empty-label` | -| `etaf-pagination` | `:controller`, `:previous-ref`, `:next-ref`, `:class`, `:color`, `:bgcolor`, `:border`, `:padding`, `:aria-label` | +| `etaf-pagination` | `:controller`, `:previous-ref`, `:next-ref`, `:previous-label`, `:next-label`, `:class`, `:color`, `:bgcolor`, `:border`, `:padding`, `:aria-label` | Every public catalog Component mounts exactly one Host root. All valid Host @@ -104,6 +136,11 @@ optional `:loading-label`, `:error-label`, `:empty-label`, or function-valued interactive button with role `button` and tab index `0`; the callback receives the row. Without `:on-row-press`, rows have no callback or tab stop. +Interactive `etaf-table` rows may also omit `:row-ref`; the framework supplies +stable references scoped to the retained Table instance. Supply refs only for +external focus, tests, or integration addresses; do not derive global symbols +from row labels. Row keys identify data; refs identify interactive Hosts. + `:row-ref` is optional for DataGrid. When it is omitted on an interactive grid, DataGrid derives a stable internal Host reference from the row identity @@ -116,13 +153,80 @@ retains one action closure per row key, so selection or Data Range updates do not recreate handlers for unchanged rows. An integer column `:width` is readable character capacity, not a raw pixel value. DataGrid passes Ebox's native character unit through and reserves one -native character between non-final tracks. +native character between non-final tracks. Use `:width '(fr 1)` to let a column +fill the remaining width; multiple fractional columns share that space by +their positive weights. For example, `(:key :title :width (fr 1))` next to +`(:key :actions :width 22 :cell render-actions)` lets the title adapt while +reserving room for the action controls. Headers and rows use the same tracks +and gap. Fractional cells clip to their allocation without widening neighboring +columns. Fixed tracks still reserve their declared space, so the containing +layout must provide enough width for those controls and gaps. + +Changing a custom cell's column width between fixed and fractional values does +not replace its Component state. All-fixed text-only tables retain their compact +text rendering path. + +### Custom cells and column migration + +Table and DataGrid share the column contract. Every column needs a unique, +non-nil `:key` (symbol, integer, or string), including presentation-only columns. +The default cell reads that field as text. A `:cell` function receives one row +and returns nil, a string, a typed Host or Component View, or a proper sequence +of those values. Table owns cell width and clips overflow; text-only tables +keep their existing compact representation. + +The example repeats the `:name` field with two distinct column keys and puts an +ordinary Button in a third column. Select the row or activate Open independently: + + +```elisp +;;; -*- lexical-binding: t; -*- +(require 'etaf-ui) + +(etaf-mount + "*etaf-cell-demo*" + (etaf-view + (etaf-table + :rows '((:id 1 :name "Ada")) + :row-key (lambda (row) (plist-get row :id)) + :on-row-press (lambda (row) (message "Select %s" (plist-get row :name))) + :columns + (list + '(:key :name :label "Name" :width 12) + (list :key :name-upper :label "Uppercase" :width 12 + :cell (lambda (row) (upcase (plist-get row :name)))) + (list :key :open :label "Action" :width 10 + :cell + (lambda (row) + (etaf-view + (etaf-button + :label "Open" + :on-press (lambda () + (message "Open %s" (plist-get row :name))))))))))) +``` + +To migrate duplicate field columns, keep one `:key :name`, give the other a +unique key such as `:name-upper`, and use `:cell` to read the original `:name` +field. Missing or duplicate column keys are errors. Row and column keys retain +cell identity across reordering; changing a key replaces that cell instance. + +Cell functions use their row argument and normal lexical captures. Their +Context is the consuming Table/Grid location; they do not recover the author's +props, `etaf-state`, or private styles. Return an ordinary Component when a +cell needs its own state, styles, or lifecycle, and create persistent refs and +watches in that Component's `:setup`. Capture an author's stable ref before +building a callback when sharing it is intentional. Do not create persistent +state on each cell-function call. `etaf-pagination` is a controlled Data Component. It accepts a Data controller -plus stable `:previous-ref` and `:next-ref` values, renders readable `←`/`→` -controls and a `Page N / M` summary, and disables the boundary action while a +plus stable `:previous-ref` and `:next-ref` values, renders padded secondary +Buttons (`‹ Previous` / `Next ›`) around a centered `Page N / M` and item-count +summary, and disables the boundary action while a page is loading or already at the first/last page. It owns no page state and -uses the same Button interaction contract. +uses the same Button interaction contract and Theme tokens. Narrow allocations +wrap the complete controls and summary. Optional `:previous-label` and +`:next-label` replace the complete captions, for example `"‹ 上一页"` and +`"下一页 ›"`; the stable English accessibility labels remain unchanged. Keyboard focus uses ETAF's public runtime ports: call `(etaf-focus-next runtime)` to move through visible Hosts with a numeric diff --git a/README.zh-CN.md b/README.zh-CN.md index e68a7b8..eb5e7eb 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -2,26 +2,41 @@ `etaf-ui` 是 ETAF 的官方 Component 目录，是建立在 `etaf` 之上的可选独立包。它不增加第二套 Control 或 Widget 模型；Button、Checkbox、Label、Panel、DataGrid 都是使用同一套 View、属性、slot、事件和 Data 契约的普通 Component。 + +所有 View 都使用准确的注册名称：`etaf-panel`、`etaf-label`、`etaf-button` 和 +`etaf-checkbox`。把下面完整例子放进启用 lexical-binding 的 `.el` 文件求值， +再切换到 `*etaf-preferences*` 使用控件。 + + ```elisp +;;; -*- lexical-binding: t; -*- (require 'etaf-ui) -(let ((done (etaf-ref nil))) - (etaf-view - (panel :title "Account" - (slot :name 'header - (button :label "Save" :ref 'save-button - :on-press (lambda () (message "saved")))) - (label :text "Preferences") - (checkbox :checked (etaf-value done) :label "Done" - :ref 'done-checkbox - :on-change (lambda (next) - (setf (etaf-value done) next)))))) +(etaf-define-component demo-preferences () + :setup (list (etaf-ref nil) (etaf-ref "Unsaved")) + :render + (let* ((state (etaf-state)) + (done (car state)) + (saved (cadr state))) + (etaf-view + (etaf-panel :title "Account" + (slot :name 'header + (etaf-button :label "Save" :ref 'save-button + :on-press (lambda () + (setf (etaf-value saved) "Saved")))) + (etaf-label :text (etaf-value saved)) + (etaf-checkbox :checked (etaf-value done) :label "Done" + :ref 'done-checkbox + :on-change (lambda (next) + (setf (etaf-value done) next))) + (text (expr (if (etaf-value done) "Complete" "Pending"))))))) + +(etaf-mount "*etaf-preferences*" (etaf-view (demo-preferences))) ``` -`.etaf` 文件的结构使用已注册的短标签（`panel`、`label`、`button`、 -`checkbox`、`data-grid`）。配套 `.el` 文件负责响应式值、Action、Behavior -和回调；其中 `etaf-view` 也使用同一组短标签。Elisp 定义和 API 文档仍使用 -规范的 `etaf-*` 名称。 +Core 不会自动加载 `.etaf`。可选的 Playground 读取 inert 结构源，并显式加载 +已注册的 Elisp companion；这个文件格式不会生成更短的 Component alias。 +普通本地回调不需要命名 Action，目录组件与应用自己定义的组件使用相同的 props 和 slot API。 Button 和 Checkbox 都是受控组件。`etaf-button` 支持 `:label`、 `:on-press`、`:disabled`、`:ref`，以及最小 presentation 属性 @@ -59,8 +74,20 @@ Component 的 `:styles` 声明负责默认外观。调用者提供的非 nil pre 显式 `:on-*` 回调和 Behavior 回调的组合由 Runtime 负责；UI 包只声明控件和 视觉状态。 -间距由父布局负责，而不是由 Button 偷塞。相邻控件应放在带明确横向 `:gap` -的 `row`/`flex` 中，这样每个控件的 mouse-face 和命中范围才保持语义独立。 +间距由父布局负责：`row` 和 `column` 使用 `:item-gap`，例如 +`(row :item-gap 1 ...)`；`flex` 和 `grid` 使用 `:gap`。尤其需要将 `row :gap` +迁移为 `row :item-gap`。相邻控件保留明确间距，让 hover 和命中范围各自独立。 + +根事件透传按顺序追加：业务动作、由内到外的 wrapper callback、最后按声明顺序 +运行的 Behavior。给 Checkbox 增加 `:on-press` 不会替换它的 `:on-change` 转换。 +每个声明执行一次，错误会中断后续回调。wrapper 的 `:use` 列表顺序连接，重复 +Behavior name 在安装前报错。 + +禁用输入取 OR，外层 nil 不能启用内部已经禁用的控件。禁用时 dispatch 和 focus +抛出 `etaf-event-error`，禁用 cell 控件会阻止指针激活落到父行，输入 Behavior +也不会安装。透传 `:role` 或 `:aria-checked` 等组件所有的 aria 状态时，冲突值会 +导致输入错误；调用方仍可覆盖 `:aria-label` 与 `:aria-description`。完整规则见 +[交互与迁移说明](../etaf/docs/user-guide.zh.md#interaction-migration)。 `etaf-label` 支持 `:text`、`:class`、`:color`、`:bgcolor`、`:font-weight`、 `:width`、`:border`、`:padding` 和 `:ref`。 @@ -79,7 +106,7 @@ surface presentation 属性，并投影命名的 `header` slot 和默认 slot。 | `etaf-number-input` | `:value`、`:label`、`:on-change`、`:disabled`、`:min`、`:max` | | `etaf-table` | `:columns`、`:rows`、`:row-key`、`:row-ref`、`:on-row-press`、`:row-selected-p` | | `etaf-data-grid` | `:controller`、`:columns`、`:row-key`、`:on-row-press`、`:row-ref`、`:row-selected-p`、`:loading-label`、`:error-label`、`:empty-label` | -| `etaf-pagination` | `:controller`、`:previous-ref`、`:next-ref`、`:class`、`:color`、`:bgcolor`、`:border`、`:padding`、`:aria-label` | +| `etaf-pagination` | `:controller`、`:previous-ref`、`:next-ref`、`:previous-label`、`:next-label`、`:class`、`:color`、`:bgcolor`、`:border`、`:padding`、`:aria-label` | 目录中的每个公共 Component 都只挂载一个 Host root。未被作为 business prop @@ -92,6 +119,10 @@ DataGrid 支持列描述、函数型 `:row-key`，以及可选的 `tab-index 0` 的可交互 button，且回调接收该行；没有 `:on-row-press` 时，行 没有回调或 tab stop。 +`etaf-table` 的交互行也可省略 `:row-ref`，框架会提供属于当前保留实例的稳定引用。 +只有外部 focus、测试或集成需要直接寻址时才提供 ref，不要根据行文字拼接全局 +symbol。row key 负责数据身份，ref 负责交互 Host 地址。 + DataGrid 的 `:row-ref` 是可选项。交互式 grid 省略它时，DataGrid 会根据 controller 持有的 row identity 派生稳定的内部 Host ref。fallback ref 不会 @@ -102,12 +133,72 @@ controller 持有的 row identity 派生稳定的内部 Host ref。fallback ref DataGrid 按 row key 保留唯一 action closure，因此 selection 或 Data Range 更新不会为未变化的行重建 handler。 整数列 `:width` 表示可读字符容量，不是裸像素；DataGrid 原样使用 Ebox 原生字符单位， -并在非末列之间保留一个原生字符间距。 +并在非末列之间保留一个原生字符间距。使用 `:width '(fr 1)` 让列填充剩余宽度； +多个 fractional 列按正数权重分配这部分空间。例如让 +`(:key :title :width (fr 1))` 与 +`(:key :actions :width 22 :cell render-actions)` 配合，可以在保留操作控件空间的 +同时自适应标题宽度。表头和数据行使用相同的轨道及间距。自适应 cell 按分配的 +宽度裁剪，不会挤宽相邻列。固定列仍保留声明的空间，父布局需要容纳这些控件 +及列间距。 + +自定义 cell 的列宽在固定值与 fractional 值之间切换时，其 Component 状态保持。 +全固定列的纯文本表格仍保留紧凑的文本渲染路径。 + +### 自定义 cell 与列迁移 + +Table 与 DataGrid 共用列契约。每一列都必须有唯一且非 nil 的 `:key` +（symbol、整数或字符串），纯展示列也一样。默认 cell 将该字段显示为文字。 +`:cell` 函数接收一个 row，返回 nil、字符串、typed Host 或 Component View， +或这些值组成的 proper sequence。Table 拥有 cell 宽度并裁剪溢出；纯文本表格 +继续使用原有的紧凑表示。 + +下面将 `:name` 字段用两个不同的 column key 展示，并在第三列放入普通 Button。 +行选择与 Open 按钮分别执行自己的动作： + + +```elisp +;;; -*- lexical-binding: t; -*- +(require 'etaf-ui) + +(etaf-mount + "*etaf-cell-demo*" + (etaf-view + (etaf-table + :rows '((:id 1 :name "Ada")) + :row-key (lambda (row) (plist-get row :id)) + :on-row-press (lambda (row) (message "Select %s" (plist-get row :name))) + :columns + (list + '(:key :name :label "Name" :width 12) + (list :key :name-upper :label "Uppercase" :width 12 + :cell (lambda (row) (upcase (plist-get row :name)))) + (list :key :open :label "Action" :width 10 + :cell + (lambda (row) + (etaf-view + (etaf-button + :label "Open" + :on-press (lambda () + (message "Open %s" (plist-get row :name))))))))))) +``` + +迁移重复字段列时，保留一列的 `:key :name`，为另一列指定 `:name-upper` 等唯一 +key，再通过 `:cell` 读取原来的 `:name` 字段。缺失或重复 column key 都会报错。 +row key 与 column key 让 cell 身份在重排时保留；改变 key 会替换该 cell 实例。 + +cell 函数使用 row 参数与普通词法捕获，Context 来自消费它的 Table/Grid 挂载 +位置，不会恢复作者的 props、`etaf-state` 或私有样式。cell 需要自己的状态、样式 +或生命周期时，返回普通 Component，在它的 `:setup` 中创建持久 ref 和 watch。 +若有意共享作者的 ref，应在创建回调前捕获稳定句柄；不要在每次 cell 函数调用时 +创建持久状态。 `etaf-pagination` 是受控 Data Component。它接收 Data controller 以及稳定的 -`:previous-ref`、`:next-ref`，显示易读的 `←`/`→` 控件和 `Page N / M` 摘要； -加载中或已经位于首/末页时会禁用对应动作。它不拥有页码状态，并复用 Button -的交互契约。 +`:previous-ref`、`:next-ref`，使用带内边距的 secondary Button（`‹ Previous` / +`Next ›`），中间显示 `Page N / M` 与条数摘要。空间不足时，完整控件和摘要 +自然换行。加载中或已经位于首/末页时会禁用对应动作。它不拥有页码状态， +并复用 Button 的交互契约和 Theme token。可选的 `:previous-label`、 +`:next-label` 替换完整按钮文案，例如 `"‹ 上一页"`、`"下一页 ›"`；稳定的英文 +无障碍标签保持不变。 键盘焦点使用 ETAF 的公共 Runtime 端口：用 `(etaf-focus-next runtime)` 在带数值且非负 `:tab-index` 的可见 Host 之间 diff --git a/etaf-ui-basic.el b/etaf-ui-basic.el index cf047a5..3055741 100644 --- a/etaf-ui-basic.el +++ b/etaf-ui-basic.el @@ -86,37 +86,19 @@ :border (etaf-ui--style-border (plist-get theme border-key)) :font-weight (if (or disabled (eq variant 'ghost)) 'normal 'bold)))) -;;;###autoload -(defun etaf-ui--button-setup () - "Return retained callback state for one Button instance." - (let ((state (list :callback nil :press-p nil))) - (plist-put - state :press - (lambda () - (when (plist-get state :press-p) - (when-let* ((callback (plist-get state :callback))) - (funcall callback))))) - state)) - (etaf-ui--define-component etaf-button (&key label on-press disabled ref class color bgcolor border padding font-weight tab-index aria-label use variant) - "Render a standard pressable Button with retained callback identity. + "Render a standard pressable Button with a committed callback. DISABLED removes the callback and default focus tab index. Presentation props -remain caller-overridable while the setup state keeps the event closure stable -across parent Component rerenders." - :setup - (etaf-ui--button-setup) +remain caller-overridable. Runtime publishes ON-PRESS with the visible Button, +so a failed render keeps the previous callback and its captured values." :render - (let* ((state (etaf-state)) - (label (etaf-ui--text-value label)) - (press-p (and (not disabled) (or on-press use))) + (let* ((label (etaf-ui--text-value label)) (variant-values (etaf-ui--button-variant-values (and (not disabled) variant) disabled))) - (setf (plist-get state :callback) on-press - (plist-get state :press-p) press-p) (etaf-node 'box (list @@ -132,8 +114,8 @@ across parent Component rerenders." :border (or border (plist-get variant-values :border)) :padding padding :font-weight (or font-weight (plist-get variant-values :font-weight)) - :use (and (not disabled) use) - :on-press (and press-p (plist-get state :press))) + :use use + :on-press (and (not disabled) on-press)) (list (etaf-node 'text nil (list label))))) :styles (styles diff --git a/etaf-ui-data.el b/etaf-ui-data.el index 024b78a..15a10e7 100644 --- a/etaf-ui-data.el +++ b/etaf-ui-data.el @@ -24,10 +24,9 @@ (defun etaf-ui--data-grid-default-row-ref (state controller row) "Return STATE's stable internal Host reference for CONTROLLER and ROW. -DataGrid owns this fallback so the presentational Table can keep its stricter -interactive-row contract. The controller's validated item identity is the -row input. Per-instance uninterned symbols prevent cross-grid collisions and -avoid process-global symbol-table growth." +The controller's validated item identity is the row input. Like Table's +retained row references, per-instance uninterned symbols prevent cross-grid +collisions and avoid process-global symbol-table growth." (let* ((identity (etaf-data-item-identity controller row)) (cache (plist-get state :row-refs)) (stage (plist-get state :row-ref-stage)) @@ -260,7 +259,8 @@ LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override the state text." DataGrid owns loading, error, empty, and controller-selection adaptation. Its keyed Range retains row identity across insert, reorder, and update. Setup state owns per-instance fallback refs plus commit-staged stable row -actions; failed candidates cannot mutate committed handler inputs." +actions; failed candidates cannot mutate committed handler inputs. COLUMNS +use Table's unique keys and optional `:cell' row-to-View functions." :setup (let ((state (list :row-actions (make-hash-table :test #'equal) @@ -297,86 +297,34 @@ actions; failed candidates cannot mutate committed handler inputs." (slot :name 'footer))) (etaf-ui--define-component etaf-pagination - (&key controller previous-ref next-ref class color bgcolor border padding - aria-label) - "Render a controlled pager for DATA CONTROLLER with retained controls." - :setup - (let* ((state (list :controller nil)) - (page-value - (lambda () - (let ((controller (plist-get state :controller))) - (max 1 (or (and controller - (etaf-value (etaf-data-page controller))) - 1))))) - (page-size-value - (lambda () - (let ((controller (plist-get state :controller))) - (max 1 (or (and controller - (etaf-value (etaf-data-page-size controller))) - 1))))) - (total-value - (lambda () - (let ((controller (plist-get state :controller))) - (max 0 (or (and controller - (etaf-value (etaf-data-total controller))) - 0))))) - (pages-value - (lambda () - (max 1 (ceiling (/ (float (funcall total-value)) - (funcall page-size-value)))))) - (loading-p - (lambda () - (let ((controller (plist-get state :controller))) - (and controller - (eq (etaf-value (etaf-data-status controller)) - 'loading))))) - (previous-disabled - (lambda () - (or (funcall loading-p) (<= (funcall page-value) 1)))) - (next-disabled - (lambda () - (or (funcall loading-p) - (>= (funcall page-value) (funcall pages-value))))) - (previous - (lambda () - (let ((controller (plist-get state :controller))) - (when (and controller - (not (funcall previous-disabled))) - (etaf-data-previous-page controller))))) - (next - (lambda () - (let ((controller (plist-get state :controller))) - (when (and controller - (not (funcall next-disabled))) - (etaf-data-next-page controller)))))) - (plist-put state :page-value page-value) - (plist-put state :page-size-value page-size-value) - (plist-put state :total-value total-value) - (plist-put state :pages-value pages-value) - (plist-put state :loading-p loading-p) - (plist-put state :previous-disabled previous-disabled) - (plist-put state :next-disabled next-disabled) - (plist-put state :previous previous) - (plist-put state :next next) - state) + (&key controller previous-ref next-ref previous-label next-label + class color bgcolor border padding aria-label) + "Render a controlled pager whose callbacks follow its committed CONTROLLER. +PREVIOUS-LABEL and NEXT-LABEL override the complete Button captions. +Each Button captures its render's Controller; Runtime publishes that callback +together with the visible control after a successful render." :render - (let* ((state (etaf-state)) - (controller-value controller)) - (setf (plist-get state :controller) controller-value) + (let ((controller-value controller)) (let* ((theme (etaf-ui--style-tokens - :ui-fg :ui-bg :ui-disabled-fg - :ui-pagination-muted-fg)) + :ui-fg :ui-bg :ui-pagination-muted-fg)) (parent-color (or color (plist-get theme :ui-fg))) (parent-bgcolor (or bgcolor (plist-get theme :ui-bg))) - (arrow-border (or border '(0 solid "transparent"))) - (page (funcall (plist-get state :page-value))) - (page-size (funcall (plist-get state :page-size-value))) - (total (funcall (plist-get state :total-value))) - (pages (funcall (plist-get state :pages-value))) - (previous-disabled - (funcall (plist-get state :previous-disabled))) - (next-disabled - (funcall (plist-get state :next-disabled))) + (page (max 1 (or (and controller-value + (etaf-value (etaf-data-page controller-value))) + 1))) + (page-size + (max 1 (or (and controller-value + (etaf-value (etaf-data-page-size controller-value))) + 1))) + (total (max 0 (or (and controller-value + (etaf-value (etaf-data-total controller-value))) + 0))) + (pages (max 1 (ceiling (/ (float total) page-size)))) + (loading-p (and controller-value + (eq (etaf-value (etaf-data-status controller-value)) + 'loading))) + (previous-disabled (or loading-p (<= page 1))) + (next-disabled (or loading-p (>= page pages))) (first-item (if (zerop total) 0 (1+ (* (1- page) page-size)))) (last-item (min total (* page page-size)))) @@ -384,10 +332,11 @@ actions; failed candidates cannot mutate committed handler inputs." 'flex (list :class (etaf-ui--class-value "etaf-pagination" nil class) :width 'stretch :flex-direction 'row :align-items 'center + :flex-wrap 'wrap :justify-content 'center :role 'navigation :aria-label (or aria-label "Pagination") :color parent-color :background-color parent-bgcolor :box-sizing 'border-box :padding (or padding '(0 1)) - :gap '(0 (1))) + :gap '(1 (16))) (list (etaf-node 'column @@ -396,19 +345,18 @@ actions; failed candidates cannot mutate committed handler inputs." (list (etaf-node 'etaf-button - (list :label "←" :ref previous-ref + (list :label (or previous-label "‹ Previous") :ref previous-ref :aria-label "Previous page" - :disabled previous-disabled :padding '(0 0) - :border arrow-border - :color (if previous-disabled - (plist-get theme :ui-disabled-fg) - parent-color) - :background-color parent-bgcolor :font-weight 'bold - :on-press (plist-get state :previous)) + :disabled previous-disabled :padding '(0 2) + :variant 'secondary :border border + :color (and (not previous-disabled) color) :bgcolor bgcolor + :on-press + (lambda () (etaf-data-previous-page controller-value))) nil))) (etaf-node 'column - (list :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0) + (list :width 'max-content + :flex-grow 0 :flex-shrink 0 :flex-basis 'auto) (list (etaf-node 'box @@ -428,15 +376,13 @@ actions; failed candidates cannot mutate committed handler inputs." (list (etaf-node 'etaf-button - (list :label "→" :ref next-ref + (list :label (or next-label "Next ›") :ref next-ref :aria-label "Next page" - :disabled next-disabled :padding '(0 0) - :border arrow-border - :color (if next-disabled - (plist-get theme :ui-disabled-fg) - parent-color) - :background-color parent-bgcolor :font-weight 'bold - :on-press (plist-get state :next)) + :disabled next-disabled :padding '(0 2) + :variant 'secondary :border border + :color (and (not next-disabled) color) :bgcolor bgcolor + :on-press + (lambda () (etaf-data-next-page controller-value))) nil))))))) :styles (styles diff --git a/etaf-ui-table.el b/etaf-ui-table.el index f380a3d..42752ad 100644 --- a/etaf-ui-table.el +++ b/etaf-ui-table.el @@ -19,6 +19,32 @@ (plist-get column key) (alist-get key column))) +(defun etaf-ui--table-validate-columns (columns) + "Return COLUMNS after checking stable identities and optional cell functions." + (unless (proper-list-p columns) + (error "ETAF Table :columns must be a proper list")) + (let ((seen (make-hash-table :test #'equal))) + (cl-loop for column in columns for index from 1 do + (let ((key (etaf-ui--column-value column :key)) + (cell (etaf-ui--column-value column :cell)) + (width (etaf-ui--column-value column :width))) + (unless (and key (or (symbolp key) (stringp key) (integerp key))) + (error "ETAF Table column %d :key must be a non-nil symbol, integer, or string; got %S" + index key)) + (when (gethash key seen) + (error "ETAF Table column %d duplicates :key %S; use a unique key and :cell to repeat a field" + index key)) + (puthash key t seen) + (when (and cell (not (functionp cell))) + (error "ETAF Table column %d (%S) :cell must be a function of one row; got %S" + index key cell)) + (when (and (consp width) (eq (car width) 'fr) + (not (and (proper-list-p width) (= (length width) 2) + (numberp (cadr width)) (> (cadr width) 0)))) + (error "ETAF Table column %d (%S) :width must use (fr POSITIVE-WEIGHT); got %S" + index key width))))) + columns) + (defun etaf-ui--table-cell-value (row key) "Return KEY from ROW, accepting a plist, alist, or hash table." (cond @@ -27,7 +53,7 @@ (zerop (% (length row) 2)) (keywordp (car row))) (plist-get row key)) - ((listp row) (alist-get key row)) + ((listp row) (alist-get key row nil nil #'equal)) (t nil))) (defun etaf-ui--table-fit-text (value column) @@ -39,19 +65,34 @@ (truncate-string-to-width value width 0 nil "…") value))) -(defun etaf-ui--table-track-width (column gap-p) - "Return COLUMN width with one character gap when GAP-P is non-nil." - (let ((width (etaf-ui--column-value column :width))) - (if (and gap-p (integerp width) (> width 0)) - (1+ width) - width))) +(defun etaf-ui--table-fixed-text-columns-p (columns) + "Return non-nil when COLUMNS can share the compact fixed-text path." + (and columns + (cl-every + (lambda (column) + (let ((width (etaf-ui--column-value column :width))) + (and (not (etaf-ui--column-value column :cell)) + (integerp width) (> width 0)))) + columns))) -(defun etaf-ui--table-header-cell (column gap-p) - "Return one Label header for COLUMN, adding air when GAP-P is non-nil." +(defun etaf-ui--table-grid (columns cells) + "Allocate CELLS with shared COLUMNS tracks and one character between them." + (etaf-node + 'grid + (list :width 'stretch + :grid-template-columns + (mapcar (lambda (column) + (or (etaf-ui--column-value column :width) 'max-content)) + columns) + :column-gap 1) + cells)) + +(defun etaf-ui--table-header-cell (column) + "Return one header for COLUMN inside its allocated Grid track." (etaf-node 'box (list :class "etaf-table-header-cell" - :width (etaf-ui--table-track-width column gap-p) + :width 'stretch :overflow 'hidden :wrap-mode 'none) (list (etaf-node @@ -64,12 +105,7 @@ (defun etaf-ui--table-fixed-header-text (columns) "Return one fixed-width header string for COLUMNS, or nil." - (when (and columns - (cl-every - (lambda (column) - (let ((width (etaf-ui--column-value column :width))) - (and (integerp width) (> width 0)))) - columns)) + (when (etaf-ui--table-fixed-text-columns-p columns) (mapconcat (lambda (column) (let* ((width (etaf-ui--column-value column :width)) @@ -84,51 +120,52 @@ (defun etaf-ui--table-header (columns) "Return a Table header row for COLUMNS." + (etaf-ui--table-validate-columns columns) (let ((theme (etaf-ui--style-tokens :ui-table-border)) (fixed-text (etaf-ui--table-fixed-header-text columns))) (etaf-node 'row - (list :class "etaf-table-header" - :border-bottom-width 1 :border-bottom-style 'solid - :border-bottom-color (plist-get theme :ui-table-border)) + (append + (unless fixed-text '(:padding (0 0))) + (list :class "etaf-table-header" + :border-bottom-width 1 :border-bottom-style 'solid + :border-bottom-color (plist-get theme :ui-table-border))) (if fixed-text (list (etaf-node 'text nil (list fixed-text))) - (cl-loop for column in columns - for tail on columns - collect - (etaf-ui--table-header-cell column (cdr tail))))))) + (list (etaf-ui--table-grid + columns (mapcar #'etaf-ui--table-header-cell columns))))))) -(defun etaf-ui--table-cell (row column gap-p) - "Return one Label cell for ROW and COLUMN using GAP-P." +(defun etaf-ui--table-cell (row column) + "Return COLUMN's ordinary View cell for ROW inside its allocated track. +Custom cell functions run at this consuming position; Component output owns +its usual Context, styles, state, and lifecycle." (etaf-node 'box - (list :class "etaf-table-cell" - :width (etaf-ui--table-track-width column gap-p) + (list :key (etaf-ui--column-value column :key) + :class "etaf-table-cell" + :width 'stretch + :overflow 'hidden :wrap-mode 'none) (list - (etaf-node - 'text nil - (list - (etaf-ui--table-fit-text - (etaf-ui--table-cell-value - row (etaf-ui--column-value column :key)) - column)))))) + (if-let* ((cell (etaf-ui--column-value column :cell))) + (etaf-view (expr (funcall cell row))) + (etaf-node + 'text nil + (list + (etaf-ui--table-fit-text + (etaf-ui--table-cell-value + row (etaf-ui--column-value column :key)) + column))))))) (defun etaf-ui--table-cells (row columns) "Return cell Components for ROW using COLUMNS." (cl-loop for column in columns - for tail on columns collect - (etaf-ui--table-cell row column (cdr tail)))) + (etaf-ui--table-cell row column))) (defun etaf-ui--table-fixed-row-text (row columns) "Return one fixed-width ROW string for COLUMNS, or nil when not applicable." - (when (and columns - (cl-every - (lambda (column) - (let ((width (etaf-ui--column-value column :width))) - (and (integerp width) (> width 0)))) - columns)) + (when (etaf-ui--table-fixed-text-columns-p columns) (mapconcat (lambda (column) (let* ((width (etaf-ui--column-value column :width)) @@ -143,11 +180,12 @@ (defun etaf-ui--table-row-children (row columns) "Return the smallest presentation-equivalent child list for ROW. -COLUMNS with fixed positive character widths use one padded Text Host; -otherwise retain the general per-cell Box path." +COLUMNS with fixed positive character widths use one padded Text Host. +Other cells always share a Grid parent, preserving their identity when column +widths change between fixed and fractional tracks." (if-let* ((text (etaf-ui--table-fixed-row-text row columns))) (list (etaf-node 'text nil (list text))) - (etaf-ui--table-cells row columns))) + (list (etaf-ui--table-grid columns (etaf-ui--table-cells row columns))))) (defun etaf-ui--table-entries (rows row-key) "Return `(KEY . ROW)' entries for ROWS using ROW-KEY. @@ -160,11 +198,10 @@ ETAF validates keys and uniqueness." (row identity columns row-ref on-row-press row-selected-p) "Return one canonical row Host for ROW and stable IDENTITY. -This helper is shared by the retained presentational Table Component and the -DataGrid's keyed hot path. Keeping the row itself as a Host avoids creating a -second Component boundary for every visible item while preserving the same -selection, event, and style contract. COLUMNS define the visible cells; -ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P define optional interaction." +The retained Table row shares its cell construction with DataGrid's keyed +hot path. COLUMNS define the visible cells; +ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P define optional interaction. +Without ROW-REF the Host receives ETAF's usual instance-local reference." (let* ((callback on-row-press) (row-value row) (interactive-p (not (null callback))) @@ -180,26 +217,29 @@ ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P define optional interaction." (when interactive-p (unless (functionp on-row-press) (error "ETAF Table :on-row-press must be a function")) - (unless (functionp row-ref) - (error "ETAF Table requires :row-ref for interactive rows")) - (setq host-ref (funcall row-ref row)) - (unless host-ref - (error "ETAF Table row reference must be non-nil"))) + (when (and row-ref (not (functionp row-ref))) + (error "ETAF Table :row-ref must be a function")) + (when row-ref + (setq host-ref (funcall row-ref row)) + (unless host-ref + (error "ETAF Table :row-ref must return a non-nil stable ref")))) (etaf-node 'row - (list :key identity - :class (concat "etaf-table-row" (if selected-p " selected" "")) - :ref host-ref :role (when interactive-p 'button) - :tab-index (when interactive-p 0) - :color - (when selected-p (plist-get theme :ui-table-selected-fg)) - :background-color - (when selected-p (plist-get theme :ui-table-selected-bg)) - :border-bottom-width 1 :border-bottom-style 'solid - :border-bottom-color (plist-get theme :ui-table-border) - :on-press - (when interactive-p - (lambda () (funcall callback row-value)))) + (append + (unless (etaf-ui--table-fixed-text-columns-p columns) '(:padding (0 0))) + (list :key identity + :class (concat "etaf-table-row" (if selected-p " selected" "")) + :ref host-ref :role (when interactive-p 'button) + :tab-index (when interactive-p 0) + :color + (when selected-p (plist-get theme :ui-table-selected-fg)) + :background-color + (when selected-p (plist-get theme :ui-table-selected-bg)) + :border-bottom-width 1 :border-bottom-style 'solid + :border-bottom-color (plist-get theme :ui-table-border) + :on-press + (when interactive-p + (lambda () (funcall callback row-value))))) (etaf-ui--table-row-children row columns)))) (etaf-ui--define-component etaf-ui--table-header (&key columns) @@ -224,9 +264,16 @@ ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P define optional interaction." (&key columns rows row-key row-ref on-row-press row-selected-p) "Render ordinary ROWS as a presentational Table. -COLUMNS contain `:key', optional `:label', and optional character `:width'. -ROW-KEY supplies stable identity. Interaction and selection are controlled -optional inputs; Table never owns application or Data Controller state." +COLUMNS contain a unique non-nil `:key', optional `:label', `:width', +and `:cell' function accepting one row and returning ordinary View content. +Integer widths are character capacities; `(fr N)' shares the remaining width +by positive weight N. +Without `:cell', the key reads a text field from the row. Cell state belongs +in a returned Component, whose Context comes from the consuming Table. +ROW-KEY supplies stable identity. ROW-REF is only needed for caller-owned +addresses; interactive rows otherwise receive instance-local references. +Interaction and selection are controlled optional inputs; Table never owns +application or Data Controller state." :view (column :class "etaf-table" diff --git a/scripts/etaf-ui-m0a-inventory.el b/scripts/etaf-ui-m0a-inventory.el index 91cd1d8..b76f974 100644 --- a/scripts/etaf-ui-m0a-inventory.el +++ b/scripts/etaf-ui-m0a-inventory.el @@ -55,8 +55,8 @@ :root-guarantee single-host-root :definition "etaf-ui-data.el") (:name etaf-pagination - :business-props (controller previous-ref next-ref class color bgcolor - border padding aria-label) + :business-props (controller previous-ref next-ref previous-label next-label + class color bgcolor border padding aria-label) :forwarded-host-attrs all-valid-host-attrs :root-guarantee single-host-root :definition "etaf-ui-data.el")) diff --git a/tests/etaf-ui-button-commit-tests.el b/tests/etaf-ui-button-commit-tests.el new file mode 100644 index 0000000..fba01f3 --- /dev/null +++ b/tests/etaf-ui-button-commit-tests.el @@ -0,0 +1,76 @@ +;;; etaf-ui-button-commit-tests.el --- Button callback publication -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Public Button callbacks follow the same commit boundary as their visible UI. + +;;; Code: + +(require 'ert) +(require 'etaf-ui) + +(ert-deftest etaf-ui-button-callback-uses-only-committed-props () + "A later sibling failure cannot replace the live Button callback." + (let ((label (etaf-ref "A")) + (buffer (generate-new-buffer " *button-commit*")) + events) + (unwind-protect + (progn + (etaf-mount + buffer + (lambda () + (let ((caption (etaf-value label))) + (etaf-view + (column + (etaf-button :ref 'button-commit :label caption + :on-press (lambda () (push caption events))) + (text (expr (if (equal (etaf-value label) "Rejected") + (error "Rejected sibling") + "Sibling")))))))) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-dispatch-event runtime 'button-commit 'press) + (setf (etaf-value label) "B") + (etaf-dispatch-event runtime 'button-commit 'press) + (let ((published (with-current-buffer buffer (buffer-string))) + (generation (etaf-runtime-current-generation runtime))) + (should-error (setf (etaf-value label) "Rejected")) + (should (eq generation (etaf-runtime-current-generation runtime))) + (should (equal-including-properties + published (with-current-buffer buffer (buffer-string))))) + (etaf-dispatch-event runtime 'button-commit 'press) + (should (equal '("B" "B" "A") events)) + (setf (etaf-value label) "C") + (etaf-dispatch-event runtime 'button-commit 'press) + (should (equal '("C" "B" "B" "A") events)))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (kill-buffer buffer)))) + +(ert-deftest etaf-ui-button-stable-callback-keeps-handler-identity () + "An unchanged caller callback remains stable through presentation updates." + (let ((label (etaf-ref "A")) + (callback #'ignore) + (buffer (generate-new-buffer " *button-stable-callback*"))) + (unwind-protect + (progn + (etaf-mount + buffer + (lambda () + (etaf-view + (etaf-button :ref 'button-stable :label (etaf-value label) + :on-press callback)))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (handler (cdr (assq 'press + (etaf-runtime-handler-for + runtime 'button-stable))))) + (setf (etaf-value label) "B") + (should (eq handler + (cdr (assq 'press + (etaf-runtime-handler-for + runtime 'button-stable))))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (kill-buffer buffer)))) + +(provide 'etaf-ui-button-commit-tests) +;;; etaf-ui-button-commit-tests.el ends here diff --git a/tests/etaf-ui-cell-tests.el b/tests/etaf-ui-cell-tests.el new file mode 100644 index 0000000..b17c5f0 --- /dev/null +++ b/tests/etaf-ui-cell-tests.el @@ -0,0 +1,706 @@ +;;; etaf-ui-cell-tests.el --- Reusable Table cell contracts -*- lexical-binding: t; -*- + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'etaf-ui) + +(defvar etaf-ui-cell-test--states nil) +(defvar etaf-ui-cell-test--removed nil) +(defvar etaf-ui-cell-test--calls nil) +(defvar etaf-ui-cell-test--disposed nil) +(defvar etaf-ui-cell-test--mounted nil) +(defvar etaf-ui-cell-test--observed nil) + +(defun etaf-ui-cell-test--row-key (row) + "Return ROW's stable identity." + (plist-get row :id)) + +(defun etaf-ui-cell-test--name (row) + "Return ROW's name, recording factory evaluation for locality assertions." + (push (plist-get row :id) etaf-ui-cell-test--calls) + (plist-get row :name)) + +(defun etaf-ui-cell-test--hosts (buffer class) + "Return reference/property pairs for Hosts with CLASS in BUFFER." + (let (hosts) + (maphash + (lambda (ref props) + (when (member class (split-string (or (plist-get props :class) ""))) + (push (cons ref props) hosts))) + (etaf-runtime-host-props (etaf-runtime-for-buffer buffer))) + hosts)) + +(defmacro etaf-ui-cell-test--with-buffer (name &rest body) + "Execute BODY with a temporary mounted buffer bound to NAME." + (declare (indent 1) (debug (symbolp body))) + `(let ((,name (generate-new-buffer " *etaf-ui-cells*"))) + (unwind-protect (progn ,@body) + (when-let* ((runtime (etaf-runtime-for-buffer ,name))) + (etaf-unmount runtime)) + (when (buffer-live-p ,name) (kill-buffer ,name))))) + +(etaf-define-component etaf-ui-cell-test-counter (&key row field value) + "Retain one independent counter at the consuming row/column position." + :setup + (let* ((id (list (plist-get row :id) field)) + (count (etaf-ref 0)) + (ref (make-symbol "etaf-cell-counter"))) + (push (list id count ref) etaf-ui-cell-test--states) + (etaf-on-unmounted (lambda () (push id etaf-ui-cell-test--removed))) + (list count ref)) + :render + (let* ((state (etaf-state)) + (count (car state))) + (etaf-node + 'etaf-button + (list :label (format "%s:%s:%s%s" (plist-get row :id) field + (etaf-value count) (if value (concat ":" value) "")) + :ref (cadr state) + :on-press (lambda () (cl-incf (etaf-value count)))) + nil))) + +(etaf-define-component etaf-ui-cell-test-resource (&key row pulse) + "Expose public lifecycle and subscription observations for one cell." + :setup + (let ((id (plist-get row :id)) + (count (etaf-ref 0)) + (ref (make-symbol "etaf-cell-resource"))) + (push (list id count ref) etaf-ui-cell-test--states) + (etaf-on-scope-dispose + (lambda () (push ref etaf-ui-cell-test--disposed))) + (etaf-on-mounted (lambda () (push ref etaf-ui-cell-test--mounted))) + (etaf-on-unmounted (lambda () (push ref etaf-ui-cell-test--removed))) + (etaf-watch pulse + (lambda (value _old) + (push (cons ref value) etaf-ui-cell-test--observed))) + (list count ref)) + :render + (let ((count (car (etaf-state))) (ref (cadr (etaf-state)))) + (etaf-node + 'etaf-button + (list :label (format "%s:%d" (plist-get row :id) (etaf-value count)) + :ref ref :on-press (lambda () (cl-incf (etaf-value count)))) + nil))) + +(defun etaf-ui-cell-test--counter-column (field) + "Return a custom FIELD column containing independent state." + (list :key field :label (symbol-name field) :width 12 + :cell (lambda (row) + (etaf-node 'etaf-ui-cell-test-counter + (list :row row :field field) nil)))) + +(etaf-define-component etaf-ui-cell-test-context (&key shared) + "Consume Context and Theme where this reusable cell is mounted." + :setup (etaf-inject 'etaf-ui-cell-test-context nil t) + :view + (text :class "cell-context" :color (etaf-theme-token :cell-color) + (expr (format "%s:%d" (etaf-state) (etaf-value shared)))) + :styles (styles (".cell-context" :font-weight bold))) + +(etaf-define-component etaf-ui-cell-test-provider + (&key label color columns controller) + "Provide a local LABEL and COLOR around Table or CONTROLLER's Grid." + :setup + (progn + (etaf-provide 'etaf-ui-cell-test-context label) + (etaf-theme-provide (list :cell-color color)) + nil) + :render + (if controller + (etaf-node 'etaf-data-grid + (list :controller controller :columns columns + :row-key #'etaf-ui-cell-test--row-key) nil) + (etaf-node 'etaf-table + (list :rows '((:id 1)) :columns columns + :row-key #'etaf-ui-cell-test--row-key) nil))) + +(etaf-define-component etaf-ui-cell-test-factory-author + (&key shared controller secret) + "Author one ordinary factory reused under two consumer Contexts." + :setup + (progn + (etaf-provide 'etaf-ui-cell-test-context "Author") + (etaf-theme-provide '(:cell-color "magenta")) + (list shared 'author-private-state)) + :render + (let* ((captured (car (etaf-state))) + (factory + (lambda (_row) + (let ((context (etaf-inject 'etaf-ui-cell-test-context nil t))) + (push (list context + (condition-case nil (etaf-state) + (etaf-component-definition-error 'unavailable)) + (etaf-current-prop 'secret)) + etaf-ui-cell-test--calls) + (etaf-node + 'text + (list :class "cell-author-private cell-factory-consumer" + :color (etaf-theme-token :cell-color)) + (list (format "%s:%d" context (etaf-value captured))))))) + (columns (list (list :key :name :width 18 :cell factory)))) + (etaf-node + 'column nil + (list + (etaf-node 'text '(:class "cell-author-private cell-author-local") + (list secret)) + (etaf-node 'etaf-ui-cell-test-provider + (list :label "Table" :color "red" :columns columns) nil) + (etaf-node 'etaf-ui-cell-test-provider + (list :label "Grid" :color "blue" :columns columns + :controller controller) nil)))) + :styles + (styles (".cell-author-private" :font-weight bold :font-style italic))) + +(ert-deftest etaf-ui-cell-columns-require-unique-non-nil-keys () + "Reject ambiguous column identity with its index and offending key." + (dolist (columns '(((:label "Missing")) + ((:key :name) (:key :name)))) + (etaf-ui-cell-test--with-buffer buffer + (let ((message + (error-message-string + (should-error + (etaf-mount + buffer + (etaf-view + (etaf-table :columns columns :rows nil + :row-key #'etaf-ui-cell-test--row-key))))))) + (should (string-match-p "column" message)) + (should (string-match-p (if (= (length columns) 1) "1" "2") + message)) + (should (string-match-p (if (= (length columns) 1) "nil" ":name") + message)))))) + +(ert-deftest etaf-ui-cell-custom-factory-bypasses-fixed-text () + "Custom fixed-width columns mount their controls as ordinary Views." + (let ((columns (list (list :key :action :width 12 :label "Action" + :cell (lambda (row) + (etaf-node 'text nil + (list (plist-get row :name)))))))) + (should-not (etaf-ui--table-fixed-row-text '(:name "Ada") columns)) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :columns columns :rows '((:id 1 :name "Ada")) + :row-key #'etaf-ui-cell-test--row-key))) + (with-current-buffer buffer + (should (string-match-p "Ada" (buffer-string))))))) + +(ert-deftest etaf-ui-cell-stateless-table-keeps-pure-render-support () + "Automatic row references do not introduce setup state into plain Tables." + (dolist (columns '(((:key :name :width 12)) + ((:key :name :width 12 :cell etaf-ui-cell-test--name)))) + (should + (ebox-canonical-input-p + (etaf-render + (etaf-view + (etaf-table :columns columns :rows '((:id 1 :name "Ada")) + :row-key #'etaf-ui-cell-test--row-key))))))) + +(ert-deftest etaf-ui-cell-shares-factory-with-consumer-context-and-theme () + "One factory uses each Table/Grid's Context and an explicitly shared ref." + (let* ((shared (etaf-ref 0)) + (columns + (list (list :key :context :width 18 + :cell (lambda (_row) + (etaf-node 'etaf-ui-cell-test-context + (list :shared shared) nil))))) + (source (etaf-data-memory-source '((:id 1)) :id-key :id)) + (controller (etaf-data-controller source :auto-load t))) + (unwind-protect + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (column + (etaf-ui-cell-test-provider :label "Table" :color "red" + :columns columns) + (etaf-ui-cell-test-provider :label "Grid" :color "blue" + :columns columns :controller controller)))) + (setf (etaf-value shared) 7) + (with-current-buffer buffer + (should (string-match-p "Table:7" (buffer-string))) + (should (string-match-p "Grid:7" (buffer-string)))) + (let ((hosts (etaf-ui-cell-test--hosts buffer "cell-context"))) + (should (= 2 (length hosts))) + (should (equal '("blue" "red") + (sort (mapcar (lambda (host) + (plist-get (cdr host) :color)) + hosts) + #'string<))) + (dolist (host hosts) + (should (eq 'bold (plist-get (cdr host) :font-weight)))))) + (etaf-data-stop controller)))) + +(ert-deftest etaf-ui-cell-ordinary-output-and-text-mode-switch () + "Accept nil/string/Host/fragment/sequences and return to compact text rows." + (let* ((columns (etaf-ref '((:key :name :label "Name" :width 12)))) + (rows '((:id 1 :name "Default"))) + (factory + (lambda (_row) + (list nil "prefix" (etaf-node 'text nil '("host")) + (etaf-node 'fragment nil '("fragment")))))) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :rows rows :columns (etaf-value columns) + :row-key #'etaf-ui-cell-test--row-key))) + (should-not (etaf-ui-cell-test--hosts buffer "etaf-table-cell")) + (setf (etaf-value columns) + (list (list :key :name :label "Name" :width 30 :cell factory))) + (with-current-buffer buffer + (dolist (word '("prefix" "host" "fragment")) + (should (string-match-p word (buffer-string))))) + (should (= 1 (length (etaf-ui-cell-test--hosts buffer "etaf-table-cell")))) + (setf (etaf-value columns) '((:key :name :label "Name" :width 12))) + (with-current-buffer buffer + (should (string-match-p "Default" (buffer-string)))) + (should-not (etaf-ui-cell-test--hosts buffer "etaf-table-cell"))))) + +(ert-deftest etaf-ui-cell-factory-uses-consumer-context-without-author-scope () + "Ordinary factories consume Context directly and capture business refs only." + (let* ((etaf-ui-cell-test--calls nil) + (shared (etaf-ref 0)) + (source (etaf-data-memory-source '((:id 1)) :id-key :id)) + (controller (etaf-data-controller source :auto-load t))) + (unwind-protect + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-ui-cell-test-factory-author + :shared shared :controller controller :secret "Author secret"))) + (setf (etaf-value shared) 7) + (with-current-buffer buffer + (should (string-match-p "Table:7" (buffer-string))) + (should (string-match-p "Grid:7" (buffer-string)))) + (should + (equal '("Grid" "Table") + (sort (delete-dups (mapcar #'car etaf-ui-cell-test--calls)) + #'string<))) + (dolist (call etaf-ui-cell-test--calls) + (should-not (equal (nth 1 call) (list shared 'author-private-state))) + (should-not (nth 2 call))) + (let ((local (etaf-ui-cell-test--hosts buffer "cell-author-local")) + (cells (etaf-ui-cell-test--hosts buffer "cell-factory-consumer"))) + ;; The author stylesheet is active, so its absence from cells is + ;; evidence of ownership rather than an unloaded stylesheet. + (should (= 1 (length local))) + (should (eq 'bold (plist-get (cdar local) :font-weight))) + (should (eq 'italic (plist-get (cdar local) :font-style))) + (should (= 2 (length cells))) + (should (equal '("blue" "red") + (sort (mapcar (lambda (cell) + (plist-get (cdr cell) :color)) + cells) + #'string<))) + (dolist (cell cells) + (should-not (eq 'bold (plist-get (cdr cell) :font-weight))) + (should-not (eq 'italic (plist-get (cdr cell) :font-style)))))) + (etaf-data-stop controller)))) + +(ert-deftest etaf-ui-cell-factory-rejects-ref-and-watch-creation () + "A factory cannot allocate persistent state or subscriptions during render." + (dolist (operation '(create-ref watch watch-effect)) + (let* ((source (etaf-ref 0)) + (calls 0) + (columns + (list + (list :key :illegal :width 12 + :cell + (lambda (_row) + (pcase operation + ('create-ref (etaf-ref 0)) + ('watch + (etaf-watch source (lambda (&rest _) (cl-incf calls)) + :immediate t)) + ('watch-effect + (etaf-watch-effect + (lambda () (etaf-value source) (cl-incf calls))))) + "Unreachable"))))) + (etaf-ui-cell-test--with-buffer buffer + (let ((failure + (should-error + (etaf-mount + buffer + (etaf-view + (etaf-table :rows '((:id 1)) :columns columns + :row-key #'etaf-ui-cell-test--row-key))) + :type 'etaf-render-side-effect-error))) + (should (equal (cdr failure) (list operation)))) + (should-not (etaf-runtime-for-buffer buffer)) + (setf (etaf-value source) 1) + (should (zerop calls)))))) + +(ert-deftest etaf-ui-cell-table-default-row-refs-are-instance-local () + "Two Tables omit row-ref while retaining distinct, callable row addresses." + (let (pressed) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (column + (etaf-table :columns '((:key :name :label "Name")) + :rows '((:id 1 :name "Left")) + :row-key #'etaf-ui-cell-test--row-key + :on-row-press (lambda (row) (push row pressed))) + (etaf-table :columns '((:key :name :label "Name")) + :rows '((:id 1 :name "Right")) + :row-key #'etaf-ui-cell-test--row-key + :on-row-press (lambda (row) (push row pressed)))))) + (let ((hosts (etaf-ui-cell-test--hosts buffer "etaf-table-row"))) + (should (= 2 (length hosts))) + (should-not (equal (caar hosts) (caadr hosts))) + (dolist (host hosts) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer) (car host) 'press)) + (should (equal '("Left" "Right") + (sort (mapcar (lambda (row) (plist-get row :name)) + pressed) + #'string<))))))) + +(ert-deftest etaf-ui-cell-table-default-row-ref-follows-key () + "An automatic row address survives reorder and reads the committed row." + (let ((rows (etaf-ref '((:id 1 :name "Old") (:id 2 :name "Second")))) + pressed) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :columns '((:key :name :width 12)) + :rows (etaf-value rows) + :row-key #'etaf-ui-cell-test--row-key + :on-row-press (lambda (row) (setq pressed row))))) + (let* ((hosts (etaf-ui-cell-test--hosts buffer "etaf-table-row")) + (ref (car (cl-find 1 hosts + :key (lambda (host) + (plist-get (cdr host) :key)))))) + (should ref) + (setf (etaf-value rows) '((:id 2 :name "Second") (:id 1 :name "New"))) + (should (assoc ref (etaf-ui-cell-test--hosts buffer "etaf-table-row"))) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer) ref 'press) + (should (equal '(:id 1 :name "New") pressed)))))) + +(ert-deftest etaf-ui-cell-row-and-column-reorder-retain-state () + "Counter state follows row and column keys, with one cleanup on deletion." + (let* ((etaf-ui-cell-test--states nil) + (etaf-ui-cell-test--removed nil) + (rows (etaf-ref '((:id 1) (:id 2)))) + (columns (etaf-ref (list (etaf-ui-cell-test--counter-column :a) + (etaf-ui-cell-test--counter-column :b))))) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :columns (etaf-value columns) :rows (etaf-value rows) + :row-key #'etaf-ui-cell-test--row-key))) + (should (= 4 (length etaf-ui-cell-test--states))) + (let* ((state (assoc '(1 :a) etaf-ui-cell-test--states)) + (ref (nth 2 state))) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer) ref 'press) + (setf (etaf-value columns) (reverse (etaf-value columns))) + (setf (etaf-value rows) (reverse (etaf-value rows))) + (should (= 4 (length etaf-ui-cell-test--states))) + (should-not etaf-ui-cell-test--removed) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer) ref 'press) + (should (= 2 (etaf-value (cadr state)))) + (with-current-buffer buffer + (should (string-match-p "1::a:2" (buffer-string))))) + (setf (etaf-value rows) '((:id 2))) + (should (= 2 (length etaf-ui-cell-test--removed))) + (should (member '(1 :a) etaf-ui-cell-test--removed)) + (should (member '(1 :b) etaf-ui-cell-test--removed))))) + +(ert-deftest etaf-ui-cell-grid-reorders-without-remounting-cells () + "DataGrid uses the same retained custom cells while preserving row identity." + (let* ((etaf-ui-cell-test--states nil) + (etaf-ui-cell-test--removed nil) + (source (etaf-data-memory-source '((:id 1) (:id 2)) :id-key :id)) + (controller (etaf-data-controller source :auto-load t)) + (columns (etaf-ref (list (etaf-ui-cell-test--counter-column :a) + (etaf-ui-cell-test--counter-column :b))))) + (unwind-protect + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-data-grid :controller controller :columns (etaf-value columns) + :row-key #'etaf-ui-cell-test--row-key))) + (let* ((state (assoc '(1 :a) etaf-ui-cell-test--states)) + (ref (nth 2 state))) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer) ref 'press) + (setf (etaf-value columns) (reverse (etaf-value columns))) + (setf (etaf-value (etaf-data-items controller)) '((:id 2) (:id 1))) + (should (= 4 (length etaf-ui-cell-test--states))) + (should-not etaf-ui-cell-test--removed) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer) ref 'press) + (should (= 2 (etaf-value (cadr state)))) + (with-current-buffer buffer + (should (string-match-p "1::a:2" (buffer-string))))) + (setf (etaf-value (etaf-data-items controller)) '((:id 2))) + (should (= 2 (length etaf-ui-cell-test--removed)))) + (etaf-data-stop controller)))) + +(ert-deftest etaf-ui-cell-duplicate-field-migration-retains-distinct-state () + "Name and Uppercase read the same field but retain distinct column identities." + (let* ((etaf-ui-cell-test--states nil) + (etaf-ui-cell-test--removed nil) + (rows (etaf-ref '((:id 1 :name "Ada") (:id 2 :name "Lin")))) + (columns + (etaf-ref + (mapcar + (lambda (entry) + (let ((key (car entry)) (transform (cdr entry))) + (list :key key :label (if (eq key :name) "Name" "Uppercase") + :width 24 + :cell + (lambda (row) + (etaf-node 'etaf-ui-cell-test-counter + (list :row row :field key + :value (funcall transform + (plist-get row :name))) + nil))))) + '((:name . identity) (:name-upper . upcase)))))) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :rows (etaf-value rows) :columns (etaf-value columns) + :row-key #'etaf-ui-cell-test--row-key))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (name (assoc '(1 :name) etaf-ui-cell-test--states)) + (upper (assoc '(1 :name-upper) etaf-ui-cell-test--states)) + (other-name (assoc '(2 :name) etaf-ui-cell-test--states)) + (other-upper (assoc '(2 :name-upper) etaf-ui-cell-test--states))) + (should (= 4 (length etaf-ui-cell-test--states))) + (should-not (eq (cadr name) (cadr upper))) + (should-not (eq (nth 2 name) (nth 2 upper))) + (etaf-dispatch-event runtime (nth 2 name) 'press) + (etaf-dispatch-event runtime (nth 2 upper) 'press) + (etaf-dispatch-event runtime (nth 2 upper) 'press) + (setf (etaf-value rows) '((:id 2 :name "Lin") (:id 1 :name "Grace"))) + (setf (etaf-value columns) (reverse (etaf-value columns))) + (should (= 4 (length etaf-ui-cell-test--states))) + (should-not etaf-ui-cell-test--removed) + (etaf-dispatch-event runtime (nth 2 name) 'press) + (etaf-dispatch-event runtime (nth 2 upper) 'press) + (should (= 2 (etaf-value (cadr name)))) + (should (= 3 (etaf-value (cadr upper)))) + (should (zerop (etaf-value (cadr other-name)))) + (should (zerop (etaf-value (cadr other-upper)))) + (with-current-buffer buffer + (dolist (label '("1::name:2:Grace" "1::name-upper:3:GRACE" + "2::name:0:Lin" "2::name-upper:0:LIN")) + (should (string-match-p (regexp-quote label) (buffer-string))))))))) + +(ert-deftest etaf-ui-cell-insert-delete-failure-preserves-scopes-and-handlers () + "Failed replacement disposes only new cells and keeps retired candidates live." + (let* ((etaf-ui-cell-test--states nil) + (etaf-ui-cell-test--removed nil) + (etaf-ui-cell-test--disposed nil) + (etaf-ui-cell-test--mounted nil) + (etaf-ui-cell-test--observed nil) + (initial '((:id 1) (:id 2))) + (rows (etaf-ref initial)) + (pulse (etaf-ref 0)) + (columns + (list + (list :key :action :width 12 + :cell + (lambda (row) + (when (plist-get row :fail) (error "Reject replacement cell")) + (etaf-node 'etaf-ui-cell-test-resource + (list :row row :pulse pulse) nil)))))) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :rows (etaf-value rows) :columns columns + :row-key #'etaf-ui-cell-test--row-key))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (first (assoc 1 etaf-ui-cell-test--states)) + (second (assoc 2 etaf-ui-cell-test--states)) + (first-ref (nth 2 first)) + (second-ref (nth 2 second))) + (etaf-dispatch-event runtime first-ref 'press) + (let ((generation (etaf-runtime-current-generation runtime)) + (text (with-current-buffer buffer (buffer-string)))) + ;; Row 3 has completed setup before row 2 rejects the candidate; + ;; row 1 is absent from that same candidate and must not retire yet. + (should-error + (setf (etaf-value rows) '((:id 3) (:id 2 :fail t))) + :type 'error) + (should (eq generation (etaf-runtime-current-generation runtime))) + (should (equal-including-properties + text (with-current-buffer buffer (buffer-string))))) + (should (= 3 (length etaf-ui-cell-test--states))) + (let ((failed-ref (nth 2 (assoc 3 etaf-ui-cell-test--states)))) + (should failed-ref) + (should (equal (list failed-ref) etaf-ui-cell-test--disposed)) + (should-not (memq failed-ref etaf-ui-cell-test--mounted)) + (should-not etaf-ui-cell-test--removed) + ;; Restore the business source before dispatch can legitimately + ;; retry its still-invalid value at the ordinary batch boundary. + (setf (etaf-value rows) initial) + (should (= 3 (length etaf-ui-cell-test--states))) + (etaf-dispatch-event runtime first-ref 'press) + (etaf-dispatch-event runtime second-ref 'press) + (should (= 2 (etaf-value (cadr first)))) + (should (= 1 (etaf-value (cadr second)))) + (setf (etaf-value pulse) 1) + (should (= 2 (length etaf-ui-cell-test--observed))) + (should (assoc first-ref etaf-ui-cell-test--observed)) + (should (assoc second-ref etaf-ui-cell-test--observed)) + (should-not (assoc failed-ref etaf-ui-cell-test--observed)) + (setf (etaf-value rows) '((:id 3) (:id 2))) + (should (= 4 (length etaf-ui-cell-test--states))) + (let ((new-ref (nth 2 (assoc 3 etaf-ui-cell-test--states)))) + (should-not (eq failed-ref new-ref)) + (should (equal (list first-ref) etaf-ui-cell-test--removed)) + (should (= 3 (length etaf-ui-cell-test--mounted))) + (should (memq new-ref etaf-ui-cell-test--mounted)) + (setq etaf-ui-cell-test--observed nil) + (setf (etaf-value pulse) 2) + (should (= 2 (length etaf-ui-cell-test--observed))) + (should (assoc second-ref etaf-ui-cell-test--observed)) + (should (assoc new-ref etaf-ui-cell-test--observed)) + (etaf-unmount runtime) + (should (= 4 (length etaf-ui-cell-test--disposed))) + (dolist (ref (list first-ref second-ref failed-ref new-ref)) + (should (= 1 (cl-count ref etaf-ui-cell-test--disposed)))) + (should (= 3 (length etaf-ui-cell-test--removed))) + (dolist (ref (list first-ref second-ref new-ref)) + (should (= 1 (cl-count ref etaf-ui-cell-test--removed)))) + (setq etaf-ui-cell-test--observed nil) + (setf (etaf-value pulse) 3) + (should-not etaf-ui-cell-test--observed))))))) + +(ert-deftest etaf-ui-cell-later-factory-error-retains-committed-handler () + "A failed later cell cannot replace an earlier cell's committed callback." + (let* ((rows (etaf-ref '((:id 1 :name "Committed") (:id 2 :name "Later")))) + (first-ref (make-symbol "etaf-cell-first")) + pressed + (columns + (list + (list :key :action :width 16 + :cell + (lambda (row) + (when (plist-get row :fail) (error "Late cell failure")) + (let ((name (plist-get row :name))) + (etaf-node 'box + (list :ref (when (= 1 (plist-get row :id)) + first-ref) + :on-press (lambda () (setq pressed name))) + (list name)))))))) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :rows (etaf-value rows) :columns columns + :row-key #'etaf-ui-cell-test--row-key))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (generation (etaf-runtime-current-generation runtime)) + (text (with-current-buffer buffer (buffer-string)))) + (should-error + (setf (etaf-value rows) + '((:id 1 :name "Candidate") (:id 2 :name "Failure" :fail t)))) + (should (eq generation (etaf-runtime-current-generation runtime))) + (should (equal-including-properties + text (with-current-buffer buffer (buffer-string)))) + (etaf-dispatch-event runtime first-ref 'press) + (should (equal "Committed" pressed)) + (setf (etaf-value rows) '((:id 1 :name "Published") (:id 2))) + (etaf-dispatch-event runtime first-ref 'press) + (should (equal "Published" pressed)))))) + +(ert-deftest etaf-ui-cell-grid-content-update-stays-row-local () + "An item update evaluates one custom cell; selection visits only its delta." + (let* ((etaf-ui-cell-test--calls nil) + (rows (cl-loop for id from 1 to 12 + collect (list :id id :name (format "Row %d" id)))) + (source (etaf-data-memory-source rows :id-key :id)) + (controller (etaf-data-controller source :page-size 12 :auto-load t)) + (columns '((:key :name :width 12 :cell etaf-ui-cell-test--name)))) + (unwind-protect + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-data-grid :controller controller :columns columns + :row-key #'etaf-ui-cell-test--row-key))) + (setq etaf-ui-cell-test--calls nil) + (setf (etaf-value (etaf-data-items controller)) + (mapcar (lambda (row) + (if (= 6 (plist-get row :id)) + '(:id 6 :name "Changed") + row)) + rows)) + (should (equal '(6) etaf-ui-cell-test--calls)) + (etaf-data-select-one controller 1) + (setq etaf-ui-cell-test--calls nil) + (etaf-data-select-one controller 2) + (should (cl-every (lambda (id) (memq id '(1 2))) + etaf-ui-cell-test--calls)) + (should (<= (length etaf-ui-cell-test--calls) 2))) + (etaf-data-stop controller)))) + +(ert-deftest etaf-ui-cell-button-owns-clipped-row-interaction () + "A clipped official Button owns its hit area even while disabled." + (let* ((disabled (etaf-ref t)) + (button-ref (make-symbol "etaf-clipped-cell-button")) + (button-presses 0) + (row-presses 0) + (columns + (list '(:key :name :label "Name" :width 8) + (list :key :action :label "Action" :width 5 + :cell (lambda (_row) + (etaf-node + 'etaf-button + (list :label "ABCDEFGHIJK" :ref button-ref + :disabled (etaf-value disabled) + :on-press (lambda () (cl-incf button-presses))) + nil))) + '(:key :tail :label "Tail" :width 6)))) + (etaf-ui-cell-test--with-buffer buffer + (etaf-mount + buffer + (etaf-view + (etaf-table :columns columns :rows '((:id 1 :name "ITEM" :tail "TAIL")) + :row-key #'etaf-ui-cell-test--row-key + :on-row-press (lambda (_row) (cl-incf row-presses))))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (cell-ref + (car (cl-find :action + (etaf-ui-cell-test--hosts buffer "etaf-table-cell") + :key (lambda (host) (plist-get (cdr host) :key)))))) + (should cell-ref) + (let ((button-bounds (ebox-host-ref-bounds buffer button-ref)) + (cell-bounds (ebox-host-ref-bounds buffer cell-ref))) + (should button-bounds) + (should (<= (car cell-bounds) (car button-bounds))) + (should (<= (cdr button-bounds) (cdr cell-bounds)))) + (with-current-buffer buffer + (goto-char (etaf-host-ref-position runtime button-ref)) + (should-error (etaf-activate runtime) :type 'user-error)) + (should-error (etaf-dispatch-event runtime button-ref 'press) + :type 'etaf-event-error) + (should (zerop button-presses)) + (should (zerop row-presses)) + (setf (etaf-value disabled) nil) + (with-current-buffer buffer + (goto-char (etaf-host-ref-position runtime button-ref)) + (etaf-activate runtime)) + (should (= 1 button-presses)) + (should (zerop row-presses)) + (with-current-buffer buffer + (goto-char (point-min)) + (search-forward "ITEM") + (backward-char) + (etaf-activate runtime) + (should (search-forward "TAIL" nil t))) + (should (= 1 row-presses)))))) + +(provide 'etaf-ui-cell-tests) +;;; etaf-ui-cell-tests.el ends here diff --git a/tests/etaf-ui-docs-tests.el b/tests/etaf-ui-docs-tests.el new file mode 100644 index 0000000..5e5eab3 --- /dev/null +++ b/tests/etaf-ui-docs-tests.el @@ -0,0 +1,85 @@ +;;; etaf-ui-docs-tests.el --- Executable catalog entry docs -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Execute exact README snippets without preloading the UI or a Playground. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defconst etaf-ui-docs-test--root + (file-name-directory + (directory-file-name (file-name-directory (or load-file-name + buffer-file-name)))) + "Absolute path of the UI repository under test.") + +(defun etaf-ui-docs-test--example (file) + "Extract the complete marked preferences example from README FILE." + (with-temp-buffer + (insert-file-contents (expand-file-name file etaf-ui-docs-test--root)) + (goto-char (point-min)) + (should (search-forward + "\n```elisp\n" nil t)) + (let ((start (point))) + (should (re-search-forward "^```$" nil t)) + (buffer-substring-no-properties start (match-beginning 0))))) + +(defun etaf-ui-docs-test--run-fresh (source) + "Mount exact README SOURCE and exercise its controls in a fresh Emacs." + (let ((script (make-temp-file "etaf-ui-readme-" nil ".el"))) + (unwind-protect + (progn + (with-temp-file script + (insert source "\n") + (prin1 + '(let ((runtime (etaf-runtime-for-buffer "*etaf-preferences*"))) + (should runtime) + (with-current-buffer "*etaf-preferences*" + (should (string-match-p "Pending" (buffer-string))) + (should (string-match-p "Unsaved" (buffer-string)))) + (etaf-dispatch-event runtime 'done-checkbox 'press) + (etaf-dispatch-event runtime 'save-button 'press) + (with-current-buffer "*etaf-preferences*" + (should (string-match-p "Complete" (buffer-string))) + (should (string-match-p "Saved" (buffer-string)))) + (etaf-dispatch-event runtime 'done-checkbox 'press) + (with-current-buffer "*etaf-preferences*" + (should (string-match-p "Pending" (buffer-string)))) + (should-not (featurep 'etaf-playground)) + (etaf-unmount runtime)) + (current-buffer))) + (with-temp-buffer + (let ((status + (apply #'call-process + (expand-file-name invocation-name invocation-directory) + nil (current-buffer) nil "-Q" "--batch" + (append + (cl-loop for directory in '("." "../etaf" "../ebox" + "../tp" "../ecss") + append (list "-L" (expand-file-name + directory + etaf-ui-docs-test--root))) + (list "--eval" + (prin1-to-string + '(progn + (require 'ert) + (require 'jka-compr) + (setq load-suffixes '(".el" ".elc") + load-prefer-newer t))) + "-l" script))))) + (unless (equal status 0) + (ert-fail (format "UI README child exited %S:\n%s" + status (buffer-string))))))) + (delete-file script)))) + +(ert-deftest etaf-ui-docs-readmes-mount-and-dispatch-in-fresh-emacs () + "Both catalog READMEs use real names and complete mounted interactions." + (dolist (file '("README.md" "README.zh-CN.md")) + (etaf-ui-docs-test--run-fresh (etaf-ui-docs-test--example file)))) + +(provide 'etaf-ui-docs-tests) +;;; etaf-ui-docs-tests.el ends here diff --git a/tests/etaf-ui-pagination-commit-tests.el b/tests/etaf-ui-pagination-commit-tests.el new file mode 100644 index 0000000..6f9ed2e --- /dev/null +++ b/tests/etaf-ui-pagination-commit-tests.el @@ -0,0 +1,241 @@ +;;; etaf-ui-pagination-commit-tests.el --- Pager callback publication -*- lexical-binding: t; -*- + +;;; Commentary: + +;; A controlled pager must operate on the Controller whose UI was committed. +;; A rejected sibling cannot redirect retained buttons to candidate props. + +;;; Code: + +(require 'ert) +(require 'etaf-ui) + +(defun etaf-ui-pagination-test--controller () + "Return an independently loaded three-page Controller." + (etaf-data-controller + (etaf-data-memory-source '((:id 1) (:id 2) (:id 3)) :id-key :id) + :page-size 1 :auto-load t)) + +(ert-deftest etaf-ui-pagination-failed-controller-swap-keeps-live-callbacks () + "A rejected A-to-B render leaves both pager buttons bound to A." + (dolist (case '((next . 3) (previous . 1))) + (let* ((first (etaf-ui-pagination-test--controller)) + (second (etaf-ui-pagination-test--controller)) + (selected (etaf-ref first)) + (reject t) + (buffer (generate-new-buffer " *pagination-commit*"))) + (unwind-protect + (progn + (etaf-data-set-page first 2) + (etaf-data-set-page second 2) + (etaf-mount + buffer + (lambda () + (etaf-view + (column + (etaf-pagination :controller (etaf-value selected) + :previous-ref 'previous :next-ref 'next) + (text (expr (if (and reject (eq (etaf-value selected) second)) + (error "Rejected pager sibling") + "Accepted sibling"))))))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (generation (etaf-runtime-current-generation runtime)) + (published (with-current-buffer buffer (buffer-string))) + (next-handler (cdr (assq 'press + (etaf-runtime-handler-for runtime 'next))))) + (should-error (setf (etaf-value selected) second)) + (should (eq generation (etaf-runtime-current-generation runtime))) + (should (equal-including-properties + published (with-current-buffer buffer (buffer-string)))) + (should (eq next-handler + (cdr (assq 'press (etaf-runtime-handler-for runtime 'next))))) + ;; Let the event's later render recover. This ordinary flag does + ;; not render or replace the committed callback before the press. + (setq reject nil) + (etaf-dispatch-event runtime (car case) 'press) + (should (= (etaf-value (etaf-data-page first)) (cdr case))) + (should (= (etaf-value (etaf-data-page second)) 2)))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (etaf-data-stop first) + (etaf-data-stop second) + (kill-buffer buffer))))) + +(ert-deftest etaf-ui-pagination-successful-controller-swap-replaces-callbacks () + "A successful controller swap publishes its current values and callbacks." + (let* ((first (etaf-ui-pagination-test--controller)) + (second (etaf-ui-pagination-test--controller)) + (selected (etaf-ref first)) + (caption (etaf-ref "Sibling A")) + (buffer (generate-new-buffer " *pagination-controller-swap*"))) + (unwind-protect + (progn + (etaf-mount + buffer + (lambda () + (etaf-view + (column + (etaf-pagination :controller (etaf-value selected) + :previous-ref 'previous :next-ref 'next) + (text (expr (etaf-value caption))))))) + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (next-handler (cdr (assq 'press + (etaf-runtime-handler-for runtime 'next)))) + (next-bounds (etaf-host-ref-bounds runtime 'next))) + (setf (etaf-value caption) "Sibling B") + (should (eq next-handler + (cdr (assq 'press (etaf-runtime-handler-for runtime 'next))))) + (should (equal next-bounds (etaf-host-ref-bounds runtime 'next))) + (etaf-dispatch-event runtime 'next 'press) + (should (= (etaf-value (etaf-data-page first)) 2)) + (setf (etaf-value selected) second) + (should (string-match-p "Page 1 / 3" + (with-current-buffer buffer (buffer-string)))) + (should-error (etaf-dispatch-event runtime 'previous 'press) + :type 'etaf-event-error) + (etaf-dispatch-event runtime 'next 'press) + (should (= (etaf-value (etaf-data-page second)) 2)) + (should (= (etaf-value (etaf-data-page first)) 2)) + (etaf-dispatch-event runtime 'previous 'press) + (should (= (etaf-value (etaf-data-page second)) 1)) + (should (= (etaf-value (etaf-data-page first)) 2)))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (etaf-data-stop first) + (etaf-data-stop second) + (kill-buffer buffer)))) + +(ert-deftest etaf-ui-pagination-labels-retain-hit-areas-and-disabled-states () + "Localized labels keep complete Button hit areas and boundary semantics." + (let* ((controller (etaf-ui-pagination-test--controller)) + (empty (etaf-data-controller + (etaf-data-memory-source nil :id-key :id) + :page-size 1 :auto-load t)) + (selected (etaf-ref controller)) + (buffer (generate-new-buffer " *pagination-labels*"))) + (unwind-protect + (progn + (etaf-mount + buffer + (lambda () + (etaf-view + (etaf-pagination :controller (etaf-value selected) + :previous-ref 'previous :next-ref 'next + :previous-label "‹ 上一页" :next-label "下一页 ›")))) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (dolist (case '((previous "‹ 上一页" "Previous page") + (next "下一页 ›" "Next page"))) + (let* ((ref (car case)) + (bounds (etaf-host-ref-bounds runtime ref)) + (props (gethash ref (etaf-runtime-host-props runtime)))) + (should bounds) + (should (equal (plist-get props :aria-label) (nth 2 case))) + (with-current-buffer buffer + (let ((text (buffer-substring-no-properties + (car bounds) (cdr bounds)))) + (should (string-match-p (regexp-quote (nth 1 case)) text)) + ;; The clickable Host includes padding on both sides. + (should (> (string-width text) + (string-width (nth 1 case)))))))) + (should-error (etaf-dispatch-event runtime 'previous 'press) + :type 'etaf-event-error) + (etaf-data-set-page controller 3) + (should-error (etaf-dispatch-event runtime 'next 'press) + :type 'etaf-event-error) + (etaf-dispatch-event runtime 'previous 'press) + (should (= (etaf-value (etaf-data-page controller)) 2)) + (setf (etaf-value (etaf-data-status controller)) 'loading) + (dolist (ref '(previous next)) + (should-error (etaf-dispatch-event runtime ref 'press) + :type 'etaf-event-error)) + (setf (etaf-value selected) empty) + (should (string-match-p "0–0 of 0" + (with-current-buffer buffer (buffer-string)))) + (dolist (ref '(previous next)) + (should-error (etaf-dispatch-event runtime ref 'press) + :type 'etaf-event-error)))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (etaf-data-stop controller) + (etaf-data-stop empty) + (kill-buffer buffer)))) + +(ert-deftest etaf-ui-pagination-wraps-complete-controls-in-narrow-space () + "A narrow allocation wraps whole controls without clipping page text." + (let ((controller (etaf-ui-pagination-test--controller)) + (buffer (generate-new-buffer " *pagination-narrow*"))) + (unwind-protect + (progn + (etaf-mount + buffer + (etaf-view + (etaf-pagination :controller controller + :previous-ref 'previous :next-ref 'next))) + (dolist (width '(280 180 140)) + (ebox-surface-update-buffer-viewport buffer width 30) + (with-current-buffer buffer + (let ((text (buffer-string))) + (dolist (label '("‹ Previous" "Next ›" "Page 1 / 3" "1–1 of 3")) + (should (string-match-p (regexp-quote label) text)))) + (goto-char (point-min)) + (while (< (point) (point-max)) + (should (<= (ebox-string-pixel-width + (buffer-substring (line-beginning-position) + (line-end-position))) + (+ width 2))) + (forward-line 1))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (etaf-data-stop controller) + (kill-buffer buffer)))) + +(ert-deftest etaf-ui-pagination-keeps-explicit-colors-and-semantic-defaults () + "Explicit colors remain effective without replacing omitted variant defaults." + (dolist (styles '(nil (:color "#F01234" :bgcolor "#123456" + :border (1 solid "#ABCDEF")))) + (let ((controller (etaf-ui-pagination-test--controller))) + (with-temp-buffer + (unwind-protect + (progn + (etaf-data-set-page controller 2) + (etaf-mount + (current-buffer) + (etaf-node + 'column nil + (list (etaf-node 'etaf-button + '(:label "Reference" :ref reference + :variant secondary) nil) + (etaf-node 'etaf-button + '(:label "Disabled" :ref disabled :disabled t) nil) + (etaf-node 'etaf-pagination + (append (list :controller controller + :previous-ref 'previous :next-ref 'next) + styles) + nil)))) + (let* ((runtime (etaf-runtime-for-buffer (current-buffer))) + (reference (etaf-runtime-host-props-for runtime 'reference)) + (disabled (etaf-runtime-host-props-for runtime 'disabled))) + (dolist (ref '(previous next)) + (let ((props (etaf-runtime-host-props-for runtime ref))) + (should (equal (plist-get props :color) + (or (plist-get styles :color) + (plist-get reference :color)))) + (should (equal (plist-get props :background-color) + (or (plist-get styles :bgcolor) + (plist-get reference :background-color)))) + (when styles + (should (equal (plist-get props :border) + (plist-get styles :border)))))) + (etaf-dispatch-event runtime 'previous 'press) + (let ((props (etaf-runtime-host-props-for runtime 'previous))) + (should (plist-get props :disabled)) + (should (equal (plist-get props :color) (plist-get disabled :color))) + (should (equal (plist-get props :background-color) + (or (plist-get styles :bgcolor) + (plist-get disabled :background-color))))))) + (when-let* ((runtime (etaf-runtime-for-buffer (current-buffer)))) + (etaf-unmount runtime)) + (etaf-data-stop controller)))))) + +(provide 'etaf-ui-pagination-commit-tests) +;;; etaf-ui-pagination-commit-tests.el ends here diff --git a/tests/etaf-ui-table-adaptive-tests.el b/tests/etaf-ui-table-adaptive-tests.el new file mode 100644 index 0000000..ee50355 --- /dev/null +++ b/tests/etaf-ui-table-adaptive-tests.el @@ -0,0 +1,274 @@ +;;; etaf-ui-table-adaptive-tests.el --- Adaptive Table tracks -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Mixed character and fractional columns share one header/row allocation. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'etaf-ui) + +(defvar etaf-ui-adaptive-test--states nil) +(defvar etaf-ui-adaptive-test--removed nil) + +(etaf-define-component etaf-ui-adaptive-test-actions (&key row) + "Keep independent action state in ROW's adaptive table cell." + :setup + (let ((state (list (plist-get row :id) (etaf-ref 0) + (etaf-inject 'adaptive-table-context nil t)))) + (push state etaf-ui-adaptive-test--states) + (etaf-on-unmounted + (lambda () (push (car state) etaf-ui-adaptive-test--removed))) + state) + :render + (let ((count (cadr (etaf-state))) + (id (plist-get row :id))) + (etaf-view + (row :item-gap 1 + (etaf-button :label "Complete" + :ref (intern (format "adaptive-complete-%s" id)) + :on-press (lambda () (cl-incf (etaf-value count)))) + (etaf-button :label "Delete" + :ref (intern (format "adaptive-delete-%s" id)) + :on-press #'ignore))))) + +(defun etaf-ui-adaptive-test--action-cell (row) + "Build ROW's action cell, rejecting explicit bad candidates." + (when (plist-get row :fail) (error "Rejected adaptive cell")) + (etaf-node 'etaf-ui-adaptive-test-actions (list :row row) nil)) + +(etaf-define-component etaf-ui-adaptive-test-provider + (&key rows columns controller theme selected) + "Render a Table or CONTROLLER's DataGrid in the same themed environment." + :setup + (progn + (etaf-provide 'adaptive-table-context "consumer-context") + (etaf-theme-provide theme) + nil) + :render + (let ((selection selected)) + (etaf-node + (if controller 'etaf-data-grid 'etaf-table) + (append + (list :columns columns :row-key (lambda (row) (plist-get row :id)) + :row-ref (lambda (row) (intern (format "adaptive-row-%s" (plist-get row :id)))) + :on-row-press (lambda (row) (setf (etaf-value selection) (plist-get row :id))) + :row-selected-p (lambda (row) (equal (etaf-value selection) (plist-get row :id)))) + (if controller (list :controller controller) (list :rows rows))) + nil))) + +(defun etaf-ui-adaptive-test--columns () + "Return an expanding title and a fixed character action track." + (list '(:key :title :label "Task" :width (fr 1)) + '(:key :actions :label "Actions" :width 22 + :cell etaf-ui-adaptive-test--action-cell))) + +(defun etaf-ui-adaptive-test--x (buffer position) + "Return POSITION's rendered horizontal pixel offset in BUFFER." + (with-current-buffer buffer + (save-excursion + (goto-char position) + (ebox-string-pixel-width + (buffer-substring (line-beginning-position) (point)))))) + +(defun etaf-ui-adaptive-test--background (runtime ref) + "Return the resolved background of RUNTIME's REF, including live paint." + (let ((value (plist-get (gethash ref (etaf-runtime-host-props runtime)) + :background-color))) + (if (tp-paint-slot-p value) + (plist-get (tp-paint-slot-spec value) :background) + value))) + +(defun etaf-ui-adaptive-test--assert-layout (buffer width) + "Check BUFFER's WIDTH, header alignment, and complete action hit targets." + (let* ((runtime (etaf-runtime-for-buffer buffer)) + (header-x + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (search-forward "Actions") + (etaf-ui-adaptive-test--x buffer (- (point) (length "Actions"))))))) + (dolist (id '(1 2)) + (let* ((ref (intern (format "adaptive-complete-%s" id))) + (bounds (etaf-host-ref-bounds runtime ref)) + (row-bounds (etaf-host-ref-bounds runtime (intern (format "adaptive-row-%s" id))))) + (should bounds) + (should (<= (car row-bounds) (car bounds))) + (should (<= (cdr bounds) (cdr row-bounds))) + (should (= header-x (etaf-ui-adaptive-test--x buffer (car bounds)))) + (dolist (control '(complete delete)) + (let* ((button (intern (format "adaptive-%s-%s" control id))) + (button-bounds (etaf-host-ref-bounds runtime button))) + (should button-bounds) + (with-current-buffer buffer + (should (string-match-p + (if (eq control 'complete) "Complete" "Delete") + (buffer-substring-no-properties + (car button-bounds) (cdr button-bounds))))))))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (while (< (point) (point-max)) + (should (<= (ebox-string-pixel-width + (buffer-substring (line-beginning-position) (line-end-position))) + (+ width 2))) + (forward-line 1)))))) + +(ert-deftest etaf-ui-adaptive-columns-reject-invalid-fractional-weights () + "Invalid fractional tracks identify the offending column before mounting." + (dolist (width '((fr) (fr 0) (fr -1) (fr "wide") (fr 1 extra))) + (let ((message + (error-message-string + (should-error + (etaf-render + (etaf-view + (etaf-table + :columns (list (list :key :title :width width)) + :rows nil :row-key #'identity))))))) + (should (string-match-p "column 1 (:title)" message)) + (should (string-match-p "POSITIVE-WEIGHT" message))))) + +(ert-deftest etaf-ui-adaptive-columns-align-and-preserve-actions-on-resize () + "Table and DataGrid allocate matching adaptive tracks through live updates." + (dolist (grid-p '(nil t)) + (let* ((etaf-ui-adaptive-test--states nil) + (etaf-ui-adaptive-test--removed nil) + (rows '((:id 1 :title "A long task title that must fit its assigned track without moving actions") + (:id 2 :title "Short task"))) + (controller (and grid-p (etaf-data-controller + (etaf-data-memory-source rows :id-key :id) + :page-size 10 :auto-load t))) + (selected (etaf-ref nil)) + (theme (etaf-ref '(:ui-fg "#152030" :ui-table-border "#CBD5E1" + :ui-table-selected-bg "#DBEAFE"))) + (buffer (generate-new-buffer " *adaptive-table*"))) + (unwind-protect + (progn + (etaf-mount + buffer + (etaf-view + (etaf-ui-adaptive-test-provider + :rows rows :columns (etaf-ui-adaptive-test--columns) + :controller controller :theme theme :selected selected))) + (let ((runtime (etaf-runtime-for-buffer buffer)) previous-x) + (dolist (width '(420 760 280 420)) + (ebox-surface-update-buffer-viewport buffer width 30) + (etaf-ui-adaptive-test--assert-layout buffer width) + (let* ((bounds (etaf-host-ref-bounds runtime 'adaptive-complete-1)) + (x (etaf-ui-adaptive-test--x buffer (car bounds)))) + (when (= width 760) (should (> x previous-x))) + (setq previous-x x)) + (etaf-dispatch-event runtime 'adaptive-complete-1 'press) + (let* ((id (if (equal (etaf-value selected) 2) 1 2)) + (ref (intern (format "adaptive-row-%s" id)))) + (etaf-dispatch-event runtime ref 'press) + (should (= (etaf-value selected) id)) + (should (equal "#DBEAFE" + (etaf-ui-adaptive-test--background runtime ref))))) + (let ((bounds (etaf-host-ref-bounds runtime 'adaptive-complete-1)) + (selected-ref (intern (format "adaptive-row-%s" (etaf-value selected))))) + (setf (etaf-value theme) + '(:ui-fg "#F1F5F9" :ui-table-border "#475569" + :ui-table-selected-bg "#334155" + :ui-button-primary-bg "#2563EB")) + (etaf-ui-adaptive-test--assert-layout buffer 420) + (should (equal bounds (etaf-host-ref-bounds runtime 'adaptive-complete-1))) + (should (equal "#334155" (etaf-ui-adaptive-test--background + runtime selected-ref))) + (should (equal "#2563EB" (etaf-ui-adaptive-test--background + runtime 'adaptive-complete-1)))) + (should (= 2 (length etaf-ui-adaptive-test--states))) + (should-not etaf-ui-adaptive-test--removed) + (should (= 4 (etaf-value (cadr (assq 1 etaf-ui-adaptive-test--states))))) + (dolist (state etaf-ui-adaptive-test--states) + (should (equal "consumer-context" (nth 2 state)))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) (etaf-unmount runtime)) + (when controller (etaf-data-stop controller)) + (kill-buffer buffer))))) + +(ert-deftest etaf-ui-adaptive-cells-retain-identity-and-failed-candidates () + "Adaptive row/column reorders preserve local state and rollback ownership." + (let* ((etaf-ui-adaptive-test--states nil) + (etaf-ui-adaptive-test--removed nil) + (rows (etaf-ref '((:id 1 :title "First") (:id 2 :title "Second")))) + (columns (etaf-ref (etaf-ui-adaptive-test--columns))) + (theme (etaf-ref nil)) + (selected (etaf-ref nil)) + (buffer (generate-new-buffer " *adaptive-retention*"))) + (unwind-protect + (progn + (etaf-mount + buffer + (etaf-view + (etaf-ui-adaptive-test-provider + :rows (etaf-value rows) :columns (etaf-value columns) + :theme theme :selected selected))) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (ebox-surface-update-buffer-viewport buffer 420 30) + (etaf-dispatch-event runtime 'adaptive-complete-1 'press) + ;; Width is geometry, not cell ownership. Keep the same keys and + ;; action Component through both fixed-to-fr and fr-to-fixed paths. + (dolist (width '(18 (fr 1) 26 (fr 2))) + (setf (etaf-value columns) + (list (list :key :title :label "Task" :width width) + (cadr (etaf-ui-adaptive-test--columns)))) + (should (= 2 (length etaf-ui-adaptive-test--states))) + (should-not etaf-ui-adaptive-test--removed) + (should (= 1 (etaf-value (cadr (assq 1 etaf-ui-adaptive-test--states)))))) + (setf (etaf-value columns) (reverse (etaf-value columns)) + (etaf-value rows) (reverse (etaf-value rows))) + (should (= 2 (length etaf-ui-adaptive-test--states))) + (should-not etaf-ui-adaptive-test--removed) + (let ((text (with-current-buffer buffer (buffer-string))) + (generation (etaf-runtime-current-generation runtime))) + (should-error + (setf (etaf-value rows) + '((:id 1 :title "Candidate") (:id 2 :title "Rejected" :fail t)))) + (should (eq generation (etaf-runtime-current-generation runtime))) + (should (equal-including-properties text (with-current-buffer buffer (buffer-string))))) + (etaf-dispatch-event runtime 'adaptive-complete-1 'press) + (should (= 2 (etaf-value (cadr (assq 1 etaf-ui-adaptive-test--states))))) + (setf (etaf-value rows) '((:id 1 :title "Recovered"))) + (should (equal '(2) etaf-ui-adaptive-test--removed)))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) (etaf-unmount runtime)) + (kill-buffer buffer)))) + +(ert-deftest etaf-ui-table-string-column-keys-read-equal-alist-keys () + "Table and DataGrid read string keys in both fixed and adaptive cells." + (dolist (grid-p '(nil t)) + (dolist (width '(12 (fr 1))) + (let* ((column-key (copy-sequence "name")) + (row-key (copy-sequence "name")) + (rows (list (list (cons :id 1) (cons row-key "Ada")))) + (controller + (and grid-p + (etaf-data-controller + (etaf-data-memory-source rows :id-key :id) + :page-size 10 :auto-load t))) + (buffer (generate-new-buffer " *string-column-key*"))) + (should (equal column-key row-key)) + (should-not (eq column-key row-key)) + (unwind-protect + (progn + (etaf-mount + buffer + (etaf-node + (if grid-p 'etaf-data-grid 'etaf-table) + (append + (list :columns (list (list :key column-key :label "Name" + :width width)) + :row-key (lambda (row) (alist-get :id row))) + (if grid-p (list :controller controller) (list :rows rows))) + nil) + '(:viewport-width 300 :viewport-height 10)) + (should (string-match-p "Ada" (with-current-buffer buffer + (buffer-string))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (when controller (etaf-data-stop controller)) + (kill-buffer buffer)))))) + +(provide 'etaf-ui-table-adaptive-tests) +;;; etaf-ui-table-adaptive-tests.el ends here diff --git a/tests/etaf-ui-tests.el b/tests/etaf-ui-tests.el index bef750f..93e6147 100644 --- a/tests/etaf-ui-tests.el +++ b/tests/etaf-ui-tests.el @@ -79,6 +79,7 @@ :color "explicit-color") (etaf-label :text "Themed" :ref 'themed-label :color nil :bgcolor nil) + (text :ref 'themed-host :color nil :bgcolor nil "Theme defaults") (etaf-panel :title "Styled panel" :ref 'styled-panel))) (etaf-define-component etaf-ui-test-token-theme-fixture () @@ -142,14 +143,19 @@ (let ((styled (etaf-ui-test--props buffer-name 'styled-button)) (custom (etaf-ui-test--props buffer-name 'custom-button)) (themed (etaf-ui-test--props buffer-name 'themed-label)) + (host (etaf-ui-test--props buffer-name 'themed-host)) (panel (etaf-ui-test--props buffer-name 'styled-panel))) (should (equal (plist-get styled :color) "#FFFFFF")) (should (equal (plist-get styled :background-color) "#2F6B43")) (should (equal (plist-get styled :padding) '(0 1))) (should (equal (plist-get custom :color) "explicit-color")) (should (equal (plist-get custom :background-color) "#2F6B43")) - (should (equal (plist-get themed :color) "theme-color")) + ;; Nil fallthrough omits an override; it does not erase Label's + ;; explicit presentation. An omitted Host value uses Theme. + (should (equal (plist-get themed :color) "#252A2E")) (should (equal (plist-get themed :background-color) "theme-bg")) + (should (equal (plist-get host :color) "theme-color")) + (should (equal (plist-get host :background-color) "theme-bg")) (should-not (plist-get themed :padding)) (should (equal (plist-get panel :color) "#252A2E")) (should (equal (plist-get panel :background-color) "#FFFDF8")) @@ -301,11 +307,11 @@ (with-current-buffer buffer-name (let ((face (get-text-property position 'face))) (should (string-match-p "#202C42" (format "%S" face))) - (should (string-match-p "#F4F7FF" (format "%S" face)))))) + (should (string-match-p "#F4F7FF" (format "%S" face))))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-unmount runtime)) (when-let* ((buffer (get-buffer buffer-name))) - (kill-buffer buffer)))))) + (kill-buffer buffer))))) (ert-deftest etaf-ui-button-dispatches-without-retained-press-state () "Buttons dispatch through semantic Host state without local press state." @@ -687,7 +693,7 @@ (kill-buffer buffer))))) (ert-deftest etaf-ui-pagination-is-readable-and-boundary-safe () - "Pagination renders Unicode controls, stable refs, and page boundaries." + "Pagination renders labeled controls, stable refs, and page boundaries." (let* ((source (etaf-data-memory-source '((:id 1) (:id 2) (:id 3) (:id 4) (:id 5)) :id-key :id)) @@ -702,8 +708,8 @@ :previous-ref 'page-previous :next-ref 'page-next))) (should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name))) - (should (string-match-p "←" (etaf-ui-test--text buffer-name))) - (should (string-match-p "→" (etaf-ui-test--text buffer-name))) + (should (string-match-p "‹ Previous" (etaf-ui-test--text buffer-name))) + (should (string-match-p "Next ›" (etaf-ui-test--text buffer-name))) ;; Live Ebox windows reserve two pixels for the exclusive display ;; boundary; the pager must stay inside the corresponding 360px row. (ebox-surface-update-buffer-viewport (get-buffer buffer-name) 358 20) @@ -929,8 +935,7 @@ (progn (setf (etaf-value (etaf-data-status controller)) (car case)) - (setf (etaf-value (etaf-data-items controller)) - (when (eq (car case) 'empty) nil)) + (setf (etaf-value (etaf-data-items controller)) nil) (etaf-mount buffer-name (etaf-view