Polish public ETAF UI components
This commit is contained in:
Kinneyzhang
parent
2d463bb784
commit
cef776e545
2
Makefile
2
Makefile
@ -1,5 +1,5 @@
|
||||
EMACS ?= emacs
|
||||
LOAD_PATH = -L . -L ../etaf -L ../ebox
|
||||
LOAD_PATH = -L . -L ../etaf -L ../ebox -L ../ecss -L ../tp
|
||||
|
||||
.PHONY: all compile test check checkdoc load clean
|
||||
|
||||
|
||||
76
README.md
76
README.md
@ -7,10 +7,78 @@
|
||||
|
||||
(let ((done (etaf-ref nil)))
|
||||
(etaf-view
|
||||
(etaf-checkbox
|
||||
:checked (etaf-value done)
|
||||
:label "Done"
|
||||
:on-change (lambda (next) (setf (etaf-value done) next)))))
|
||||
(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))))))
|
||||
```
|
||||
|
||||
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.
|
||||
|
||||
Button and Checkbox are controlled Components. `etaf-button` accepts `:label`,
|
||||
`:on-press`, `:disabled`, `:ref`, and the small presentation set
|
||||
`:class`, `:color`, `:bgcolor`, `:border`, `:padding`, `:face`, `:tab-index`,
|
||||
and `:aria-label`, plus `:use` for a public Behavior list. An enabled button
|
||||
defaults to role `button` and tab index `0`; a disabled button keeps its label
|
||||
and disabled styling but has no press handler, Behavior, or tab stop.
|
||||
`etaf-checkbox` accepts `:checked`, `:label`,
|
||||
`:on-change`, `:disabled`, `:ref`, and the same presentation props. It exposes
|
||||
role `checkbox`, a stable `:ref`, and tab index `0` while enabled. Its
|
||||
`:on-change` receives the next boolean value; disabled checkboxes have no
|
||||
handler or tab stop.
|
||||
|
||||
Component `:styles` declarations own default appearance. A non-nil
|
||||
presentation prop supplied by the caller wins; an omitted or nil prop leaves
|
||||
the inherited Theme/default style available. Button has the deliberately small
|
||||
`primary`, `secondary`, and `ghost` visual vocabulary; it is a visual variant
|
||||
set, not a second widget taxonomy.
|
||||
|
||||
Enabled buttons and checkboxes expose the same interaction affordances: a hand
|
||||
pointer, `mouse-face` hover feedback, a readable `help-echo`, a numeric tab
|
||||
stop, and a semantic role. Button presses briefly enter a `pressed` visual
|
||||
state. Disabled controls retain their text and disabled appearance but expose
|
||||
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.
|
||||
|
||||
`etaf-label` accepts `:text`, `:face`, `:class`, `:color`, `:bgcolor`, `:width`,
|
||||
`:border`, `:padding`, and `:ref`. `etaf-panel` accepts `:title`, the same
|
||||
surface presentation props, and projects the named `header` slot plus the
|
||||
default slot.
|
||||
|
||||
DataGrid accepts column descriptors, a function-valued `:row-key`, and the
|
||||
optional `:loading-label`, `:error-label`, `:empty-label`, `:selected-key`, or
|
||||
function-valued `:row-selected-p`. When `:on-row-press` is supplied, every
|
||||
row is an interactive button: `:row-ref` is required, must return a non-nil
|
||||
stable Host reference for each row, and the row receives role `button` and
|
||||
tab index `0`. `:on-row-press` receives the row. Without `:on-row-press`, rows
|
||||
have no callback or tab stop. `:row-key` remains a required non-nil stable
|
||||
scalar identity for retained rows.
|
||||
|
||||
`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
|
||||
page is loading or already at the first/last page. It owns no page state and
|
||||
uses the same Button interaction contract.
|
||||
|
||||
Keyboard focus uses ETAF's public runtime ports: call
|
||||
`(etaf-focus-next runtime)` to move through visible Hosts with a numeric
|
||||
non-negative `:tab-index`, and dispatch through
|
||||
`(etaf-dispatch-event runtime ref 'press)` when an action must be invoked by
|
||||
code. Disabled controls and non-interactive DataGrid rows are omitted from
|
||||
that tab order.
|
||||
|
||||
Run `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs` from this directory.
|
||||
|
||||
@ -7,10 +7,67 @@
|
||||
|
||||
(let ((done (etaf-ref nil)))
|
||||
(etaf-view
|
||||
(etaf-checkbox
|
||||
:checked (etaf-value done)
|
||||
:label "Done"
|
||||
:on-change (lambda (next) (setf (etaf-value done) next)))))
|
||||
(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` 文件的结构使用已注册的短标签（`panel`、`label`、`button`、
|
||||
`checkbox`、`data-grid`）。配套 `.el` 文件负责响应式值、Action、Behavior
|
||||
和回调；其中 `etaf-view` 也使用同一组短标签。Elisp 定义和 API 文档仍使用
|
||||
规范的 `etaf-*` 名称。
|
||||
|
||||
Button 和 Checkbox 都是受控组件。`etaf-button` 支持 `:label`、
|
||||
`:on-press`、`:disabled`、`:ref`，以及最小 presentation 属性
|
||||
`:class`、`:color`、`:bgcolor`、`:border`、`:padding`、`:face`、
|
||||
`:tab-index`、`:aria-label` 和公共 Behavior 列表 `:use`。启用按钮默认使用
|
||||
`button` role 和 `tab-index 0`；禁用按钮仍显示标签和禁用样式，但没有 press
|
||||
回调、Behavior，也不进入 tab 顺序。`etaf-checkbox` 支持 `:checked`、`:label`、`:on-change`、
|
||||
`:disabled`、`:ref` 及相同的 presentation 属性。启用时它提供
|
||||
`checkbox` role、稳定的 `:ref` 和 `tab-index 0`；`:on-change` 接收下一个
|
||||
布尔值。禁用 checkbox 没有回调或 tab stop。
|
||||
|
||||
Component 的 `:styles` 声明负责默认外观。调用者提供的非 nil presentation
|
||||
属性会覆盖默认值；省略或传 nil 时，继承的 Theme/默认样式仍可生效。Button
|
||||
只提供刻意收敛的 `primary`、`secondary`、`ghost` 三种视觉 variant；这是
|
||||
视觉状态集合，不是第二套 widget 分类体系。
|
||||
|
||||
启用的 button 和 checkbox 共享同一套交互反馈：小手指针、`mouse-face` 悬停
|
||||
反馈、可读的 `help-echo`、数字 tab stop 和语义 role。Button 按下时短暂进入
|
||||
`pressed` 外观。禁用控件保留文字和禁用样式，但没有回调、指针激活或 tab stop。
|
||||
显式 `:on-*` 回调和 Behavior 回调的组合由 Runtime 负责；UI 包只声明控件和
|
||||
视觉状态。
|
||||
|
||||
间距由父布局负责，而不是由 Button 偷塞。相邻控件应放在带明确横向 `:gap`
|
||||
的 `row`/`flex` 中，这样每个控件的 mouse-face 和命中范围才保持语义独立。
|
||||
|
||||
`etaf-label` 支持 `:text`、`:face`、`:class`、`:color`、`:bgcolor`、`:width`、
|
||||
`:border`、`:padding` 和 `:ref`。`etaf-panel` 支持 `:title`、相同的
|
||||
surface presentation 属性，并投影命名的 `header` slot 和默认 slot。
|
||||
|
||||
DataGrid 支持列描述、函数型 `:row-key`，以及可选的
|
||||
`:loading-label`、`:error-label`、`:empty-label`、`:selected-key` 或函数型
|
||||
`:row-selected-p`。提供 `:on-row-press` 后，每一行都是可交互 button：必须
|
||||
提供 `:row-ref`，它对每一行返回非 nil 的稳定 Host ref；行会获得
|
||||
`button` role 和 `tab-index 0`，且回调接收该行。没有 `:on-row-press` 时，
|
||||
行没有回调或 tab stop。`:row-key` 仍然是 retained row 必须具备的非 nil
|
||||
稳定标量 identity。
|
||||
|
||||
`etaf-pagination` 是受控 Data Component。它接收 Data controller 以及稳定的
|
||||
`:previous-ref`、`:next-ref`，显示易读的 `‹`/`›` 控件和 `Page N / M` 摘要；
|
||||
加载中或已经位于首/末页时会禁用对应动作。它不拥有页码状态，并复用 Button
|
||||
的交互契约。
|
||||
|
||||
键盘焦点使用 ETAF 的公共 Runtime 端口：用
|
||||
`(etaf-focus-next runtime)` 在带数值且非负 `:tab-index` 的可见 Host 之间
|
||||
移动；需要代码触发动作时使用
|
||||
`(etaf-dispatch-event runtime ref 'press)`。禁用控件和不可交互的 DataGrid
|
||||
行不会进入 tab 顺序。
|
||||
|
||||
在该目录运行 `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。
|
||||
|
||||
449
etaf-ui.el
449
etaf-ui.el
@ -19,12 +19,76 @@
|
||||
|
||||
(declare-function etaf-data-status "etaf-data" (controller))
|
||||
(declare-function etaf-data-items "etaf-data" (controller))
|
||||
(declare-function etaf-data-page "etaf-data" (controller))
|
||||
(declare-function etaf-data-page-size "etaf-data" (controller))
|
||||
(declare-function etaf-data-total "etaf-data" (controller))
|
||||
(declare-function etaf-data-previous-page "etaf-data" (controller))
|
||||
(declare-function etaf-data-next-page "etaf-data" (controller))
|
||||
(declare-function text "etaf-view" (&rest arguments))
|
||||
(declare-function row "etaf-view" (&rest arguments))
|
||||
(declare-function column "etaf-view" (&rest arguments))
|
||||
(declare-function expr "etaf-view" (&rest arguments))
|
||||
(declare-function slot "etaf-view" (&rest arguments))
|
||||
|
||||
(defun etaf-ui--class-value (base state custom)
|
||||
"Return BASE and STATE classes with optional CUSTOM classes."
|
||||
(let ((custom (cond
|
||||
((null custom) nil)
|
||||
((listp custom) custom)
|
||||
(t (list custom)))))
|
||||
(mapconcat (lambda (class) (format "%s" class))
|
||||
(cl-remove-if (lambda (class)
|
||||
(or (null class) (equal class "")))
|
||||
(append (list base state) custom))
|
||||
" ")))
|
||||
|
||||
(defun etaf-ui--interactive-surface-properties (label disabled)
|
||||
"Return shared text properties for an interactive LABEL surface.
|
||||
DISABLED selects a non-pointer help description instead of an activation
|
||||
affordance.
|
||||
The properties are deliberately backend-neutral: Ebox turns them into the
|
||||
native Emacs pointer/hover/help affordances while other renderers may ignore
|
||||
the optional text properties and keep the semantic role/event contract."
|
||||
(if disabled
|
||||
(list 'help-echo (format "%s (disabled)" (or label "Control")))
|
||||
(list 'pointer 'hand
|
||||
'mouse-face 'highlight
|
||||
'help-echo (format "%s · RET or mouse-1" (or label "Activate")))))
|
||||
|
||||
(defun etaf-ui--button-view
|
||||
(label on-press disabled ref class color bgcolor border padding face
|
||||
tab-index aria-label use pressed)
|
||||
"Return a Button Host showing LABEL.
|
||||
|
||||
ON-PRESS and USE provide callbacks and Behaviors. DISABLED controls whether
|
||||
the Host is interactive. REF, CLASS, COLOR, BGCOLOR, BORDER, PADDING, FACE,
|
||||
TAB-INDEX, and ARIA-LABEL provide Host identity and presentation."
|
||||
(let ((class-value (etaf-ui--class-value
|
||||
"etaf-button"
|
||||
(cond (disabled "disabled")
|
||||
(pressed "pressed")
|
||||
(t "enabled"))
|
||||
class))
|
||||
(tab-value (unless disabled (or tab-index 0)))
|
||||
(label-value (or aria-label label))
|
||||
(surface (etaf-ui--interactive-surface-properties label disabled)))
|
||||
(if on-press
|
||||
(etaf-view
|
||||
(text :class class-value :role 'button :ref ref :disabled disabled
|
||||
:tab-index tab-value :aria-label label-value
|
||||
:color color :bgcolor bgcolor :border border
|
||||
:padding padding :face face
|
||||
:surface-properties surface
|
||||
:use (unless disabled use) :on-press on-press
|
||||
(expr :value label)))
|
||||
(etaf-view
|
||||
(text :class class-value :role 'button :ref ref :disabled disabled
|
||||
:tab-index tab-value :aria-label label-value
|
||||
:color color :bgcolor bgcolor :border border
|
||||
:padding padding :face face
|
||||
:surface-properties surface
|
||||
:use (unless disabled use) (expr :value label))))))
|
||||
|
||||
(defun etaf-ui--column-value (column key)
|
||||
"Return KEY from COLUMN, accepting a plist or alist descriptor."
|
||||
(if (and (listp column) (keywordp (car column)))
|
||||
@ -45,12 +109,11 @@
|
||||
(defun etaf-ui--grid-header-cell (column)
|
||||
"Return one header View for COLUMN."
|
||||
(etaf-view
|
||||
(text
|
||||
:face 'bold
|
||||
:width (etaf-ui--column-value column :width)
|
||||
(expr :value (format "%s"
|
||||
(or (etaf-ui--column-value column :label)
|
||||
(etaf-ui--column-value column :key)))))))
|
||||
(text :class "etaf-data-grid-header-cell"
|
||||
:width (etaf-ui--column-value column :width)
|
||||
(expr :value (format "%s"
|
||||
(or (etaf-ui--column-value column :label)
|
||||
(etaf-ui--column-value column :key)))))))
|
||||
|
||||
(defun etaf-ui--grid-header (columns)
|
||||
"Return a View header row for COLUMNS."
|
||||
@ -63,127 +126,359 @@
|
||||
"Return one data cell View for ROW and COLUMN."
|
||||
(let ((key (etaf-ui--column-value column :key)))
|
||||
(etaf-view
|
||||
(text
|
||||
:width (etaf-ui--column-value column :width)
|
||||
(expr :value
|
||||
(format "%s" (or (etaf-ui--grid-cell-value row key) "")))))))
|
||||
(text :width (etaf-ui--column-value column :width)
|
||||
(expr :value
|
||||
(format "%s" (or (etaf-ui--grid-cell-value row key) "")))))))
|
||||
|
||||
(defun etaf-ui--grid-cells (row columns)
|
||||
"Return data cell Views for ROW and COLUMNS."
|
||||
(mapcar (lambda (column) (etaf-ui--grid-cell row column)) columns))
|
||||
|
||||
(defun etaf-ui--grid-row (row columns row-key on-row-press)
|
||||
"Return a View row for ROW, COLUMNS, ROW-KEY, and ON-ROW-PRESS."
|
||||
(let ((key (funcall row-key row)))
|
||||
(defun etaf-ui--grid-selected-p (row key selected-key row-selected-p)
|
||||
"Return whether ROW with KEY matches SELECTED-KEY or ROW-SELECTED-P."
|
||||
(or (and row-selected-p (funcall row-selected-p row))
|
||||
(and selected-key (equal key selected-key))))
|
||||
|
||||
(defun etaf-ui--grid-row
|
||||
(row columns row-key row-ref on-row-press selected-key row-selected-p)
|
||||
"Return a View row for ROW and COLUMNS with the DataGrid contract.
|
||||
|
||||
ROW-KEY returns identity; ROW-REF returns the interactive reference;
|
||||
ON-ROW-PRESS, SELECTED-KEY, and ROW-SELECTED-P control state."
|
||||
(let* ((key (funcall row-key row))
|
||||
(interactive-p (not (null on-row-press)))
|
||||
(selected-p (etaf-ui--grid-selected-p
|
||||
row key selected-key row-selected-p))
|
||||
host-ref)
|
||||
(unless key
|
||||
(error "ETAF DataGrid row-key must return a non-nil stable scalar"))
|
||||
(when interactive-p
|
||||
(unless (functionp row-ref)
|
||||
(error "ETAF DataGrid requires :row-ref for interactive rows"))
|
||||
(setq host-ref (funcall row-ref row))
|
||||
(unless host-ref
|
||||
(error "ETAF DataGrid :row-ref must return a non-nil stable ref")))
|
||||
(etaf-view
|
||||
(row
|
||||
:key key
|
||||
:class "etaf-data-grid-row"
|
||||
:on-press (when on-row-press
|
||||
:class (concat "etaf-data-grid-row"
|
||||
(if selected-p " selected" ""))
|
||||
:ref host-ref
|
||||
:role (when interactive-p 'button)
|
||||
:tab-index (when interactive-p 0)
|
||||
:surface-properties
|
||||
(when interactive-p
|
||||
(etaf-ui--interactive-surface-properties
|
||||
(format "Row %s" key) nil))
|
||||
:on-press (when interactive-p
|
||||
(lambda () (funcall on-row-press row)))
|
||||
(expr :value (etaf-ui--grid-cells row columns))))))
|
||||
|
||||
(defun etaf-ui--button-setup ()
|
||||
"Create the retained renderer for one Button instance."
|
||||
(let* ((pressed (etaf-ref nil))
|
||||
(timer nil)
|
||||
(scope (etaf-current-effect-scope))
|
||||
(current-callback nil)
|
||||
(current-press-p nil)
|
||||
(press nil))
|
||||
(setq press
|
||||
(lambda ()
|
||||
(when current-press-p
|
||||
(when (timerp timer)
|
||||
(cancel-timer timer))
|
||||
(setf (etaf-value pressed) t)
|
||||
(unwind-protect
|
||||
(when current-callback
|
||||
(funcall current-callback))
|
||||
(setq timer
|
||||
(run-at-time
|
||||
0.09 nil
|
||||
(lambda ()
|
||||
(when (etaf-effect-scope-active-p scope)
|
||||
(setf (etaf-value pressed) nil)))))))))
|
||||
(etaf-on-unmounted
|
||||
(lambda ()
|
||||
(when (timerp timer)
|
||||
(cancel-timer timer))))
|
||||
(lambda ()
|
||||
(let* ((label (etaf-current-prop :label))
|
||||
(callback (etaf-current-prop :on-press))
|
||||
(disabled (etaf-current-prop :disabled))
|
||||
(use (etaf-current-prop :use))
|
||||
(press-p (and (not disabled) (or callback use))))
|
||||
(setq current-callback callback
|
||||
current-press-p press-p)
|
||||
(let* ((state-pressed (and (not disabled) (etaf-value pressed)))
|
||||
(state-class (cond (disabled "disabled")
|
||||
(state-pressed "pressed")
|
||||
(t "enabled")))
|
||||
(variant (and (not disabled) (etaf-current-prop :variant)))
|
||||
(variant-values
|
||||
(cond
|
||||
((and (eq variant 'secondary) state-pressed)
|
||||
'(:color "#142235" :bgcolor "#B9DED7"
|
||||
:border ((1) solid "#24736C") :face bold))
|
||||
((eq variant 'secondary)
|
||||
'(:color "#142235" :bgcolor "#D9EEEA"
|
||||
:border ((1) solid "#2E8B83") :face bold))
|
||||
((and (eq variant 'ghost) state-pressed)
|
||||
'(:color "#142235" :bgcolor "#EEEAE2"
|
||||
:border ((1) solid "#A79F93") :face normal))
|
||||
((eq variant 'ghost)
|
||||
'(:color "#142235" :bgcolor "#FFFDF8"
|
||||
:border ((1) solid "#C8C1B6") :face normal)))))
|
||||
(etaf-ui--button-view
|
||||
label (and press-p press) disabled (etaf-current-prop :ref)
|
||||
(let ((custom-class (etaf-current-prop :class)))
|
||||
(delq nil (list custom-class state-class)))
|
||||
(or (etaf-current-prop :color)
|
||||
(plist-get variant-values :color))
|
||||
(or (etaf-current-prop :bgcolor)
|
||||
(plist-get variant-values :bgcolor))
|
||||
(or (etaf-current-prop :border)
|
||||
(plist-get variant-values :border))
|
||||
(etaf-current-prop :padding)
|
||||
(or (etaf-current-prop :face)
|
||||
(plist-get variant-values :face))
|
||||
(etaf-current-prop :tab-index)
|
||||
(etaf-current-prop :aria-label)
|
||||
use state-pressed))))))
|
||||
|
||||
;;;###autoload
|
||||
(etaf-define-component etaf-button (&key label on-press disabled ref)
|
||||
(etaf-define-component etaf-button
|
||||
(&key label on-press disabled ref class color bgcolor border padding face
|
||||
tab-index aria-label use variant)
|
||||
"Render a standard pressable button with LABEL and ON-PRESS.
|
||||
|
||||
DISABLED removes the callback and the default focus tab index. Product
|
||||
appearance is ordinary Component styling, not a hidden variant taxonomy."
|
||||
appearance is controlled by VARIANT and the shared interactive surface
|
||||
contract; callers can still override presentation with the ordinary props."
|
||||
:styles
|
||||
(styles
|
||||
("&" :padding (0 1) :border ((1) solid "#687386"))
|
||||
("&.disabled" :color "#8A93A6")
|
||||
("&.enabled" :face bold))
|
||||
:view
|
||||
(text
|
||||
:class (if disabled "etaf-button disabled" "etaf-button enabled")
|
||||
:role 'button
|
||||
:ref ref
|
||||
:disabled disabled
|
||||
:tab-index (unless disabled 0)
|
||||
:on-press (unless disabled on-press)
|
||||
(expr :value label)))
|
||||
("&" :width max-content)
|
||||
("&.disabled" :color "#687386" :bgcolor "#E5E7EB"
|
||||
:border ((1) solid "#9CA3AF") :padding (0 1) :face normal)
|
||||
("&.enabled" :color "#FFFFFF" :bgcolor "#2F6B43"
|
||||
:border ((1) solid "#2F6B43") :padding (0 1) :face bold)
|
||||
("&.pressed" :color "#FFFFFF" :bgcolor "#1E5A56"
|
||||
:border ((1) solid "#174A47") :padding (0 1) :face bold))
|
||||
:setup
|
||||
(etaf-ui--button-setup))
|
||||
|
||||
(defun etaf-ui--checkbox-view
|
||||
(checked label on-change ref disabled class color bgcolor border padding
|
||||
face tab-index aria-label)
|
||||
"Return LABEL checkbox View with captured CHECKED and ON-PRESS.
|
||||
REF, DISABLED, CLASS, COLOR, BGCOLOR, BORDER, PADDING, FACE, TAB-INDEX, and
|
||||
ARIA-LABEL provide its semantic and presentation properties."
|
||||
(etaf-view
|
||||
(row
|
||||
:class (etaf-ui--class-value
|
||||
"etaf-checkbox" (if disabled "disabled" "enabled") class)
|
||||
:role 'checkbox :ref ref :disabled disabled
|
||||
:aria-label (or aria-label label)
|
||||
:tab-index (unless disabled (or tab-index 0))
|
||||
:color color :bgcolor bgcolor :border border :padding padding :face face
|
||||
:surface-properties (etaf-ui--interactive-surface-properties label disabled)
|
||||
:on-press on-change
|
||||
(text :class "etaf-checkbox-mark" (expr :value (if checked "☑" "☐")))
|
||||
(text (expr :value (if label (concat " " label) ""))))))
|
||||
|
||||
;;;###autoload
|
||||
(etaf-define-component etaf-checkbox (&key checked label on-change ref)
|
||||
(etaf-define-component etaf-checkbox
|
||||
(&key checked label on-change ref disabled class color bgcolor border padding
|
||||
face tab-index aria-label)
|
||||
"Render a controlled checkbox with CHECKED, LABEL, and ON-CHANGE.
|
||||
|
||||
ON-CHANGE receives the next boolean value. State ownership stays with the
|
||||
caller, so the Component works with local refs or Data-backed forms."
|
||||
:view
|
||||
(row
|
||||
:class "etaf-checkbox"
|
||||
:role 'checkbox
|
||||
:ref ref
|
||||
:aria-label label
|
||||
:on-press (lambda ()
|
||||
(when on-change
|
||||
(funcall on-change (not checked))))
|
||||
(text :face 'bold (expr :value (if checked "☑" "☐")))
|
||||
(text (expr :value (if label (concat " " label) "")))))
|
||||
:styles
|
||||
(styles
|
||||
("&" :width max-content)
|
||||
("&.disabled" :color "#6B7280" :bgcolor "#EEEAE2"
|
||||
:border ((1) solid "#9CA3AF") :padding (0 1))
|
||||
("&.enabled" :color "#252A2E" :bgcolor "#DCEBDD"
|
||||
:border ((1) solid "#6D8A73") :padding (0 1))
|
||||
(".etaf-checkbox-mark" :face bold :width 1))
|
||||
:setup
|
||||
(let* ((current-checked nil)
|
||||
(current-callback nil)
|
||||
(press
|
||||
(lambda ()
|
||||
(when current-callback
|
||||
(funcall current-callback (not current-checked))))))
|
||||
(lambda ()
|
||||
(setq current-checked (etaf-current-prop :checked)
|
||||
current-callback
|
||||
(when (and (not (etaf-current-prop :disabled))
|
||||
(etaf-current-prop :on-change))
|
||||
(etaf-current-prop :on-change)))
|
||||
(etaf-ui--checkbox-view
|
||||
current-checked (etaf-current-prop :label)
|
||||
(and current-callback press)
|
||||
(etaf-current-prop :ref) (etaf-current-prop :disabled)
|
||||
(etaf-current-prop :class) (etaf-current-prop :color)
|
||||
(etaf-current-prop :bgcolor) (etaf-current-prop :border)
|
||||
(etaf-current-prop :padding) (etaf-current-prop :face)
|
||||
(etaf-current-prop :tab-index) (etaf-current-prop :aria-label)))))
|
||||
|
||||
;;;###autoload
|
||||
(etaf-define-component etaf-label (&key text face)
|
||||
"Render TEXT as a semantic label with optional FACE."
|
||||
(etaf-define-component etaf-label
|
||||
(&key text face class color bgcolor border padding ref width)
|
||||
"Render TEXT as a semantic label with presentation properties."
|
||||
:view
|
||||
(text :face face (expr :value text)))
|
||||
(expr
|
||||
:value
|
||||
(etaf-view
|
||||
(text :class class :face face :color color :bgcolor bgcolor :border border
|
||||
:padding padding :ref ref :width width (expr :value text)))))
|
||||
|
||||
;;;###autoload
|
||||
(etaf-define-component etaf-panel (&key title)
|
||||
(etaf-define-component etaf-panel
|
||||
(&key title class color bgcolor border padding ref)
|
||||
"Render a titled panel with header and default slot projections."
|
||||
:styles
|
||||
(styles
|
||||
("&" :padding (1 2) :border ((1) solid "#687386"))
|
||||
("&" :padding (1 2) :border ((1) solid "#687386")
|
||||
:color "#252A2E" :bgcolor "#FFFDF8")
|
||||
(".etaf-panel-title" :face bold))
|
||||
:view
|
||||
(column
|
||||
:class "etaf-panel"
|
||||
(expr
|
||||
:value
|
||||
(when title
|
||||
(etaf-view (text :class "etaf-panel-title"
|
||||
(expr :value title)))))
|
||||
(slot :name 'header)
|
||||
(slot)))
|
||||
(expr
|
||||
:value
|
||||
(etaf-view
|
||||
(column
|
||||
:class (etaf-ui--class-value "etaf-panel" nil class)
|
||||
:color color :bgcolor bgcolor :border border :padding padding :ref ref
|
||||
(expr
|
||||
:value
|
||||
(when title
|
||||
(etaf-view (text :class "etaf-panel-title"
|
||||
(expr :value title)))))
|
||||
(slot :name 'header)
|
||||
(slot)))))
|
||||
|
||||
;;;###autoload
|
||||
(etaf-define-component etaf-data-grid
|
||||
(&key controller columns row-key on-row-press
|
||||
loading-label error-label empty-label)
|
||||
row-ref selected-key row-selected-p loading-label error-label
|
||||
empty-label)
|
||||
"Render rows from reactive DATA CONTROLLER and COLUMNS.
|
||||
|
||||
COLUMNS is a list of descriptors such as `(:key :name :label NAME)'. ROW-KEY
|
||||
receives each row and must return a stable scalar identity. Data owns loading,
|
||||
errors, pagination, mutation, and selection; this Component only projects
|
||||
those values into ordinary Hosts."
|
||||
those values into ordinary Hosts. Interactive rows require ROW-REF to return
|
||||
a stable Host reference."
|
||||
:styles
|
||||
(styles
|
||||
(".etaf-data-grid-header" :face bold :padding (0 1)
|
||||
:border ((1) solid "#687386"))
|
||||
(".etaf-data-grid-header-cell" :face bold)
|
||||
(".etaf-data-grid-row" :padding (0 1)
|
||||
:border ((1) solid "#687386"))
|
||||
(".selected" :color "#2F6B43" :bgcolor "#DCEBDD" :face bold)
|
||||
(".etaf-data-grid-error" :color "#FF6B6B"))
|
||||
:view
|
||||
(column
|
||||
:class "etaf-data-grid"
|
||||
(expr :value (etaf-ui--grid-header columns))
|
||||
(expr
|
||||
:value
|
||||
(progn
|
||||
(unless (functionp row-key)
|
||||
(error "ETAF DataGrid requires a function-valued :row-key"))
|
||||
(let ((status (etaf-value (etaf-data-status controller)))
|
||||
(items (etaf-value (etaf-data-items controller))))
|
||||
(cond
|
||||
((eq status 'loading)
|
||||
(etaf-view (text (expr :value (or loading-label "Loading...")))))
|
||||
((eq status 'error)
|
||||
(etaf-view
|
||||
(text :color "#FF6B6B"
|
||||
(expr :value (or error-label "Unable to load data.")))))
|
||||
((null items)
|
||||
(etaf-view (text (expr :value (or empty-label "No data.")))))
|
||||
(t
|
||||
(mapcar (lambda (item)
|
||||
(etaf-ui--grid-row item columns row-key on-row-press))
|
||||
items))))))
|
||||
(column
|
||||
:class "etaf-data-grid-body"
|
||||
(expr
|
||||
:value
|
||||
(progn
|
||||
(unless (functionp row-key)
|
||||
(error "ETAF DataGrid requires a function-valued :row-key"))
|
||||
(when (and on-row-press (not (functionp on-row-press)))
|
||||
(error "ETAF DataGrid :on-row-press must be a function"))
|
||||
(when (and on-row-press (not (functionp row-ref)))
|
||||
(error "ETAF DataGrid requires :row-ref for interactive rows"))
|
||||
(when (and row-selected-p (not (functionp row-selected-p)))
|
||||
(error "ETAF DataGrid :row-selected-p must be a function"))
|
||||
(let ((status (etaf-value (etaf-data-status controller)))
|
||||
(items (etaf-value (etaf-data-items controller))))
|
||||
(cond
|
||||
((eq status 'loading)
|
||||
(etaf-view (text (expr :value (or loading-label "Loading...")))))
|
||||
((eq status 'error)
|
||||
(etaf-view
|
||||
(text :class "etaf-data-grid-error"
|
||||
(expr :value (or error-label "Unable to load data.")))))
|
||||
((null items)
|
||||
(etaf-view (text (expr :value (or empty-label "No data.")))))
|
||||
(t
|
||||
(mapcar (lambda (item)
|
||||
(etaf-ui--grid-row
|
||||
item columns row-key row-ref on-row-press
|
||||
selected-key row-selected-p))
|
||||
items)))))))
|
||||
(slot :name 'footer)))
|
||||
|
||||
;;;###autoload
|
||||
(etaf-define-component etaf-pagination
|
||||
(&key controller previous-ref next-ref class color bgcolor border padding
|
||||
aria-label)
|
||||
"Render a compact, accessible pager for DATA CONTROLLER.
|
||||
|
||||
The pager owns no data state: page, page-size, total, loading, and error stay
|
||||
with CONTROLLER. PREVIOUS-REF and NEXT-REF should be stable public refs when
|
||||
the pager participates in keyboard/mouse interaction. The visible glyphs
|
||||
(`‹' and `›') are paired with labels and help text so the compact control is
|
||||
readable in both GUI and text review."
|
||||
:styles
|
||||
(styles
|
||||
("&" :width stretch :padding (0 1))
|
||||
(".etaf-pagination-label" :face bold)
|
||||
(".etaf-pagination-summary" :color "#526174"))
|
||||
:setup
|
||||
(let* ((current-controller nil)
|
||||
(previous
|
||||
(lambda ()
|
||||
(when current-controller
|
||||
(etaf-data-previous-page current-controller))))
|
||||
(next
|
||||
(lambda ()
|
||||
(when current-controller
|
||||
(etaf-data-next-page current-controller)))))
|
||||
(lambda ()
|
||||
(let* ((controller-value (etaf-current-prop :controller))
|
||||
(page (max 1 (or (etaf-value (etaf-data-page controller-value)) 1)))
|
||||
(page-size (max 1 (or (etaf-value (etaf-data-page-size controller-value)) 1)))
|
||||
(total (max 0 (or (etaf-value (etaf-data-total controller-value)) 0)))
|
||||
(pages (max 1 (ceiling (/ (float total) page-size))))
|
||||
(status (etaf-value (etaf-data-status controller-value)))
|
||||
(first-item (if (zerop total) 0 (1+ (* (1- page) page-size))))
|
||||
(last-item (min total (* page page-size)))
|
||||
(previous-disabled (or (eq status 'loading) (<= page 1)))
|
||||
(next-disabled (or (eq status 'loading) (>= page pages))))
|
||||
(setq current-controller controller-value)
|
||||
(etaf-view
|
||||
(row :class (etaf-ui--class-value "etaf-pagination" nil
|
||||
(etaf-current-prop :class))
|
||||
:role 'navigation
|
||||
:aria-label (or (etaf-current-prop :aria-label) "Pagination")
|
||||
:color (etaf-current-prop :color)
|
||||
:bgcolor (etaf-current-prop :bgcolor)
|
||||
:border (etaf-current-prop :border)
|
||||
:padding (etaf-current-prop :padding)
|
||||
(button :label "‹" :ref (etaf-current-prop :previous-ref)
|
||||
:aria-label "Previous page"
|
||||
:disabled previous-disabled
|
||||
:variant 'secondary
|
||||
:on-press (unless previous-disabled previous))
|
||||
(column :width 'stretch
|
||||
(text :class "etaf-pagination-label" :text-align 'center
|
||||
(expr :value (format "Page %d / %d" page pages)))
|
||||
(text :class "etaf-pagination-summary" :text-align 'center
|
||||
(expr :value (format "%d–%d of %d"
|
||||
first-item last-item total))))
|
||||
(button :label "›" :ref (etaf-current-prop :next-ref)
|
||||
:aria-label "Next page"
|
||||
:disabled next-disabled
|
||||
:variant 'secondary
|
||||
:on-press (unless next-disabled next))))))))
|
||||
|
||||
(provide 'etaf-ui)
|
||||
|
||||
;;; etaf-ui.el ends here
|
||||
|
||||
26
postmortem/2026-08-19-interaction-contract.en.md
Normal file
26
postmortem/2026-08-19-interaction-contract.en.md
Normal file
@ -0,0 +1,26 @@
|
||||
# Decision: Keep interaction contracts in `etaf-ui`
|
||||
|
||||
## Context
|
||||
|
||||
The playground needs components that remain visibly meaningful and keyboard
|
||||
addressable when its `.etaf` structure and Elisp callbacks are mounted through
|
||||
the public ETAF Runtime. Bare text Hosts made enabled controls hard to see,
|
||||
while disabled controls could still look focusable. DataGrid rows also lacked a
|
||||
public identity for dispatch and focus.
|
||||
|
||||
## Decision
|
||||
|
||||
Button and Checkbox own their disabled semantics: they keep visible state but
|
||||
remove their callback and tab index when disabled. Enabled controls publish a
|
||||
role, stable ref, and default tab index. DataGrid keeps stable scalar
|
||||
`row-key` validation and requires an explicit `row-ref` callback for
|
||||
interactive rows; only those rows publish button semantics and tab index.
|
||||
Selection is represented by the small `selected-key`/`row-selected-p` props.
|
||||
|
||||
These rules belong in the catalog because they are component invariants, not
|
||||
playground styling. Making each example re-add them would create divergent
|
||||
event and focus behavior and would hide failures behind example-only
|
||||
compensation.
|
||||
|
||||
The dynamic DataGrid rows are nested under a stable body Host so adding or
|
||||
removing rows does not invalidate the retained header/footer surface scope.
|
||||
23
postmortem/2026-08-19-interaction-contract.zh-CN.md
Normal file
23
postmortem/2026-08-19-interaction-contract.zh-CN.md
Normal file
@ -0,0 +1,23 @@
|
||||
# 决策：由 `etaf-ui` 持有交互契约
|
||||
|
||||
## 背景
|
||||
|
||||
Playground 需要让 `.etaf` 结构和 Elisp 回调通过公共 ETAF Runtime 挂载后，
|
||||
组件仍然清晰可见并可用键盘访问。原本的纯文本 Host 不像可操作控件，禁用
|
||||
控件也可能看起来仍可聚焦；DataGrid 行还缺少用于 dispatch 和 focus 的公共
|
||||
identity。
|
||||
|
||||
## 决策
|
||||
|
||||
Button 和 Checkbox 自己负责 disabled 语义：保留可见状态，但禁用时移除回调
|
||||
和 tab index；启用时发布 role、稳定 ref 和默认 tab index。DataGrid 保留稳定
|
||||
标量 `row-key` 校验，并要求交互行通过显式 `row-ref` 回调得到稳定 Host ref；
|
||||
只有交互行发布 button 语义和 tab index。选中状态只使用最小的
|
||||
`selected-key`/`row-selected-p` 属性。
|
||||
|
||||
这些规则属于目录组件，因为它们是组件不变量，而不是 Playground 的样式。
|
||||
如果每个示例重新补齐，就会产生分叉的事件与焦点行为，并把错误隐藏在仅供
|
||||
示例使用的补偿逻辑中。
|
||||
|
||||
DataGrid 动态行放在稳定的 body Host 下，增删行时不会使 retained header/footer
|
||||
的 surface scope 失效。
|
||||
@ -8,17 +8,134 @@
|
||||
(with-current-buffer buffer-name
|
||||
(string-trim-right (substring-no-properties (buffer-string)))))
|
||||
|
||||
(ert-deftest etaf-ui-button-dispatches-controlled-press ()
|
||||
"Render a button and dispatch its public Host callback."
|
||||
(defun etaf-ui-test--props (buffer-name ref)
|
||||
"Return mounted Host properties for REF in BUFFER-NAME."
|
||||
(gethash ref
|
||||
(etaf-runtime-host-props
|
||||
(etaf-runtime-for-buffer buffer-name))))
|
||||
|
||||
(defun etaf-ui-test--props-with-key (buffer-name key)
|
||||
"Return mounted Host properties with Host KEY in BUFFER-NAME."
|
||||
(let (found)
|
||||
(maphash
|
||||
(lambda (_ref props)
|
||||
(when (equal (plist-get props :key) key)
|
||||
(setq found props)))
|
||||
(etaf-runtime-host-props (etaf-runtime-for-buffer buffer-name)))
|
||||
found))
|
||||
|
||||
(defun etaf-ui-test--surface-properties (buffer-name ref)
|
||||
"Return interactive text properties at REF's first rendered position."
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||
(position (etaf-host-ref-position runtime ref)))
|
||||
(with-current-buffer buffer-name
|
||||
(list (get-text-property position 'pointer)
|
||||
(get-text-property position 'mouse-face)
|
||||
(get-text-property position 'help-echo)))))
|
||||
|
||||
(defvar etaf-ui-test-use-count 0)
|
||||
|
||||
(etaf-define-behavior etaf-ui-test-press-behavior (&rest attributes)
|
||||
"Install a press callback that increments `etaf-ui-test-use-count'."
|
||||
(apply #'etaf-behavior-create
|
||||
'etaf-ui-test-press
|
||||
(append attributes
|
||||
(list :on-press
|
||||
(lambda () (cl-incf etaf-ui-test-use-count))))))
|
||||
|
||||
(etaf-define-component etaf-ui-test-theme-fixture ()
|
||||
"Provide Theme defaults for official Component presentation tests."
|
||||
:setup
|
||||
(progn
|
||||
(etaf-theme-provide '(:color "theme-color"
|
||||
:bgcolor "theme-bg"
|
||||
:padding (9 9)))
|
||||
(lambda ()
|
||||
(etaf-view
|
||||
(row
|
||||
(button :label "Styled" :ref 'styled-button)
|
||||
(button :label "Custom" :ref 'custom-button
|
||||
:color "explicit-color")
|
||||
(label :text "Themed" :ref 'themed-label
|
||||
:color nil :bgcolor nil)
|
||||
(panel :title "Styled panel" :ref 'styled-panel))))))
|
||||
|
||||
(ert-deftest etaf-ui-button-use-behavior-dispatches-through-host ()
|
||||
"Install Button `:use' Behavior and dispatch its merged callback."
|
||||
(let ((buffer-name " *etaf-ui-button-use-test*"))
|
||||
(setq etaf-ui-test-use-count 0)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(button :label "Behavior" :ref 'behavior-button
|
||||
:use (list (etaf-ui-test-press-behavior)))))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'behavior-button 'press)
|
||||
(should (= etaf-ui-test-use-count 1)))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-defaults-use-styles-and-preserve-theme ()
|
||||
"Use Component styles for defaults and Theme for omitted properties."
|
||||
(let ((buffer-name " *etaf-ui-style-default-test*"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name
|
||||
(etaf-view (ui-test-theme-fixture)))
|
||||
(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))
|
||||
(panel (etaf-ui-test--props buffer-name 'styled-panel)))
|
||||
(should (equal (plist-get styled :color) "#FFFFFF"))
|
||||
(should (equal (plist-get styled :bgcolor) "#2F6B43"))
|
||||
(should (equal (plist-get styled :padding) '(0 1)))
|
||||
(should (equal (plist-get custom :color) "explicit-color"))
|
||||
(should (equal (plist-get custom :bgcolor) "#2F6B43"))
|
||||
(should (equal (plist-get themed :color) "theme-color"))
|
||||
(should (equal (plist-get themed :bgcolor) "theme-bg"))
|
||||
(should (equal (plist-get themed :padding) '(9 9)))
|
||||
(should (equal (plist-get panel :color) "#252A2E"))
|
||||
(should (equal (plist-get panel :bgcolor) "#FFFDF8"))
|
||||
(should (equal (plist-get panel :padding) '(1 2)))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-button-dispatches-and-exposes-enabled-props ()
|
||||
"Render an enabled button with semantic and presentation properties."
|
||||
(let ((buffer-name " *etaf-ui-button-test*")
|
||||
(presses 0))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name
|
||||
(etaf-view
|
||||
(etaf-button :label "Save" :ref 'save
|
||||
(button :label "Save" :ref 'save
|
||||
:class "primary"
|
||||
:color "#FFFFFF"
|
||||
:bgcolor "#2F6B43"
|
||||
:border "#2F6B43"
|
||||
:padding '(0 2)
|
||||
:face 'bold
|
||||
:tab-index 3
|
||||
:aria-label "Save changes"
|
||||
:on-press (lambda () (cl-incf presses)))))
|
||||
(should (string-match-p "Save" (etaf-ui-test--text buffer-name)))
|
||||
(let ((props (etaf-ui-test--props buffer-name 'save)))
|
||||
(should (equal (plist-get props :role) 'button))
|
||||
(should (eq (plist-get props :width) 'max-content))
|
||||
(should (equal (plist-get props :tab-index) 3))
|
||||
(should (equal (plist-get props :aria-label) "Save changes"))
|
||||
(should (equal (plist-get props :color) "#FFFFFF"))
|
||||
(should (equal (plist-get props :bgcolor) "#2F6B43"))
|
||||
(should (equal (plist-get props :border) "#2F6B43"))
|
||||
(should (equal (plist-get props :padding) '(0 2)))
|
||||
(should (equal (plist-get props :face) 'bold))
|
||||
(should (string-match-p "primary" (plist-get props :class))))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'save 'press)
|
||||
(should (= presses 1)))
|
||||
@ -27,63 +144,376 @@
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-checkbox-emits-next-value ()
|
||||
"Render a controlled checkbox and emit its next checked value."
|
||||
(let ((buffer-name " *etaf-ui-checkbox-test*") next)
|
||||
(ert-deftest etaf-ui-button-disabled-is-not-interactive ()
|
||||
"A disabled button has no callback and is not a focus candidate."
|
||||
(let ((buffer-name " *etaf-ui-disabled-button-test*")
|
||||
(presses 0))
|
||||
(setq etaf-ui-test-use-count 0)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name
|
||||
(etaf-view
|
||||
(etaf-checkbox :label "Done" :ref 'done
|
||||
:on-change (lambda (value)
|
||||
(setq next value)))))
|
||||
(should (string-match-p "☐ Done" (etaf-ui-test--text buffer-name)))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'done 'press)
|
||||
(should (eq next t)))
|
||||
(row
|
||||
(button :label "Save" :ref 'enabled-save
|
||||
:on-press (lambda () (cl-incf presses)))
|
||||
(button :label "Delete" :ref 'disabled-delete
|
||||
:disabled t
|
||||
:use (list (etaf-ui-test-press-behavior))
|
||||
:on-press (lambda () (cl-incf presses))))))
|
||||
(let ((props (etaf-ui-test--props buffer-name 'enabled-save)))
|
||||
(should (equal (plist-get props :color) "#FFFFFF"))
|
||||
(should (equal (plist-get props :bgcolor) "#2F6B43"))
|
||||
(should (equal (plist-get props :padding) '(0 1)))
|
||||
(should (equal (plist-get props :face) 'bold)))
|
||||
(let ((props (etaf-ui-test--props buffer-name 'disabled-delete)))
|
||||
(should (eq (plist-get props :disabled) t))
|
||||
(should-not (plist-get props :tab-index))
|
||||
(should (equal (plist-get props :bgcolor) "#E5E7EB"))
|
||||
(should (string-match-p "disabled" (plist-get props :class))))
|
||||
(should-error
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'disabled-delete 'press)
|
||||
:type 'etaf-event-error)
|
||||
(etaf-focus-next (etaf-runtime-for-buffer buffer-name))
|
||||
(should (eq (etaf-focused-host-ref
|
||||
(etaf-runtime-for-buffer buffer-name))
|
||||
'enabled-save))
|
||||
(should (= presses 0))
|
||||
(should (= etaf-ui-test-use-count 0)))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-panel-uses-common-slots ()
|
||||
"Project a named header and default body through the common slot model."
|
||||
(let ((text (substring-no-properties
|
||||
(ebox-render
|
||||
(etaf-render
|
||||
(etaf-view
|
||||
(etaf-panel :title "Account"
|
||||
(slot :name 'header (text "Settings"))
|
||||
(text "Body"))))))))
|
||||
(dolist (label '("Account" "Settings" "Body"))
|
||||
(should (string-match-p (regexp-quote label) text)))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-projects-reactive-controller ()
|
||||
"Render DataGrid rows and update them through the Data Controller."
|
||||
(let* ((source (etaf-data-memory-source
|
||||
'((:id 1 :name "Ada") (:id 2 :name "Grace"))
|
||||
:id-key :id))
|
||||
(controller (etaf-data-controller source :page-size 10 :auto-load t))
|
||||
(buffer-name " *etaf-ui-grid-test*"))
|
||||
(ert-deftest etaf-ui-button-owns-pointer-hover-and-pressed-feedback ()
|
||||
"Buttons expose native pointer/hover affordances and a pressed state."
|
||||
(let ((buffer-name " *etaf-ui-button-surface-test*")
|
||||
(presses 0))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(etaf-data-grid
|
||||
(button :label "Run health check" :ref 'health
|
||||
:variant 'secondary
|
||||
:on-press (lambda () (cl-incf presses)))))
|
||||
(let ((surface (etaf-ui-test--surface-properties buffer-name 'health)))
|
||||
(should (eq (nth 0 surface) 'hand))
|
||||
(should (eq (nth 1 surface) 'highlight))
|
||||
(should (string-match-p "RET" (nth 2 surface))))
|
||||
(let ((props (etaf-ui-test--props buffer-name 'health)))
|
||||
(should (equal (plist-get props :color) "#142235"))
|
||||
(should (equal (plist-get props :bgcolor) "#D9EEEA")))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||
(before (cdr (assq 'press
|
||||
(etaf-runtime-handler-for runtime 'health)))))
|
||||
(should (functionp before))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'health 'press)
|
||||
(should (= presses 1))
|
||||
(should (string-match-p
|
||||
"pressed"
|
||||
(plist-get (etaf-ui-test--props buffer-name 'health)
|
||||
:class)))
|
||||
(should (eq before
|
||||
(cdr (assq 'press
|
||||
(etaf-runtime-handler-for runtime 'health)))))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-checkbox-is-controlled-and-focusable ()
|
||||
"Render a controlled checkbox, toggle it, and retain its focus contract."
|
||||
(let ((buffer-name " *etaf-ui-checkbox-test*")
|
||||
(checked (etaf-ref nil))
|
||||
next)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name
|
||||
(etaf-view
|
||||
(checkbox :label "Done" :ref 'done
|
||||
:checked (etaf-value checked)
|
||||
:on-change (lambda (value)
|
||||
(setq next value)
|
||||
(setf (etaf-value checked)
|
||||
value)))))
|
||||
(should (string-match-p "☐ Done" (etaf-ui-test--text buffer-name)))
|
||||
(let ((props (etaf-ui-test--props buffer-name 'done)))
|
||||
(should (equal (plist-get props :role) 'checkbox))
|
||||
(should (eq (plist-get props :width) 'max-content))
|
||||
(should (equal (plist-get props :tab-index) 0))
|
||||
(should (equal (plist-get props :ref) 'done)))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'done 'press)
|
||||
(should (eq next t))
|
||||
(should (string-match-p "☑ Done" (etaf-ui-test--text buffer-name)))
|
||||
(etaf-focus-next (etaf-runtime-for-buffer buffer-name))
|
||||
(should (eq (etaf-focused-host-ref
|
||||
(etaf-runtime-for-buffer buffer-name))
|
||||
'done)))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-checkbox-disabled-is-not-interactive ()
|
||||
"A disabled checkbox has no callback or tab stop and remains visible."
|
||||
(let ((buffer-name " *etaf-ui-disabled-checkbox-test*")
|
||||
(changes 0))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name
|
||||
(etaf-view
|
||||
(row
|
||||
(checkbox :label "Open" :ref 'open-box
|
||||
:on-change (lambda (_value)
|
||||
(cl-incf changes)))
|
||||
(checkbox :label "Closed" :ref 'closed-box
|
||||
:disabled t
|
||||
:on-change (lambda (_value)
|
||||
(cl-incf changes))))))
|
||||
(let ((props (etaf-ui-test--props buffer-name 'closed-box)))
|
||||
(should (eq (plist-get props :disabled) t))
|
||||
(should-not (plist-get props :tab-index))
|
||||
(should (equal (plist-get props :bgcolor) "#EEEAE2"))
|
||||
(should (string-match-p "disabled" (plist-get props :class))))
|
||||
(should-error
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'closed-box 'press)
|
||||
:type 'etaf-event-error)
|
||||
(etaf-focus-next (etaf-runtime-for-buffer buffer-name))
|
||||
(should (eq (etaf-focused-host-ref
|
||||
(etaf-runtime-for-buffer buffer-name))
|
||||
'open-box))
|
||||
(should (= changes 0)))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-label-and-panel-expose-presentation-and-slots ()
|
||||
"Render Label and Panel presentation props with named/default slots."
|
||||
(let ((buffer-name " *etaf-ui-panel-test*"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(panel :title "Account" :ref 'account-panel
|
||||
:class "surface" :color "#252A2E" :bgcolor "#FFFDF8"
|
||||
:border "#687386" :padding '(1 2)
|
||||
(slot :name 'header
|
||||
(label :text "Settings" :ref 'settings-label
|
||||
:class "eyebrow" :color "#66706A"
|
||||
:face 'bold :width 12))
|
||||
(label :text "Body"))))
|
||||
(let ((panel (etaf-ui-test--props buffer-name 'account-panel))
|
||||
(label (etaf-ui-test--props buffer-name 'settings-label)))
|
||||
(should (string-match-p "surface" (plist-get panel :class)))
|
||||
(should (equal (plist-get panel :color) "#252A2E"))
|
||||
(should (equal (plist-get panel :bgcolor) "#FFFDF8"))
|
||||
(should (equal (plist-get panel :border) "#687386"))
|
||||
(should (equal (plist-get panel :padding) '(1 2)))
|
||||
(should (string-match-p "eyebrow" (plist-get label :class)))
|
||||
(should (equal (plist-get label :color) "#66706A"))
|
||||
(should (equal (plist-get label :face) 'bold))
|
||||
(should (equal (plist-get label :width) 12)))
|
||||
(dolist (label '("Account" "Settings" "Body"))
|
||||
(should (string-match-p (regexp-quote label)
|
||||
(etaf-ui-test--text buffer-name)))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-projects-reactive-controller ()
|
||||
"Render DataGrid rows, refs, semantics, selection, and dispatch."
|
||||
(let* ((source (etaf-data-memory-source
|
||||
'((:id 1 :name "Ada") (:id 2 :name "Grace"))
|
||||
:id-key :id))
|
||||
(controller (etaf-data-controller source :page-size 10 :auto-load t))
|
||||
(buffer-name " *etaf-ui-grid-test*")
|
||||
pressed)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID")
|
||||
(:key :name :label "Name"))
|
||||
:row-key (lambda (row) (plist-get row :id)))))
|
||||
:row-key (lambda (row) (plist-get row :id))
|
||||
:row-ref (lambda (row)
|
||||
(intern (format "row-%d" (plist-get row :id))))
|
||||
:selected-key 2
|
||||
:on-row-press (lambda (row) (setq pressed row)))))
|
||||
(should (string-match-p "Ada" (etaf-ui-test--text buffer-name)))
|
||||
(let ((first (etaf-ui-test--props buffer-name 'row-1))
|
||||
(second (etaf-ui-test--props buffer-name 'row-2)))
|
||||
(should (equal (plist-get first :role) 'button))
|
||||
(should (equal (plist-get first :tab-index) 0))
|
||||
(should (equal (plist-get second :role) 'button))
|
||||
(should (equal (plist-get second :tab-index) 0))
|
||||
(should (string-match-p "selected" (plist-get second :class)))
|
||||
(should-not (string-match-p "selected" (plist-get first :class))))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'row-1 'press)
|
||||
(should (equal (plist-get pressed :id) 1))
|
||||
(etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
|
||||
(should (string-match-p "Alan" (etaf-ui-test--text buffer-name))))
|
||||
(should (string-match-p "Alan" (etaf-ui-test--text buffer-name)))
|
||||
(should (equal (plist-get (etaf-ui-test--props buffer-name 'row-3)
|
||||
:tab-index)
|
||||
0)))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(etaf-data-stop controller)
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-pagination-is-readable-and-boundary-safe ()
|
||||
"Pagination renders Unicode 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))
|
||||
(controller (etaf-data-controller source :page-size 2 :auto-load t))
|
||||
(buffer-name " *etaf-ui-pagination-test*"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(pagination :controller controller
|
||||
: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 (eq (nth 0 (etaf-ui-test--surface-properties
|
||||
buffer-name 'page-next))
|
||||
'hand))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'page-next 'press)
|
||||
(should (string-match-p "Page 2 / 3" (etaf-ui-test--text buffer-name)))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'page-previous 'press)
|
||||
(should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name)))
|
||||
(should-error
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||
'page-previous 'press)
|
||||
:type 'etaf-event-error))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(etaf-data-stop controller)
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-noninteractive-rows-have-no-focus-contract ()
|
||||
"Rows without ON-ROW-PRESS have no role, ref callback, or tab stop."
|
||||
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
||||
:id-key :id))
|
||||
(controller (etaf-data-controller source :auto-load t))
|
||||
(buffer-name " *etaf-ui-grid-static-row-test*"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID"))
|
||||
:row-key (lambda (row) (plist-get row :id)))))
|
||||
(let ((props (etaf-ui-test--props-with-key buffer-name 1)))
|
||||
(should-not (plist-get props :role))
|
||||
(should-not (plist-get props :tab-index))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(etaf-data-stop controller)
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-requires-row-ref-for-interaction ()
|
||||
"Reject an interactive DataGrid without a row-ref callback."
|
||||
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
||||
:id-key :id))
|
||||
(controller (etaf-data-controller source :auto-load t))
|
||||
(buffer-name " *etaf-ui-grid-row-ref-test*"))
|
||||
(unwind-protect
|
||||
(should-error
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID"))
|
||||
:row-key (lambda (row) (plist-get row :id))
|
||||
:on-row-press (lambda (_row) t)))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(etaf-data-stop controller)
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-rejects-nil-row-ref ()
|
||||
"Reject an interactive row-ref callback that returns nil."
|
||||
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
||||
:id-key :id))
|
||||
(controller (etaf-data-controller source :auto-load t))
|
||||
(buffer-name " *etaf-ui-grid-nil-row-ref-test*"))
|
||||
(unwind-protect
|
||||
(should-error
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID"))
|
||||
:row-key (lambda (row) (plist-get row :id))
|
||||
:row-ref (lambda (_row) nil)
|
||||
:on-row-press (lambda (_row) t)))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(etaf-data-stop controller)
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-projects-loading-error-and-empty ()
|
||||
"Project the Data Controller loading, error, and empty states."
|
||||
(dolist (case '((loading . "Loading custom")
|
||||
(error . "Error custom")
|
||||
(empty . "Empty custom")))
|
||||
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
||||
:id-key :id))
|
||||
(controller (etaf-data-controller source))
|
||||
(buffer-name (format " *etaf-ui-grid-%s-test*" (car case))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf (etaf-value (etaf-data-status controller))
|
||||
(car case))
|
||||
(setf (etaf-value (etaf-data-items controller))
|
||||
(when (eq (car case) 'empty) nil))
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID"))
|
||||
:row-key (lambda (row) (plist-get row :id))
|
||||
:loading-label (when (eq (car case) 'loading)
|
||||
(cdr case))
|
||||
:error-label (when (eq (car case) 'error)
|
||||
(cdr case))
|
||||
:empty-label (when (eq (car case) 'empty)
|
||||
(cdr case)))))
|
||||
(should (string-match-p (regexp-quote (cdr case))
|
||||
(etaf-ui-test--text buffer-name))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
(etaf-unmount runtime))
|
||||
(etaf-data-stop controller)
|
||||
(when-let ((buffer (get-buffer buffer-name)))
|
||||
(kill-buffer buffer))))))
|
||||
|
||||
(ert-deftest etaf-ui-data-grid-requires-stable-row-key ()
|
||||
"Reject a DataGrid that cannot identify retained rows."
|
||||
(let* ((source (etaf-data-memory-source
|
||||
@ -96,7 +526,7 @@
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(etaf-data-grid
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID"))))))
|
||||
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||
@ -117,7 +547,7 @@
|
||||
(etaf-mount
|
||||
buffer-name
|
||||
(etaf-view
|
||||
(etaf-data-grid
|
||||
(data-grid
|
||||
:controller controller
|
||||
:columns '((:key :id :label "ID"))
|
||||
:row-key (lambda (_row) nil)))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user