From a35b3dc469e2f0e618456face161010a28302279 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 31 Aug 2026 15:17:30 +0800 Subject: [PATCH] fix: close M0b DataGrid publication contract --- Makefile | 19 +- README.md | 6 +- README.zh-CN.md | 6 +- etaf-ui-basic.el | 248 +++++++ etaf-ui-data.el | 234 +++++-- etaf-ui-style.el | 71 ++ etaf-ui-table.el | 235 +++++++ etaf-ui.el | 963 +-------------------------- scripts/etaf-ui-m0a-inventory.el | 4 + tests/etaf-ui-m0a-inventory-tests.el | 5 + tests/etaf-ui-m0b-extension-tests.el | 173 +++++ tests/etaf-ui-tests.el | 282 ++++---- 12 files changed, 1085 insertions(+), 1161 deletions(-) create mode 100644 etaf-ui-basic.el create mode 100644 etaf-ui-style.el create mode 100644 etaf-ui-table.el diff --git a/Makefile b/Makefile index a052aea..967e2f6 100644 --- a/Makefile +++ b/Makefile @@ -1,25 +1,34 @@ EMACS ?= emacs LOAD_PATH = -L . -L ../etaf -L ../ebox -L ../ecss -L ../tp +SOURCES = etaf-ui-style.el etaf-ui-basic.el etaf-ui-table.el etaf-ui-data.el etaf-ui.el -.PHONY: all compile test check checkdoc load clean +TEST_FILES := $(wildcard tests/*-tests.el) + +.PHONY: all compile test m0a-inventory check checkdoc load clean all: check compile: rm -f *.elc tests/*.elc - $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ - --eval '(load-file "etaf-ui.el")' --eval '(byte-compile-file "etaf-ui.el")' + $(EMACS) -Q --batch $(LOAD_PATH) \ + --eval '(setq load-prefer-newer t byte-compile-error-on-warn t)' \ + --eval '(require (quote cl-lib))' \ + --eval '(unless (cl-every (function byte-compile-file) (quote ($(foreach file,$(SOURCES),"$(file)")))) (kill-emacs 1))' test: compile $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ - -l tests/etaf-ui-tests.el -f ert-run-tests-batch-and-exit + $(foreach test,$(TEST_FILES),-l $(test)) -f ert-run-tests-batch-and-exit + +m0a-inventory: + $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ + -l scripts/etaf-ui-m0a-inventory.el -f etaf-ui-m0a-inventory-batch load: compile $(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-ui))' \ --eval '(princ "etaf-ui load OK\n")' checkdoc: - $(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (directory-files "." t)) (when (string-suffix-p ".el" file) (checkdoc-file file))))' + $(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (append (directory-files "." t "\\.el$$") (directory-files-recursively "tests" "\\.el$$") (directory-files-recursively "scripts" "\\.el$$"))) (checkdoc-file file)))' check: checkdoc compile test diff --git a/README.md b/README.md index 2911b39..c2acd68 100644 --- a/README.md +++ b/README.md @@ -107,8 +107,10 @@ the row. Without `:on-row-press`, rows have no callback or tab stop. `: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 -owned by the controller. When it is supplied, the callback owns that identity -and must return a non-nil stable Host reference for every row. `:row-key` +owned by the controller. Fallback refs are uninterned and scoped to each +retained DataGrid instance, so separate grids may share row identities without +colliding. When `:row-ref` is supplied, the callback owns that identity and +must return a non-nil stable Host reference for every row. `:row-key` remains a required non-nil stable scalar identity for retained rows. DataGrid retains one action closure per row key, so selection or Data Range updates do not recreate handlers for unchanged rows. diff --git a/README.zh-CN.md b/README.zh-CN.md index d16a597..e68a7b8 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -94,8 +94,10 @@ DataGrid 支持列描述、函数型 `:row-key`，以及可选的 DataGrid 的 `:row-ref` 是可选项。交互式 grid 省略它时，DataGrid 会根据 -controller 持有的 row identity 派生稳定的内部 Host ref；显式提供它时， -该回调拥有 identity，并且必须为每一行返回非 nil 的稳定 Host ref。 +controller 持有的 row identity 派生稳定的内部 Host ref。fallback ref 不会 +进入全局 symbol table，并按每个 retained DataGrid instance 隔离，因此多个 grid +可以安全复用相同行 identity；显式提供它时，该回调拥有 identity，并且必须为 +每一行返回非 nil 的稳定 Host ref。 `:row-key` 仍然是 retained row 必须具备的非 nil 稳定标量 identity。 DataGrid 按 row key 保留唯一 action closure，因此 selection 或 Data Range 更新不会为未变化的行重建 handler。 diff --git a/etaf-ui-basic.el b/etaf-ui-basic.el new file mode 100644 index 0000000..a0feae1 --- /dev/null +++ b/etaf-ui-basic.el @@ -0,0 +1,248 @@ +;;; etaf-ui-basic.el --- Basic reusable ETAF UI Components -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Label, Button, Checkbox, and Panel are the catalog's small semantic +;; building blocks. NumberInput is the first compound Component and composes +;; Button instead of duplicating its interaction contract. + +;;; Code: + +(require 'cl-lib) +(require 'etaf-ui-style) + +(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--reactive-value (value) + "Return VALUE, reading it when it is an ETAF reactive source." + (if (or (etaf-ref-p value) (etaf-computed-p value)) + (etaf-value value) + value)) + +(defun etaf-ui--text-value (value) + "Return VALUE as a Text payload without discarding string properties." + (setq value (etaf-ui--reactive-value value)) + (cond ((null value) "") + ((stringp value) value) + (t (format "%s" value)))) + +(defun etaf-ui--label-presentation (variant) + "Return semantic presentation for Label VARIANT." + (let* ((variant (or variant 'default)) + (color-key + (pcase variant + ('muted :ui-muted-fg) + ('danger :ui-danger-fg) + ('success :ui-success-fg) + (_ :ui-fg))) + (theme (etaf-ui--style-tokens color-key))) + (list :variant variant + :color (plist-get theme color-key) + :font-weight (when (memq variant '(strong heading)) 'bold)))) + +;;;###autoload +(etaf-define-component etaf-label (&key text variant) + "Render TEXT as a semantic Label." + :view + (text + :class (let ((presentation (etaf-ui--label-presentation variant))) + (etaf-ui--class-value + "etaf-label" + (symbol-name (plist-get presentation :variant)) nil)) + :color (plist-get (etaf-ui--label-presentation variant) :color) + :font-weight + (plist-get (etaf-ui--label-presentation variant) :font-weight) + (expr (etaf-ui--text-value text)))) + +(defun etaf-ui--button-variant-values (variant disabled) + "Return themed presentation defaults for Button VARIANT and DISABLED." + (let* ((fg (cond (disabled :ui-disabled-fg) + ((eq variant 'secondary) :ui-button-secondary-fg) + ((eq variant 'ghost) :ui-button-ghost-fg) + (t :ui-button-primary-fg))) + (bg (cond (disabled :ui-disabled-bg) + ((eq variant 'secondary) :ui-button-secondary-bg) + ((eq variant 'ghost) :ui-button-ghost-bg) + (t :ui-button-primary-bg))) + (border-key + (cond (disabled :ui-disabled-border) + ((eq variant 'secondary) :ui-button-secondary-border) + ((eq variant 'ghost) :ui-button-ghost-border) + (t :ui-button-primary-border))) + (theme (etaf-ui--style-tokens fg bg border-key))) + (list :color (plist-get theme fg) + :bgcolor (plist-get theme bg) + :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)) + +;;;###autoload +(etaf-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. + +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) + :render + (let* ((state (etaf-state)) + (label (etaf-ui--text-value label)) + (press-p (and (not disabled) (or on-press use))) + (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 + :class (etaf-ui--class-value + "etaf-button" + (if disabled "disabled" "enabled") + class) + :ref ref :role 'button :disabled disabled + :tab-index (unless disabled (or tab-index 0)) + :aria-label (or aria-label label) + :color (or color (plist-get variant-values :color)) + :background-color (or bgcolor (plist-get variant-values :bgcolor)) + :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))) + (list (etaf-node 'text nil (list label))))) + :styles + (styles + ("&" :width max-content) + ("&.disabled" :padding (0 1) :font-weight normal) + ("&.enabled" :padding (0 1) :font-weight bold))) + +(defun etaf-ui--checkbox-variant-values (disabled) + "Return semantic Theme presentation for a DISABLED Checkbox." + (let* ((prefix (if disabled "disabled" "enabled")) + (fg (intern (format ":ui-checkbox-%s-fg" prefix))) + (bg (intern (format ":ui-checkbox-%s-bg" prefix))) + (border-key (intern (format ":ui-checkbox-%s-border" prefix))) + (theme (etaf-ui--style-tokens fg bg border-key))) + (list :color (plist-get theme fg) + :bgcolor (plist-get theme bg) + :border (etaf-ui--style-border (plist-get theme border-key))))) + +;;;###autoload +(etaf-define-component etaf-checkbox + (&key checked label on-change disabled) + "Render a controlled Checkbox whose next value is sent to ON-CHANGE." + :view + (row + :class (etaf-ui--class-value + "etaf-checkbox" (if disabled "disabled" "enabled") nil) + :role 'checkbox :disabled disabled + :aria-label (etaf-ui--text-value label) + :tab-index (unless disabled 0) + :color (plist-get (etaf-ui--checkbox-variant-values disabled) :color) + :background-color + (plist-get (etaf-ui--checkbox-variant-values disabled) :bgcolor) + :border (plist-get (etaf-ui--checkbox-variant-values disabled) :border) + :on-press + (and (not disabled) on-change + (let ((callback on-change) + (source checked)) + (lambda () + (funcall callback (not (etaf-ui--reactive-value source)))))) + (box :class "etaf-checkbox-mark" + (text (expr (if (etaf-ui--reactive-value checked) "☑" "☐")))) + (text (expr + (let ((value (etaf-ui--text-value label))) + (if (string-empty-p value) "" (concat " " value)))))) + :styles + (styles + ("&" :width max-content) + ("&.disabled" :padding (0 1)) + ("&.enabled" :padding (0 1)) + (".etaf-checkbox-mark" :font-weight bold :width 1))) + +;;;###autoload +(etaf-define-component etaf-panel (&key title variant) + "Render a titled Panel with named header and default slots." + :render + (let ((theme (etaf-ui--style-tokens + :ui-panel-fg :ui-panel-bg :ui-panel-border))) + (etaf-node + 'column + (list :class (etaf-ui--class-value + "etaf-panel" (symbol-name (or variant 'default)) nil) + :color (plist-get theme :ui-panel-fg) + :background-color + (unless (eq variant 'flat) (plist-get theme :ui-panel-bg)) + :border + (unless (eq variant 'flat) + (etaf-ui--style-border (plist-get theme :ui-panel-border)))) + (append + (when title + (list (etaf-node + 'etaf-label + (list :class "etaf-panel-title" :text title :variant 'strong) + nil))) + (etaf-current-slot 'header) + (etaf-current-slot 'default)))) + :styles + (styles + ("&" :padding (1 2)) + (".etaf-panel-title" :font-weight bold))) + +;;;###autoload +(etaf-define-component etaf-number-input + (&key value label on-change disabled min max) + "Render a controlled minibuffer-backed NumberInput using Button." + :render + (let ((label (or label "Value")) + (callback on-change) + (current-value value) + (minimum min) + (maximum max)) + (etaf-node + 'etaf-button + (list + :label (format "%s %s ✎" label (or current-value "—")) + :disabled disabled :variant 'ghost + :on-press + (unless disabled + (lambda () + (let ((next (read-number + (format "%s: " label) (or current-value 0)))) + (unless (and (integerp next) + (or (null minimum) (>= next minimum)) + (or (null maximum) (<= next maximum))) + (user-error "%s must be an integer from %s to %s" + label (or minimum "—") (or maximum "—"))) + (when callback (funcall callback next)))))) + nil))) + +(provide 'etaf-ui-basic) +;;; etaf-ui-basic.el ends here diff --git a/etaf-ui-data.el b/etaf-ui-data.el index d5dc267..2d5a404 100644 --- a/etaf-ui-data.el +++ b/etaf-ui-data.el @@ -21,48 +21,122 @@ (declare-function etaf-data-selected-ref "etaf-data" (controller identity)) (declare-function etaf-data-item-identity "etaf-data" (controller item)) -(defun etaf-ui--data-grid-default-row-ref (controller row) - "Return a stable internal Host reference for CONTROLLER ROW. +(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 -only input, making the reference stable across keyed Range updates." - (intern (format "etaf-data-grid-row-%s" - (etaf-data-item-identity - controller row)))) +row input. 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)) + (ref (or (gethash identity cache) + (and (hash-table-p stage) (gethash identity stage))))) + (unless ref + (unless (hash-table-p stage) + (error "ETAF DataGrid row ref changed outside a keyed candidate")) + (setq ref (make-symbol (format "etaf-data-grid-row-%s" identity))) + (puthash identity ref stage)) + ref)) -(defun etaf-ui--data-grid-row-ref (row-ref on-row-press controller row) +(defun etaf-ui--data-grid-row-ref + (state row-ref on-row-press controller row) "Return a validated stable Host reference for interactive ROW. An explicit ROW-REF remains caller-owned. Interactive grids without one use -the CONTROLLER identity fallback; when ON-ROW-PRESS is nil, rows have no Host -reference." +STATE's CONTROLLER identity fallback; when ON-ROW-PRESS is nil, rows have no +Host reference." (when on-row-press (let ((ref (if row-ref (funcall row-ref row) - (etaf-ui--data-grid-default-row-ref controller row)))) + (etaf-ui--data-grid-default-row-ref + state controller row)))) (unless ref (error "ETAF DataGrid :row-ref must return a non-nil stable ref")) ref))) -(defun etaf-ui--data-grid-row-action (cache key row callback) - "Return CACHE's stable press action for row KEY. +(defun etaf-ui--data-grid-row-action-entry () + "Return one committed-state cell and stable DataGrid handler." + (let (entry) + (setq entry (vector nil nil nil)) + (aset entry 2 + (lambda () + (let ((current (aref entry 1))) + (when current + (funcall current (aref entry 0)))))) + entry)) -The vector is retained by DataGrid setup state; only its current ROW and -CALLBACK change across renders. Unchanged keyed rows therefore keep the same -handler identity and avoid rebuilding behavior resources." - (let ((entry (gethash key cache))) - (unless entry - (setq entry (vector row callback nil)) - (aset entry 2 - (lambda () - (let ((current (aref entry 1))) - (when current - (funcall current (aref entry 0)))))) - (puthash key entry cache)) - (aset entry 0 row) - (aset entry 1 callback) - (aref entry 2))) +(defun etaf-ui--data-grid-row-action (state key row callback) + "Return STATE's stable action for row KEY, staging ROW and CALLBACK. + +Committed handlers read only committed cells. Candidate rendering writes a +private stage that lifecycle hooks promote after successful publication." + (let* ((cache (plist-get state :row-actions)) + (stage (plist-get state :row-action-stage)) + (committed (gethash key cache))) + (if (and committed + (equal-including-properties row (aref committed 0)) + (eq callback (aref committed 1))) + (aref committed 2) + (unless (hash-table-p stage) + (error "ETAF DataGrid handler changed outside a keyed candidate")) + (let* ((proposal (gethash key stage)) + (entry (or committed (and proposal (aref proposal 0)) + (etaf-ui--data-grid-row-action-entry)))) + (puthash key (vector entry row callback) stage) + (aref entry 2))))) + +(defun etaf-ui--data-grid-promote-row-actions (state) + "Promote STATE's staged row actions/refs and prune non-live keys." + (let ((stage (plist-get state :row-action-stage)) + (live (plist-get state :row-action-live-keys)) + (cache (plist-get state :row-actions)) + (prune-p (plist-get state :row-cache-prune-p))) + (when (and (hash-table-p stage) (hash-table-p live)) + (maphash + (lambda (key proposal) + (let ((entry (aref proposal 0))) + (aset entry 0 (aref proposal 1)) + (aset entry 1 (aref proposal 2)) + (puthash key entry cache))) + stage) + (when prune-p + (let (removed) + (maphash (lambda (key _entry) + (unless (gethash key live) (push key removed))) + cache) + (dolist (key removed) (remhash key cache)))) + (setf (plist-get state :row-action-stage) nil + (plist-get state :row-action-live-keys) nil))) + (let ((stage (plist-get state :row-ref-stage)) + (live (plist-get state :row-ref-live-identities)) + (cache (plist-get state :row-refs)) + (prune-p (plist-get state :row-cache-prune-p))) + (when (and (hash-table-p stage) (hash-table-p live)) + (maphash (lambda (identity ref) (puthash identity ref cache)) stage) + (when prune-p + (let (removed) + (maphash (lambda (identity _ref) + (unless (gethash identity live) + (push identity removed))) + cache) + (dolist (identity removed) (remhash identity cache)))) + (setf (plist-get state :row-ref-stage) nil + (plist-get state :row-ref-live-identities) nil + (plist-get state :row-cache-prune-p) nil))) + state) + +(defun etaf-ui--data-grid-dispose-row-actions (state) + "Release all committed and staged row actions in STATE." + (clrhash (plist-get state :row-actions)) + (clrhash (plist-get state :row-refs)) + (setf (plist-get state :row-action-stage) nil + (plist-get state :row-action-live-keys) nil + (plist-get state :row-ref-stage) nil + (plist-get state :row-ref-live-identities) nil + (plist-get state :row-cache-prune-p) nil) + state) (defun etaf-ui--data-grid-row-selected-p (controller row row-selected-p) "Return whether ROW is selected in CONTROLLER or by ROW-SELECTED-P." @@ -72,12 +146,11 @@ handler identity and avoid rebuilding behavior resources." controller (etaf-data-item-identity controller row))))) (defun etaf-ui--data-grid-row - (controller entry columns row-ref on-row-press row-selected-p row-actions - theme) + (state controller entry columns row-ref on-row-press row-selected-p theme) "Return one retained DataGrid row for keyed ENTRY. CONTROLLER owns selection identity; ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P -define the interaction contract. ROW-ACTIONS retains callback identity, and -THEME is the resolved table-paint snapshot for this item." +define the interaction contract. STATE retains callback identity and stages +candidate values; THEME is the resolved table-paint snapshot for this item." (let* ((key (car entry)) (row (cdr entry)) (border-color (plist-get theme :ui-table-border)) @@ -91,7 +164,7 @@ THEME is the resolved table-paint snapshot for this item." (list :key key :class (concat "etaf-table-row" (when selected-p " selected")) :ref (etaf-ui--data-grid-row-ref - row-ref on-row-press controller row) + state row-ref on-row-press controller row) :role (when on-row-press 'button) :tab-index (when on-row-press 0) :color (when selected-p @@ -104,8 +177,8 @@ THEME is the resolved table-paint snapshot for this item." :on-press (and on-row-press (etaf-ui--data-grid-row-action - row-actions key row on-row-press))) - (etaf-ui--table-cells row columns border-color)))) + state key row on-row-press))) + (etaf-ui--table-row-children row columns border-color)))) (defun etaf-ui--data-grid-state-label (key text &optional class color) "Return TEXT as a non-row DataGrid state label identified by KEY. @@ -115,28 +188,46 @@ CLASS and COLOR optionally style the label." nil)) (defun etaf-ui--data-grid-body-entries - (controller row-key loading-label error-label empty-label) - "Return public keyed Range entries for CONTROLLER and labels. -ROW-KEY identifies successful rows. Loading, error, and empty states use one -stable sentinel entry so every body state remains below the same Range. -LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override default state text." + (state controller row-key on-row-press row-ref + loading-label error-label empty-label) + "Return keyed Range entries and begin STATE's candidate action stage. +CONTROLLER and ROW-KEY identify successful rows. ON-ROW-PRESS and ROW-REF +determine which current keys retain committed handlers and fallback refs. +LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override the state text." (let* ((status (etaf-value (etaf-data-status controller))) - (items (etaf-value (etaf-data-items controller)))) - (cond - ((and (eq status 'success) items) - (etaf-ui--table-entries items row-key)) - ((and (eq status 'loading) (null items)) - (list (cons 'loading - (list :etaf-data-grid-state 'loading - :text (or loading-label "Loading..."))))) - ((and (eq status 'error) (null items)) - (list (cons 'error - (list :etaf-data-grid-state 'error - :text (or error-label "Unable to load data."))))) - (t - (list (cons 'empty - (list :etaf-data-grid-state 'empty - :text (or empty-label "No data.")))))))) + (items (etaf-value (etaf-data-items controller))) + (entries + (cond + ((eq status 'loading) + (list (cons 'loading + (list :etaf-data-grid-state 'loading + :text (or loading-label "Loading..."))))) + ((eq status 'error) + (list (cons 'error + (list :etaf-data-grid-state 'error + :text (or error-label + "Unable to load data."))))) + (items (etaf-ui--table-entries items row-key)) + (t + (list (cons 'empty + (list :etaf-data-grid-state 'empty + :text (or empty-label "No data."))))))) + (stage (make-hash-table :test #'equal)) + (live (make-hash-table :test #'equal)) + (ref-stage (make-hash-table :test #'equal)) + (ref-live (make-hash-table :test #'equal))) + (when (and on-row-press items (not (memq status '(loading error)))) + (dolist (entry entries) (puthash (car entry) t live)) + (unless row-ref + (dolist (row items) + (puthash (etaf-data-item-identity controller row) t ref-live)))) + (setf (plist-get state :row-action-stage) stage + (plist-get state :row-action-live-keys) live + (plist-get state :row-ref-stage) ref-stage + (plist-get state :row-ref-live-identities) ref-live + (plist-get state :row-cache-prune-p) + (not (memq status '(loading error)))) + entries)) (defun etaf-ui--data-grid-state-entry-node (entry) "Return the state label View represented by keyed ENTRY." @@ -151,14 +242,14 @@ LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override default state text." (etaf-define-component etaf-ui--data-grid-body-item (&key controller entry columns row-ref on-row-press row-selected-p - row-actions) + grid-state) "Render one retained keyed DataGrid ENTRY with a cached row action." :view (expr (if (plist-get (cdr entry) :etaf-data-grid-state) - (etaf-ui--data-grid-state-entry-node entry) + (etaf-ui--data-grid-state-entry-node entry) (etaf-ui--data-grid-row - controller entry columns row-ref on-row-press row-selected-p row-actions + grid-state controller entry columns row-ref on-row-press row-selected-p (etaf-ui--style-tokens :ui-table-border :ui-table-selected-fg :ui-table-selected-bg))))) @@ -169,9 +260,25 @@ LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override default state text." "Render DATA CONTROLLER state through the public Component DSL. DataGrid owns loading, error, empty, and controller-selection adaptation. -Its keyed Range retains row identity across insert, reorder, and update; setup -state only caches stable row action closures." - :setup (list :row-actions (make-hash-table :test #'equal)) +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." + :setup + (let ((state + (list :row-actions (make-hash-table :test #'equal) + :row-action-stage nil + :row-action-live-keys nil + :row-refs (make-hash-table :test #'equal) + :row-ref-stage nil + :row-ref-live-identities nil + :row-cache-prune-p nil))) + (etaf-on-mounted + (lambda () (etaf-ui--data-grid-promote-row-actions state))) + (etaf-on-updated + (lambda () (etaf-ui--data-grid-promote-row-actions state))) + (etaf-on-unmounted + (lambda () (etaf-ui--data-grid-dispose-row-actions state))) + state) :view (column :class "etaf-data-grid etaf-table" @@ -182,12 +289,13 @@ state only caches stable row action closures." (etaf-ui--data-grid-body-item :for (entry (etaf-ui--data-grid-body-entries - controller row-key loading-label error-label empty-label)) + (etaf-state) controller row-key on-row-press row-ref + loading-label error-label empty-label)) :key (car entry) :controller controller :entry entry :columns columns :row-ref row-ref :on-row-press on-row-press :row-selected-p row-selected-p - :row-actions (plist-get (etaf-state) :row-actions))) + :grid-state (etaf-state))) (slot :name 'footer))) ;;;###autoload diff --git a/etaf-ui-style.el b/etaf-ui-style.el new file mode 100644 index 0000000..9cf7b93 --- /dev/null +++ b/etaf-ui-style.el @@ -0,0 +1,71 @@ +;;; etaf-ui-style.el --- Internal styling for ETAF UI Components -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Private catalog styling. ETAF owns Theme; this module only supplies +;; fallback values for the semantic tokens consumed by official Components. + +;;; Code: + +(require 'cl-lib) +(require 'etaf) + +(defconst etaf-ui--style-palette + '(:ui-fg "#252A2E" + :ui-bg "#FFFDF8" + :ui-border "#687386" + :ui-muted-fg "#526174" + :ui-danger-fg "#FF6B6B" + :ui-success-fg "#2F6B43" + :ui-disabled-fg "#687386" + :ui-disabled-bg "#E5E7EB" + :ui-disabled-border "#9CA3AF" + :ui-button-primary-fg "#FFFFFF" + :ui-button-primary-bg "#2F6B43" + :ui-button-primary-border "#2F6B43" + :ui-button-secondary-fg "#142235" + :ui-button-secondary-bg "#D9EEEA" + :ui-button-secondary-border "#2E8B83" + :ui-button-ghost-fg "#142235" + :ui-button-ghost-bg "#FFFDF8" + :ui-button-ghost-border "#C8C1B6" + :ui-checkbox-enabled-fg "#252A2E" + :ui-checkbox-enabled-bg "#DCEBDD" + :ui-checkbox-enabled-border "#6D8A73" + :ui-checkbox-disabled-fg "#6B7280" + :ui-checkbox-disabled-bg "#EEEAE2" + :ui-checkbox-disabled-border "#9CA3AF" + :ui-table-border "#687386" + :ui-table-selected-fg "#2F6B43" + :ui-table-selected-bg "#DCEBDD" + :ui-data-grid-error-fg "#FF6B6B" + :ui-pagination-muted-fg "#526174" + :ui-panel-fg "#252A2E" + :ui-panel-bg "#FFFDF8" + :ui-panel-border "#687386") + "Fallback values for semantic tokens used by ETAF UI Components.") + +(defun etaf-ui--style-tokens (&rest keys) + "Return deferred ETAF Theme values for private catalog token KEYS." + (let (result) + (dolist (key keys result) + (setq result + (plist-put + result key + (etaf-theme-token key (plist-get etaf-ui--style-palette key))))))) + +(defun etaf-ui--style-border (value) + "Return canonical border VALUE from a semantic ETAF Theme value." + (cond + ((etaf-theme-token-p value) + (etaf-theme-token (nth 1 value) (nth 2 value) + #'etaf-ui--style-border)) + ((and (stringp value) + (string-match-p "\\`#[[:xdigit:]]+\\'" value)) + (list 1 'solid value)) + (t value))) + +(provide 'etaf-ui-style) +;;; etaf-ui-style.el ends here diff --git a/etaf-ui-table.el b/etaf-ui-table.el new file mode 100644 index 0000000..e8fdddc --- /dev/null +++ b/etaf-ui-table.el @@ -0,0 +1,235 @@ +;;; etaf-ui-table.el --- Presentational Table Component for ETAF UI -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Table renders ordinary rows and columns. It owns no loading, database, +;; pagination, or selection state; callers provide optional controlled row +;; interaction. DataGrid adapts ETAF Data onto this Component. + +;;; Code: + +(require 'cl-lib) +(require 'etaf-ui-basic) + +(defun etaf-ui--column-value (column key) + "Return KEY from COLUMN, accepting a plist or alist descriptor." + (if (and (listp column) (keywordp (car column))) + (plist-get column key) + (alist-get key column))) + +(defun etaf-ui--table-cell-value (row key) + "Return KEY from ROW, accepting a plist, alist, or hash table." + (cond + ((hash-table-p row) (gethash key row)) + ((and (proper-list-p row) + (zerop (% (length row) 2)) + (keywordp (car row))) + (plist-get row key)) + ((listp row) (alist-get key row)) + (t nil))) + +(defun etaf-ui--table-fit-text (value column) + "Return VALUE fitted to COLUMN's declared character capacity." + (let* ((value (format "%s" (or value ""))) + (width (etaf-ui--column-value column :width))) + (if (and (integerp width) (> width 0) + (> (string-width value) width)) + (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-cell-frame (first-p header-p color) + "Return shared Cell border properties for FIRST-P, HEADER-P, and COLOR." + (ignore first-p header-p color) + nil) + +(defun etaf-ui--table-header-cell (column first-p gap-p border-color) + "Return one Label header for COLUMN, adding air when GAP-P is non-nil." + (etaf-node + 'box + (append + (list :class "etaf-table-header-cell" + :width (etaf-ui--table-track-width column gap-p) + :wrap-mode 'none) + (etaf-ui--table-cell-frame first-p t border-color)) + (list + (etaf-node + 'text nil + (list + (etaf-ui--table-fit-text + (or (etaf-ui--column-value column :label) + (etaf-ui--column-value column :key)) + column)))))) + +(defun etaf-ui--table-header (columns) + "Return a Table header row for COLUMNS." + (let ((theme (etaf-ui--style-tokens :ui-table-border))) + (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)) + (cl-loop for column in columns + for tail on columns + for index from 0 + collect + (etaf-ui--table-header-cell + column (zerop index) (cdr tail) + (plist-get theme :ui-table-border)))))) + +(defun etaf-ui--table-cell (row column first-p gap-p border-color) + "Return one Label cell for ROW and COLUMN using GAP-P." + (etaf-node + 'box + (append + (list :class "etaf-table-cell" + :width (etaf-ui--table-track-width column gap-p) + :wrap-mode 'none) + (etaf-ui--table-cell-frame first-p nil border-color)) + (list + (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 border-color) + "Return cell Components for ROW and COLUMNS." + (cl-loop for column in columns + for tail on columns + for index from 0 + collect + (etaf-ui--table-cell + row column (zerop index) (cdr tail) border-color))) + +(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)) + (mapconcat + (lambda (column) + (let* ((width (etaf-ui--column-value column :width)) + (value + (etaf-ui--table-fit-text + (etaf-ui--table-cell-value + row (etaf-ui--column-value column :key)) + column))) + (concat value + (make-string (max 0 (- width (string-width value))) ?\s)))) + columns " "))) + +(defun etaf-ui--table-row-children (row columns border-color) + "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 using BORDER-COLOR." + (if-let* ((text (etaf-ui--table-fixed-row-text row columns))) + (list (etaf-node 'text nil (list text))) + (etaf-ui--table-cells row columns border-color))) + +(defun etaf-ui--table-entries (rows row-key) + "Return `(KEY . ROW)' entries; ETAF validates keys and uniqueness." + (unless (functionp row-key) + (error "ETAF Table requires a function-valued :row-key")) + (mapcar (lambda (row) (cons (funcall row-key row) row)) rows)) + +(defun etaf-ui--table-row-node + (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." + (let* ((callback on-row-press) + (row-value row) + (interactive-p (not (null callback))) + (selected-p + (progn + (when (and row-selected-p (not (functionp row-selected-p))) + (error "ETAF Table :row-selected-p must be a function")) + (and row-selected-p (funcall row-selected-p row)))) + (host-ref nil) + (theme (etaf-ui--style-tokens + :ui-table-border :ui-table-selected-fg + :ui-table-selected-bg))) + (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"))) + (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)))) + (etaf-ui--table-row-children + row columns (plist-get theme :ui-table-border))))) + +(etaf-define-component etaf-ui--table-header (&key columns) + "Render one retained Table header." + :render (etaf-ui--table-header columns) + :styles + (styles + (".etaf-table-header" :font-weight bold :padding (0 1)) + (".etaf-table-header-cell" :font-weight bold))) + +(etaf-define-component etaf-ui--table-row + (&key row identity columns row-ref on-row-press row-selected-p) + "Render one retained Table ROW with stable IDENTITY." + :render + (etaf-ui--table-row-node + row identity columns row-ref on-row-press row-selected-p) + :styles + (styles + (".etaf-table-row" :padding (0 1)))) + +;;;###autoload +(etaf-define-component etaf-table + (&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." + :view + (column + :class "etaf-table" + :color (plist-get (etaf-ui--style-tokens :ui-fg) :ui-fg) + (etaf-ui--table-header :columns columns) + (column :class "etaf-table-body" + (etaf-ui--table-row + :for (entry (etaf-ui--table-entries rows row-key)) + :key (car entry) + :row (cdr entry) :identity (car entry) :columns columns + :row-ref row-ref :on-row-press on-row-press + :row-selected-p row-selected-p)))) + +(provide 'etaf-ui-table) +;;; etaf-ui-table.el ends here diff --git a/etaf-ui.el b/etaf-ui.el index 1843f7b..e64c8e4 100644 --- a/etaf-ui.el +++ b/etaf-ui.el @@ -8,967 +8,14 @@ ;;; Commentary: -;; The official ETAF catalog is one ordinary Component library. It does not -;; expose a parallel Control/Widget taxonomy: a DataGrid is a compound -;; Component built from the same View, props, slots, events, and Data APIs. +;; Public facade for Components defined with ETAF. The catalog exposes no +;; second Widget runtime, Theme system, data store, or layout engine. ;;; Code: -(require 'cl-lib) -(require 'etaf) - -(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 etaf-data-selected-ref "etaf-data" (controller identity)) -(declare-function etaf-theme-defaults "etaf-context" (&optional default)) -(declare-function text "etaf-view" (&rest arguments)) -(declare-function box "etaf-view" (&rest arguments)) -(declare-function expr "etaf-view" (&rest arguments)) -(declare-function slot "etaf-view" (&rest arguments)) - -(defconst etaf-ui--default-theme-palette - '(:ui-fg "#252A2E" - :ui-bg "#FFFDF8" - :ui-border "#687386" - :ui-muted-fg "#526174" - :ui-danger-fg "#FF6B6B" - :ui-success-fg "#2F6B43" - :ui-disabled-fg "#687386" - :ui-disabled-bg "#E5E7EB" - :ui-disabled-border "#9CA3AF" - :ui-button-primary-fg "#FFFFFF" - :ui-button-primary-bg "#2F6B43" - :ui-button-primary-border "#2F6B43" - :ui-button-secondary-fg "#142235" - :ui-button-secondary-bg "#D9EEEA" - :ui-button-secondary-border "#2E8B83" - :ui-button-ghost-fg "#142235" - :ui-button-ghost-bg "#FFFDF8" - :ui-button-ghost-border "#C8C1B6" - :ui-checkbox-enabled-fg "#252A2E" - :ui-checkbox-enabled-bg "#DCEBDD" - :ui-checkbox-enabled-border "#6D8A73" - :ui-checkbox-disabled-fg "#6B7280" - :ui-checkbox-disabled-bg "#EEEAE2" - :ui-checkbox-disabled-border "#9CA3AF" - :ui-grid-border "#687386" - :ui-grid-selected-fg "#2F6B43" - :ui-grid-selected-bg "#DCEBDD" - :ui-grid-error-fg "#FF6B6B" - :ui-pagination-muted-fg "#526174" - :ui-panel-fg "#252A2E" - :ui-panel-bg "#FFFDF8" - :ui-panel-border "#687386") - "Default semantic UI palette, centralized outside Component definitions. - -Applications normally override these tokens through ETAF Theme. Keeping the -fallback palette here gives the catalog a useful standalone appearance while -ensuring every Component reads one shared semantic vocabulary.") - -(defconst etaf-ui--legacy-theme-aliases - '((:ui-fg :color) - (:ui-bg :bgcolor) - (:ui-border :border) - (:ui-button-primary-fg :ui-button-color) - (:ui-button-primary-bg :ui-button-bgcolor) - (:ui-button-primary-border :ui-button-border) - (:ui-button-secondary-fg :ui-button-secondary-color) - (:ui-button-secondary-bg :ui-button-secondary-bgcolor) - (:ui-button-secondary-border :ui-button-secondary-border) - (:ui-button-ghost-fg :ui-button-ghost-color) - (:ui-button-ghost-bg :ui-button-ghost-bgcolor) - (:ui-button-ghost-border :ui-button-ghost-border) - (:ui-disabled-fg :ui-button-disabled-color) - (:ui-disabled-bg :ui-button-disabled-bgcolor) - (:ui-disabled-border :ui-button-disabled-border)) - "Compatibility aliases for the first ETAF UI Theme token spelling.") - -;;;###autoload -(defun etaf-ui-theme-values (&rest requested) - "Return merged semantic UI Theme values for REQUESTED tokens. - -Inherited application tokens win, legacy aliases remain readable, and the -central catalog palette fills only omitted values. This is the boundary -between generic ETAF Theme Context and etaf-ui's product-independent visual -semantics; individual Components do not own separate color systems. When -REQUESTED is nil, return the complete catalog token map." - (let* ((inherited (etaf-theme-defaults)) - (defaults etaf-ui--default-theme-palette) - ;; Callers that request a subset only need that semantic subset. - ;; Keeping the full inherited plist is useful for the no-argument - ;; catalog query, but copying it for every Button/Panel/DataGrid - ;; render needlessly scales Theme work with application token count. - (result (unless requested (copy-sequence inherited))) - (keys (or requested - (cl-loop for (key _spec) on defaults by #'cddr - collect key)))) - (dolist (key keys) - (let ((found - (cond - ((plist-member inherited key) - (cons t (plist-get inherited key))) - (t - (cl-loop for alias in etaf-ui--legacy-theme-aliases - when (and (eq (car alias) key) - (plist-member inherited (cadr alias))) - return - (cons t (plist-get inherited (cadr alias)))))))) - (setq result - (plist-put result key - (if found (cdr found) (plist-get defaults key))))) - ) - result)) - -(defun etaf-ui-theme-tokens (&rest requested) - "Return deferred semantic Theme tokens for REQUESTED UI keys. - -Catalog defaults and legacy aliases are encoded as nested token fallbacks, so -Host lowering can update paint properties without making the current -Component render depend on the Theme source." - (let ((keys (or requested - (cl-loop for (key _spec) on etaf-ui--default-theme-palette - by #'cddr collect key))) - result) - (dolist (key keys result) - (let* ((default (plist-get etaf-ui--default-theme-palette key)) - (alias (cadr (assq key etaf-ui--legacy-theme-aliases))) - (fallback (if alias (etaf-theme-token alias default) default))) - (setq result - (plist-put result key (etaf-theme-token key fallback))))))) - -(defun etaf-ui--theme-border (value) - "Return Ebox border VALUE, preserving complete caller-owned specs. - -Semantic Theme border tokens conventionally contain a color string. The -catalog turns a hex color into a one-pixel solid border; an existing canonical -border value remains unchanged." - (cond - ((etaf-theme-token-p value) - (etaf-theme-token (nth 1 value) (nth 2 value) - #'etaf-ui--theme-border)) - ((and (stringp value) - (string-match-p "\\`#[[:xdigit:]]+\\'" value)) - (list 1 'solid value)) - (t value))) - -(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--reactive-value (value) - "Return VALUE, reading it when it is an ETAF reactive source." - (if (or (etaf-ref-p value) (etaf-computed-p value)) - (etaf-value value) - value)) - -(defun etaf-ui--button-variant-values (variant disabled) - "Return themed presentation defaults for Button VARIANT and DISABLED." - (let* ((fg (cond (disabled :ui-disabled-fg) - ((eq variant 'secondary) :ui-button-secondary-fg) - ((eq variant 'ghost) :ui-button-ghost-fg) - (t :ui-button-primary-fg))) - (bg (cond (disabled :ui-disabled-bg) - ((eq variant 'secondary) :ui-button-secondary-bg) - ((eq variant 'ghost) :ui-button-ghost-bg) - (t :ui-button-primary-bg))) - (border (cond (disabled :ui-disabled-border) - ((eq variant 'secondary) :ui-button-secondary-border) - ((eq variant 'ghost) :ui-button-ghost-border) - (t :ui-button-primary-border))) - (theme (etaf-ui-theme-tokens fg bg border))) - (list :color (plist-get theme fg) - :bgcolor (plist-get theme bg) - :border (etaf-ui--theme-border (plist-get theme border)) - :font-weight (if (or disabled (eq variant 'ghost)) 'normal 'bold)))) - -(defun etaf-ui--button-view - (label on-press disabled ref class color bgcolor border padding font-weight - tab-index aria-label use) - "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, -FONT-WEIGHT, -TAB-INDEX, and ARIA-LABEL provide Host identity and presentation." - (let ((class-value (etaf-ui--class-value - "etaf-button" - (if disabled "disabled" "enabled") - class)) - (tab-value (unless disabled (or tab-index 0))) - (label-value (or aria-label label))) - (if on-press - (etaf-view - (box :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 :font-weight font-weight - :use (unless disabled use) :on-press on-press - (text (expr :value label)))) - (etaf-view - (box :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 :font-weight font-weight - :use (unless disabled use) - (text (expr :value label))))))) - -(defun etaf-ui--checkbox-variant-values (theme disabled) - "Return semantic Theme values from THEME for DISABLED Checkbox state." - (let ((prefix (if disabled "disabled" "enabled"))) - (list :color (plist-get theme - (intern (format ":ui-checkbox-%s-fg" prefix))) - :bgcolor (plist-get theme - (intern (format ":ui-checkbox-%s-bg" prefix))) - :border - (etaf-ui--theme-border - (plist-get theme - (intern (format ":ui-checkbox-%s-border" prefix))))))) - -(defun etaf-ui--column-value (column key) - "Return KEY from COLUMN, accepting a plist or alist descriptor." - (if (and (listp column) (keywordp (car column))) - (plist-get column key) - (alist-get key column))) - -(defun etaf-ui--grid-cell-value (row key) - "Return KEY from data ROW, accepting a plist, alist, or hash table." - (cond - ((hash-table-p row) (gethash key row)) - ((and (proper-list-p row) - (zerop (% (length row) 2)) - (keywordp (car row))) - (plist-get row key)) - ((listp row) (alist-get key row)) - (t nil))) - -(defun etaf-ui--grid-fit-text (value column) - "Return VALUE fitted to COLUMN's declared character capacity." - (let* ((value (format "%s" (or value ""))) - (width (etaf-ui--column-value column :width))) - (if (and (integerp width) (> width 0) - (> (string-width value) width)) - (truncate-string-to-width value width 0 nil "…") - value))) - -(defun etaf-ui--grid-display-value (row column) - "Return one single-line display value for ROW and COLUMN. - -DataGrid columns are tabular tracks, not prose paragraphs. Keep each cell on -one visual line and use an ellipsis when a fixed character-width descriptor is -too small; the original ROW remains intact for selection and callbacks." - (etaf-ui--grid-fit-text - (etaf-ui--grid-cell-value row (etaf-ui--column-value column :key)) - column)) - -(defun etaf-ui--grid-track-width (column gap-p) - "Return COLUMN width with one native-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--grid-header-cell (column gap-p) - "Return one header View for COLUMN, adding air when GAP-P is non-nil." - (etaf--view-call - 'box - (list :class "etaf-data-grid-header-cell" - :width (etaf-ui--grid-track-width column gap-p)) - (list - (etaf--view-call - 'text nil - (list - (etaf-ui--grid-fit-text - (or (etaf-ui--column-value column :label) - (etaf-ui--column-value column :key)) - column)))))) - -(defun etaf-ui--grid-header (columns theme) - "Return a View header row for COLUMNS using semantic THEME colors." - (etaf-view - (row :class "etaf-data-grid-header" - :border (etaf-ui--theme-border - (plist-get theme :ui-grid-border)) - (expr :value - (cl-loop for column in columns - for tail on columns - collect (etaf-ui--grid-header-cell - column (cdr tail))))))) - -(defun etaf-ui--grid-cell (row column gap-p host-ref) - "Return one data cell View for ROW and COLUMN using HOST-REF and GAP-P." - (etaf--view-call - 'box - (list :ref host-ref :width (etaf-ui--grid-track-width column gap-p)) - (list - (etaf--view-call - 'text nil (list (etaf-ui--grid-display-value row column)))))) - -(defun etaf-ui--grid-cells (row columns cell-refs) - "Return data cell Views for ROW and COLUMNS using stable CELL-REFS." - (cl-loop for column in columns - for tail on columns - for index from 0 - collect - (etaf-ui--grid-cell - row column (cdr tail) - (or (gethash index cell-refs) - (puthash index (gensym "etaf-data-grid-cell-") - cell-refs))))) - -(defun etaf-ui--grid-selected-p - (row key selected-key row-selected-p selected-ref) - "Return whether ROW with KEY is selected. -ROW-SELECTED-P and SELECTED-KEY preserve custom controlled selection; -SELECTED-REF supplies the controller-backed keyed default." - (or (and row-selected-p (funcall row-selected-p row)) - (and selected-key (equal key selected-key)) - (and selected-ref (etaf-value selected-ref)))) - -(defun etaf-ui--grid-row-action (cache key row callback) - "Return CACHE's stable row action for KEY, refreshing ROW and CALLBACK." - (let ((entry (gethash key cache))) - (unless entry - (setq entry (vector row callback nil)) - (aset entry 2 - (lambda () - (let ((current (aref entry 1))) - (when current - (funcall current (aref entry 0)))))) - (puthash key entry cache)) - (aset entry 0 row) - (aset entry 1 callback) - (aref entry 2))) - -(defun etaf-ui--grid-row - (row key columns row-ref on-row-press selected-key row-selected-p - selected-ref row-actions theme internal-row-ref cell-refs) - "Return a View row for ROW and COLUMNS using THEME and the DataGrid contract. - -KEY is ROW's stable identity; ROW-REF returns the interactive reference; -ON-ROW-PRESS, SELECTED-KEY, ROW-SELECTED-P, and SELECTED-REF control state. -ROW-ACTIONS owns stable keyed callbacks across body reevaluation." - (let* ((interactive-p (not (null on-row-press))) - (selected-p - (lambda () - (etaf-ui--grid-selected-p - row key selected-key row-selected-p selected-ref))) - (host-ref internal-row-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-call - 'row - (list :key key - :class - (etaf--expr-create - :thunk (lambda () - (concat "etaf-data-grid-row" - (if (funcall selected-p) " selected" "")))) - :ref host-ref - :role (when interactive-p 'button) - :tab-index (when interactive-p 0) - :border-bottom-width 1 - :border-bottom-style 'solid - :border-bottom-color (plist-get theme :ui-grid-border) - :on-press (when interactive-p - (etaf-ui--grid-row-action - row-actions key row on-row-press)) - :bgcolor - (etaf--expr-create - :thunk (lambda () - (when (funcall selected-p) - (plist-get theme :ui-grid-selected-bg))))) - (etaf-ui--grid-cells row columns cell-refs)))) - -(defun etaf-ui--grid-row-state (states key) - "Return STATES' retained internal row and cell refs for KEY." - (or (gethash key states) - (let ((state (cons (gensym "etaf-data-grid-row-") - (make-hash-table :test #'eql)))) - (puthash key state states) - state))) - -(defun etaf-ui--grid-keyed-items - (items row-key row-actions row-states) - "Return validated `(KEY . ITEM)' entries and prune retained row caches." - (let ((seen (make-hash-table :test #'equal)) entries) - (dolist (item items) - (let ((key (funcall row-key item))) - (unless key - (error "ETAF DataGrid row-key must return a non-nil stable scalar")) - (when (gethash key seen) - (error "ETAF DataGrid row-key must be unique: %S" key)) - (puthash key t seen) - (push (cons key item) entries))) - (maphash - (lambda (key _entry) - (unless (gethash key seen) - (remhash key row-actions) - (remhash key row-states))) - row-actions) - (nreverse entries))) - -(defun etaf-ui--grid-rows - (controller items columns row-key row-ref on-row-press selected-key - row-selected-p row-actions row-states &optional theme) - "Return keyed Host rows and prune caches outside current ITEMS. -CONTROLLER owns keyed default selection refs. COLUMNS and ROW-KEY describe -cells and identity. ROW-REF, ON-ROW-PRESS, SELECTED-KEY, and ROW-SELECTED-P -provide interaction state. ROW-ACTIONS and ROW-STATES retain callback and -internal Host identities. THEME optionally supplies resolved colors." - (let* ((theme (or theme - ;; Resolve Theme once in the retained DataGrid owner - ;; of doing it independently in every row Component. - (etaf-ui-theme-tokens :ui-grid-border - :ui-grid-selected-fg - :ui-grid-selected-bg))) - (entries - (etaf-ui--grid-keyed-items - items row-key row-actions row-states))) - (mapcar - (lambda (entry) - (let* ((key (car entry)) - (item (cdr entry)) - (state (etaf-ui--grid-row-state row-states key))) - (etaf-ui--grid-row - item key columns row-ref on-row-press selected-key row-selected-p - (unless (or row-selected-p selected-key) - (etaf-data-selected-ref controller key)) - row-actions theme (car state) (cdr state)))) - entries))) - -(defun etaf-ui--grid-body-items - (controller status items columns row-key row-ref on-row-press selected-key - row-selected-p row-actions row-states theme loading-label - error-label empty-label) - "Return CONTROLLER DataGrid body items for STATUS and ITEMS. -COLUMNS and ROW-KEY describe rows; ROW-REF and ON-ROW-PRESS add interaction. -SELECTED-KEY, ROW-SELECTED-P, and ROW-ACTIONS preserve controlled behavior. -THEME supplies colors, while LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL -customize state messages. The parent Component directly owns the result." - (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")) - (cond - ((eq status 'loading) - (list (etaf--view-call 'text nil - (list (or loading-label "Loading..."))))) - ((eq status 'error) - (list - (etaf--view-call - 'text - (list :class "etaf-data-grid-error" - :color (plist-get (etaf-ui-theme-tokens :ui-grid-error-fg) - :ui-grid-error-fg)) - (list (or error-label "Unable to load data."))))) - ((null items) - (list (etaf--view-call 'text nil - (list (or empty-label "No data."))))) - (t - (etaf-ui--grid-rows - controller items columns row-key row-ref on-row-press selected-key - row-selected-p row-actions row-states theme)))) - -(defun etaf-ui--button-setup () - "Create the retained renderer for one Button instance." - (let* ((current-callback nil) - (current-press-p nil) - (press nil)) - (setq press - (lambda () - (when current-press-p - (when current-callback - (funcall current-callback))))) - (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* ((variant (and (not disabled) (etaf-current-prop :variant))) - (variant-values - (etaf-ui--button-variant-values variant disabled))) - (etaf-ui--button-view - label (and press-p press) disabled (etaf-current-prop :ref) - (etaf-current-prop :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 :font-weight) - (plist-get variant-values :font-weight)) - (etaf-current-prop :tab-index) - (etaf-current-prop :aria-label) - use)))))) - -;;;###autoload -(etaf-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 LABEL and ON-PRESS. - -DISABLED removes the callback and the default focus tab index. Product -appearance is controlled by VARIANT and the shared interactive surface -contract; callers can still override presentation with the ordinary props." - :styles - (styles - ("&" :width max-content) - ;; State classes carry semantic state only. Resolved presentation props - ;; above remain authoritative, so a themed disabled Button cannot inherit - ;; the catalog's light default surface. - ("&.disabled" :padding (0 1) :font-weight normal) - ("&.enabled" :padding (0 1) :font-weight bold)) - :setup - (etaf-ui--button-setup)) - -(etaf-define-component etaf-number-input - (&key value label on-change ref disabled min max aria-label) - "Render a controlled minibuffer-backed numeric input. - -VALUE is displayed as a Button. Activating it reads a number through -Emacs's native minibuffer, validates optional MIN and MAX bounds, and calls -ON-CHANGE with the accepted integer. The Component owns prompting and -validation; the caller owns the value and subsequent state write." - :setup - (let ((callback (etaf-current-prop :on-change))) - (lambda () - (let* ((value (etaf-current-prop :value)) - (label (or (etaf-current-prop :label) "Value")) - (min-value (etaf-current-prop :min)) - (max-value (etaf-current-prop :max)) - (disabled (etaf-current-prop :disabled)) - (ref (etaf-current-prop :ref)) - (aria-label (etaf-current-prop :aria-label))) - (etaf-view - (button - :label (format "%s %s ✎" label (or value "—")) - :ref ref :disabled disabled - :aria-label (or aria-label label) - :variant 'ghost - :on-press - (unless disabled - (lambda () - (let ((next (read-number - (format "%s: " label) (or value 0)))) - (unless (and (integerp next) - (or (null min-value) (>= next min-value)) - (or (null max-value) (<= next max-value))) - (user-error "%s must be an integer from %s to %s" - label (or min-value "—") (or max-value "—"))) - (when callback (funcall callback next))))))))))) - -(defun etaf-ui--checkbox-view - (checked label on-change ref disabled class color bgcolor border padding - font-weight 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 :font-weight font-weight - :on-press on-change - (box :class "etaf-checkbox-mark" - (text (expr :value - (if (etaf-ui--reactive-value checked) "☑" "☐")))) - (text (expr :value (if label (concat " " label) "")))))) - -;;;###autoload -(etaf-define-component etaf-checkbox - (&key checked label on-change ref disabled class color bgcolor border padding - font-weight tab-index aria-label) - "Render a controlled checkbox with CHECKED, LABEL, and ON-CHANGE. - -CHECKED may be a boolean or an ETAF reactive source. ON-CHANGE receives the -next boolean value. State ownership stays with the caller, so the Component -works with local refs or Data-backed forms." - :styles - (styles - ("&" :width max-content) - ;; Color, background, and border are resolved through the shared semantic - ;; Theme map in :setup; styles keep only geometry defaults. - ("&.disabled" :padding (0 1)) - ("&.enabled" :padding (0 1)) - (".etaf-checkbox-mark" :font-weight bold :width 1)) - :setup - (let* ((current-checked nil) - (current-callback nil) - (press - (lambda () - (when current-callback - (funcall current-callback - (not (etaf-ui--reactive-value current-checked))))))) - (lambda () - (let* ((theme (etaf-ui-theme-tokens :ui-fg :ui-bg - :ui-checkbox-enabled-fg - :ui-checkbox-enabled-bg - :ui-checkbox-enabled-border - :ui-checkbox-disabled-fg - :ui-checkbox-disabled-bg - :ui-checkbox-disabled-border)) - (variant-values - (etaf-ui--checkbox-variant-values - theme (etaf-current-prop :disabled)))) - (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) - (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) (etaf-current-prop :font-weight) - (etaf-current-prop :tab-index) (etaf-current-prop :aria-label)))))) - -;;;###autoload -(etaf-define-component etaf-label - (&key text font-weight class color bgcolor border padding ref width) - "Render TEXT as a semantic label with presentation properties. -TEXT may be an ordinary value or an ETAF reactive source." - :view - (expr - :value - (if (or border padding width) - (etaf-view - (box :class class :font-weight font-weight :color color - :bgcolor bgcolor :border border :padding padding - :ref ref :width width - (text (expr :value (etaf-ui--reactive-value text))))) - (etaf-view - (text :class class :font-weight font-weight :color color - :bgcolor bgcolor :ref ref - (expr :value (etaf-ui--reactive-value text))))))) - -(defun etaf-ui--panel-view (title class color bgcolor border padding ref) - "Render a themed Panel View. -Arguments are TITLE, CLASS, COLOR, BGCOLOR, BORDER, PADDING, and REF." - (let ((theme (etaf-ui-theme-tokens :ui-panel-fg :ui-panel-bg - :ui-panel-border))) - (etaf-view - (column - :class (etaf-ui--class-value "etaf-panel" nil class) - :color (or color (plist-get theme :ui-panel-fg)) - :bgcolor (or bgcolor (plist-get theme :ui-panel-bg)) - :border (or border - (etaf-ui--theme-border - (plist-get theme :ui-panel-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-panel - (&key title class color bgcolor border padding ref) - "Render a titled panel with header and default slot projections." - :styles - (styles - ("&" :padding (1 2)) - (".etaf-panel-title" :font-weight bold)) - :view - (expr :value - (etaf-ui--panel-view title class color bgcolor border padding ref))) - -;;;###autoload -(etaf-define-component etaf-data-grid - (&key controller columns row-key on-row-press - 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. Interactive rows require ROW-REF to return -a stable Host reference." - :styles - (styles - (".etaf-data-grid-header" :font-weight bold :padding (0 1)) - (".etaf-data-grid-header-cell" :font-weight bold) - (".etaf-data-grid-row" :padding (0 1)) - ;; Selection color and error color are dynamic semantic props below, so - ;; this Component style scope contains geometry only. - ) - :setup - (let ((row-actions (make-hash-table :test #'equal)) - (row-states (make-hash-table :test #'equal)) - current-controller current-columns current-row-key current-row-ref - current-on-row-press current-selected-key current-row-selected-p - current-loading-label current-error-label current-empty-label - body-config body-expr body-thunk body-range-snapshot body-range-item) - (setq - body-thunk - (lambda () - (let* ((status - (etaf-value (etaf-data-status current-controller))) - (items - (etaf-value (etaf-data-items current-controller))) - (theme - (etaf-ui-theme-tokens :ui-grid-border - :ui-grid-selected-bg))) - (etaf-ui--grid-body-items - current-controller status items current-columns current-row-key - current-row-ref current-on-row-press current-selected-key - current-row-selected-p row-actions row-states theme - current-loading-label current-error-label current-empty-label)))) - (setq - body-range-snapshot - (lambda () - (let ((status (etaf-value (etaf-data-status current-controller))) - (items (etaf-value (etaf-data-items current-controller)))) - (when (and (eq status 'success) items) - (let ((theme - (etaf-ui-theme-tokens :ui-grid-border - :ui-grid-selected-bg))) - (list - :items - (etaf-ui--grid-keyed-items - items current-row-key row-actions row-states) - :context theme)))))) - (setq - body-range-item - (lambda (entry theme) - (let* ((key (car entry)) - (item (cdr entry)) - (state (etaf-ui--grid-row-state row-states key))) - (etaf-ui--grid-row - item key current-columns current-row-ref current-on-row-press - current-selected-key current-row-selected-p - (unless (or current-row-selected-p current-selected-key) - (etaf-data-selected-ref current-controller key)) - row-actions theme (car state) (cdr state))))) - (lambda () - (let* ((controller (etaf-current-prop :controller)) - (columns (etaf-current-prop :columns)) - (row-key (etaf-current-prop :row-key)) - (row-ref (etaf-current-prop :row-ref)) - (on-row-press (etaf-current-prop :on-row-press)) - (selected-key (etaf-current-prop :selected-key)) - (row-selected-p (etaf-current-prop :row-selected-p)) - (loading-label (etaf-current-prop :loading-label)) - (error-label (etaf-current-prop :error-label)) - (empty-label (etaf-current-prop :empty-label)) - (config - (list controller columns row-key row-ref on-row-press - selected-key row-selected-p loading-label error-label - empty-label)) - (theme (etaf-ui-theme-tokens :ui-fg :ui-grid-border)) - (theme-color (plist-get theme :ui-fg))) - (unless (eq controller current-controller) - (clrhash row-actions) - (clrhash row-states)) - (setq current-controller controller - current-columns columns - current-row-key row-key - current-row-ref row-ref - current-on-row-press on-row-press - current-selected-key selected-key - current-row-selected-p row-selected-p - current-loading-label loading-label - current-error-label error-label - current-empty-label empty-label) - (unless (equal-including-properties config body-config) - (setq body-config (copy-tree config) - body-expr - (etaf--expr-create - :token (gensym "etaf-data-grid-body-") - :thunk body-thunk - :range-snapshot body-range-snapshot - :range-key #'car - :range-item body-range-item))) - (etaf--view-call - 'column - (list :class "etaf-data-grid" :color theme-color) - (list - (etaf-ui--grid-header columns theme) - (etaf--view-call - 'column (list :class "etaf-data-grid-body") - (list body-expr)) - (etaf--slot-projection-create - :name 'footer :token 'etaf-ui-data-grid-footer :fallback nil))))))) - -;;;###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) - (".etaf-pagination-label" :font-weight bold)) - :setup - (let* ((current-controller nil) - (current-parent-color nil) - (current-parent-bgcolor nil) - (page-value - (lambda () - (max 1 (or (etaf-value - (etaf-data-page current-controller)) - 1)))) - (page-size-value - (lambda () - (max 1 (or (etaf-value - (etaf-data-page-size current-controller)) - 1)))) - (total-value - (lambda () - (max 0 (or (etaf-value - (etaf-data-total current-controller)) - 0)))) - (pages-value - (lambda () - (max 1 (ceiling (/ (float (funcall total-value)) - (funcall page-size-value)))))) - (loading-p - (lambda () - (eq (etaf-value (etaf-data-status current-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 () - (when (and current-controller - (not (funcall previous-disabled))) - (etaf-data-previous-page current-controller)))) - (next - (lambda () - (when (and current-controller - (not (funcall next-disabled))) - (etaf-data-next-page current-controller))))) - (lambda () - (let* ((controller-value (etaf-current-prop :controller)) - (theme (etaf-ui-theme-tokens :ui-fg :ui-bg - :ui-disabled-fg - :ui-pagination-muted-fg)) - (parent-color (or (etaf-current-prop :color) - (plist-get theme :ui-fg))) - (parent-bgcolor (or (etaf-current-prop :bgcolor) - (plist-get theme :ui-bg))) - (arrow-border '(0 solid "transparent"))) - (setq current-controller controller-value - current-parent-color parent-color - current-parent-bgcolor parent-bgcolor) - (etaf-view - (flex - :class (etaf-ui--class-value "etaf-pagination" nil - (etaf-current-prop :class)) - :width 'stretch - :flex-direction 'row - :align-items 'center - :role 'navigation - :aria-label (or (etaf-current-prop :aria-label) "Pagination") - :color parent-color - :bgcolor parent-bgcolor - :border (etaf-current-prop :border) - :box-sizing 'border-box - :padding (or (etaf-current-prop :padding) '(0 1)) - :gap '(0 (1)) - (column :width 'max-content - :flex-grow 0 :flex-shrink 0 :flex-basis 'auto - (button :label "←" :ref (etaf-current-prop :previous-ref) - :aria-label "Previous page" - :disabled (funcall previous-disabled) - :padding '(0 0) - :border arrow-border - :color (if (funcall previous-disabled) - (plist-get theme :ui-disabled-fg) - current-parent-color) - :bgcolor current-parent-bgcolor - :font-weight 'bold - :on-press previous)) - (column - :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 - (box :class "etaf-pagination-label" :text-align 'center - :wrap-mode 'none :min-width 'max-content - (text - (expr :value - (format "Page %d / %d" - (funcall page-value) - (funcall pages-value))))) - (box :class "etaf-pagination-summary" :text-align 'center - :color (plist-get theme :ui-pagination-muted-fg) - :wrap-mode 'none :min-width 'max-content - (text - (expr :value - (let* ((page (funcall page-value)) - (page-size (funcall page-size-value)) - (total (funcall total-value)) - (first-item - (if (zerop total) - 0 - (1+ (* (1- page) page-size)))) - (last-item (min total (* page page-size)))) - (format "%d–%d of %d" - first-item last-item total)))))) - (column :width 'max-content - :flex-grow 0 :flex-shrink 0 :flex-basis 'auto - (button :label "→" :ref (etaf-current-prop :next-ref) - :aria-label "Next page" - :disabled (funcall next-disabled) - :padding '(0 0) - :border arrow-border - :color (if (funcall next-disabled) - (plist-get theme :ui-disabled-fg) - current-parent-color) - :bgcolor current-parent-bgcolor - :font-weight 'bold - :on-press next)))))))) +(require 'etaf-ui-basic) +(require 'etaf-ui-table) +(require 'etaf-ui-data) (provide 'etaf-ui) - ;;; etaf-ui.el ends here diff --git a/scripts/etaf-ui-m0a-inventory.el b/scripts/etaf-ui-m0a-inventory.el index 3bb7f50..c9df7bd 100644 --- a/scripts/etaf-ui-m0a-inventory.el +++ b/scripts/etaf-ui-m0a-inventory.el @@ -252,6 +252,10 @@ ROOT defaults to the etaf-ui package root." (list :schema-version 1 :milestone 'M0b :evidence-mode 'migrated-public-extension-seam + :datagrid-contract + '(:handler-publication postcommit-promoted + :fallback-ref instance-scoped-uninterned + :fixed-width-row single-text-host) :components (etaf-ui-m0a-component-inventory) :m0a-private-production-baseline etaf-ui-m0a-private-production-callsites diff --git a/tests/etaf-ui-m0a-inventory-tests.el b/tests/etaf-ui-m0a-inventory-tests.el index 7533522..462fbd7 100644 --- a/tests/etaf-ui-m0a-inventory-tests.el +++ b/tests/etaf-ui-m0a-inventory-tests.el @@ -171,6 +171,11 @@ (should (eq 'M0b (plist-get inventory :milestone))) (should (eq 'migrated-public-extension-seam (plist-get inventory :evidence-mode))) + (should + (equal '(:handler-publication postcommit-promoted + :fallback-ref instance-scoped-uninterned + :fixed-width-row single-text-host) + (plist-get inventory :datagrid-contract))) (should (= 7 (length (plist-get inventory :m0a-private-production-baseline)))) (should-not diff --git a/tests/etaf-ui-m0b-extension-tests.el b/tests/etaf-ui-m0b-extension-tests.el index 7c7b565..29d1bce 100644 --- a/tests/etaf-ui-m0b-extension-tests.el +++ b/tests/etaf-ui-m0b-extension-tests.el @@ -200,5 +200,178 @@ (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-ui-m0b-data-grid-late-row-failure-keeps-committed-handler () + "Do not leak an early candidate row when a later row fails rendering." + (let* ((old-rows '((:id 1 :name "Committed") (:id 2 :name "Stable"))) + (new-rows '((:id 1 :name "UNCOMMITTED") + (:id 2 :name "Late failure"))) + (source (etaf-data-memory-source old-rows :id-key :id)) + (controller (etaf-data-controller source :page-size 10 :auto-load t)) + (buffer-name " *etaf-ui-m0b-grid-late-failure*") + fail-late pressed) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-data-grid + :controller controller + :columns '((:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :row-ref + (lambda (row) + (unless (and fail-late (= 2 (plist-get row :id))) + (intern (format "late-row-%s" (plist-get row :id))))) + :on-row-press (lambda (row) (setq pressed row))))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (text (with-current-buffer buffer-name (buffer-string))) + (handler + (cdr (assq 'press + (etaf-runtime-handler-for runtime 'late-row-1))))) + (setq fail-late t) + (should-error + (setf (etaf-value (etaf-data-items controller)) new-rows)) + (should (eq generation + (etaf-runtime-current-generation runtime))) + (should (equal-including-properties + text (with-current-buffer buffer-name (buffer-string)))) + (should (eq handler + (cdr (assq + 'press + (etaf-runtime-handler-for runtime 'late-row-1))))) + (etaf-dispatch-event runtime 'late-row-1 'press) + (should (equal "Committed" (plist-get pressed :name))) + (setq fail-late nil) + (setf (etaf-value (etaf-data-items controller)) old-rows) + (setf (etaf-value (etaf-data-items controller)) new-rows) + (should (eq handler + (cdr (assq + 'press + (etaf-runtime-handler-for runtime 'late-row-1))))) + (etaf-dispatch-event runtime 'late-row-1 'press) + (should (equal "UNCOMMITTED" (plist-get pressed :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-m0b-data-grid-prunes-committed-handler-cache () + "Bound the stable handler cache to currently retained interactive keys." + (let* ((rows-a '((:id 1 :name "A") (:id 2 :name "B") + (:id 3 :name "C"))) + (rows-b '((:id 4 :name "D") (:id 5 :name "E") + (:id 6 :name "F"))) + (source (etaf-data-memory-source rows-a :id-key :id)) + (controller (etaf-data-controller source :page-size 10 :auto-load t)) + (buffer-name " *etaf-ui-m0b-grid-handler-prune*") + state) + (unwind-protect + (progn + (let ((promote + (symbol-function 'etaf-ui--data-grid-promote-row-actions))) + (cl-letf + (((symbol-function 'etaf-ui--data-grid-promote-row-actions) + (lambda (candidate-state) + (setq state candidate-state) + (funcall promote candidate-state)))) + (etaf-mount + buffer-name + (etaf-view + (etaf-data-grid + :controller controller + :columns '((:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :row-ref (lambda (row) + (intern (format "prune-row-%s" + (plist-get row :id)))) + :on-row-press #'ignore))))) + (should state) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (cache (plist-get state :row-actions))) + (should (= 3 (hash-table-count cache))) + (dolist (key '(1 2 3)) + (etaf-data-mutate controller 'delete key)) + (dolist (row rows-b) + (etaf-data-mutate controller 'insert row)) + (should (= 3 (hash-table-count cache))) + (dolist (key '(1 2 3)) (should-not (gethash key cache))) + (dolist (key '(4 5 6)) (should (gethash key cache))) + (dolist (key '(4 5 6)) + (etaf-data-mutate controller 'delete key)) + (should (zerop (hash-table-count cache))))) + (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-m0b-data-grid-default-refs-are-instance-scoped () + "Keep fallback refs distinct across grids and typed row identities." + (let* ((rows '((:id foo :name "Symbol") (:id "foo" :name "String"))) + (source (etaf-data-memory-source rows :id-key :id)) + (controller (etaf-data-controller source :page-size 10 :auto-load t)) + (buffer-name " *etaf-ui-m0b-grid-default-ref-scope*")) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (column + (etaf-data-grid + :controller controller + :columns '((:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :on-row-press #'ignore) + (etaf-data-grid + :controller controller + :columns '((:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :on-row-press #'ignore)))) + (let (refs) + (maphash + (lambda (ref props) + (when (member (plist-get props :key) '(foo "foo")) + (push ref refs))) + (etaf-runtime-host-props + (etaf-runtime-for-buffer buffer-name))) + (should (= 4 (length refs))) + (should (= 4 (length (delete-dups (copy-sequence refs))))))) + (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-m0b-data-grid-error-status-beats-retained-items () + "Show the error state when a failed reload retains previously loaded rows." + (let* ((rows '((:id 1 :name "Existing"))) + (source (etaf-data-memory-source rows :id-key :id)) + (controller (etaf-data-controller source :page-size 10 :auto-load t)) + (buffer-name " *etaf-ui-m0b-grid-retained-error*")) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-data-grid + :controller controller + :columns '((:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :error-label "Retained load failed" + :empty-label "EMPTY-LABEL"))) + (setf (etaf-value (etaf-data-status controller)) 'error) + (let ((text (with-current-buffer buffer-name + (substring-no-properties (buffer-string))))) + (should (string-match-p "Retained load failed" text)) + (should-not (string-match-p "EMPTY-LABEL" text)) + (should-not (string-match-p "Existing" text)))) + (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))))) + (provide 'etaf-ui-m0b-extension-tests) ;;; etaf-ui-m0b-extension-tests.el ends here diff --git a/tests/etaf-ui-tests.el b/tests/etaf-ui-tests.el index caaa76a..1bb9ad4 100644 --- a/tests/etaf-ui-tests.el +++ b/tests/etaf-ui-tests.el @@ -29,11 +29,15 @@ (let (found) (maphash (lambda (_ref props) - (when (equal (plist-get props :class) class) + (when (member class (etaf--class-tokens (plist-get props :class))) (setq found props))) (etaf-runtime-host-props (etaf-runtime-for-buffer buffer-name))) found)) +(defun etaf-ui-test--has-class-p (props class) + "Return non-nil when PROPS contain CLASS." + (member class (etaf--class-tokens (plist-get props :class)))) + (defun etaf-ui-test--paint-color (value property) "Return effective paint color from VALUE for Ebox PROPERTY." (if (not (tp-paint-slot-p value)) @@ -63,49 +67,49 @@ :setup (progn (etaf-theme-provide '(:color "theme-color" - :bgcolor "theme-bg" + :background-color "theme-bg" :padding (9 9))) - (lambda () - (etaf-view - (row - (button :label "Styled" :ref 'styled-button) - (button :label "Custom" :ref 'custom-button + nil) + :view + (row + (etaf-button :label "Styled" :ref 'styled-button) + (etaf-button :label "Custom" :ref 'custom-button :color "explicit-color") - (label :text "Themed" :ref 'themed-label + (etaf-label :text "Themed" :ref 'themed-label :color nil :bgcolor nil) - (panel :title "Styled panel" :ref 'styled-panel)))))) + (etaf-panel :title "Styled panel" :ref 'styled-panel))) (etaf-define-component etaf-ui-test-token-theme-fixture () "Provide explicit UI Button tokens through ETAF Theme." :setup (progn (etaf-theme-provide - '(:ui-button-color "token-fg" - :ui-button-bgcolor "token-bg" - :ui-button-border "token-border" - :ui-button-secondary-color "secondary-fg" - :ui-button-secondary-bgcolor "secondary-bg" + '(:ui-button-primary-fg "token-fg" + :ui-button-primary-bg "token-bg" + :ui-button-primary-border "token-border" + :ui-button-secondary-fg "secondary-fg" + :ui-button-secondary-bg "secondary-bg" :ui-button-secondary-border "secondary-border")) - (lambda () - (etaf-view - (row - (button :label "Token" :ref 'token-button) - (button :label "Secondary" :ref 'token-secondary - :variant 'secondary)))))) + nil) + :view + (row + (etaf-button :label "Token" :ref 'token-button) + (etaf-button :label "Secondary" :ref 'token-secondary + :variant 'secondary))) (etaf-define-component etaf-ui-test-grid-theme-fixture (&key controller theme) "Provide a reactive Theme around one DataGrid for palette tests." :setup (progn - (etaf-theme-provide (etaf-current-prop :theme)) - (lambda () - (etaf-view - (data-grid - :controller (etaf-current-prop :controller) - :columns '((:key :id :label "ID") (:key :name :label "Name")) - :row-key (lambda (row) (plist-get row :id)) - :selected-key 1))))) + (etaf-theme-provide theme) + nil) + :view + (etaf-data-grid + :controller controller + :columns '((:key :id :label "ID") (:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :row-selected-p (lambda (row) (= (plist-get row :id) 1)))) (ert-deftest etaf-ui-button-use-behavior-dispatches-through-host () "Install Button `:use' Behavior and dispatch its merged callback." @@ -116,7 +120,7 @@ (etaf-mount buffer-name (etaf-view - (button :label "Behavior" :ref 'behavior-button + (etaf-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) @@ -132,21 +136,21 @@ (unwind-protect (progn (etaf-mount buffer-name - (etaf-view (ui-test-theme-fixture))) + (etaf-view (etaf-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 :background-color) "#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 custom :background-color) "#2F6B43")) (should (equal (plist-get themed :color) "theme-color")) - (should (equal (plist-get themed :bgcolor) "theme-bg")) + (should (equal (plist-get themed :background-color) "theme-bg")) (should-not (plist-get themed :padding)) (should (equal (plist-get panel :color) "#252A2E")) - (should (equal (plist-get panel :bgcolor) "#FFFDF8")) + (should (equal (plist-get panel :background-color) "#FFFDF8")) (should (equal (plist-get panel :padding) '(1 2))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-unmount runtime)) @@ -159,14 +163,15 @@ (unwind-protect (progn (etaf-mount buffer-name - (etaf-view (ui-test-token-theme-fixture))) + (etaf-view (etaf-ui-test-token-theme-fixture))) (let ((token (etaf-ui-test--props buffer-name 'token-button)) (secondary (etaf-ui-test--props buffer-name 'token-secondary))) (should (equal "token-fg" (plist-get token :color))) - (should (equal "token-bg" (plist-get token :bgcolor))) + (should (equal "token-bg" (plist-get token :background-color))) (should (equal "token-border" (plist-get token :border))) (should (equal "secondary-fg" (plist-get secondary :color))) - (should (equal "secondary-bg" (plist-get secondary :bgcolor))) + (should (equal "secondary-bg" + (plist-get secondary :background-color))) (should (equal "secondary-border" (plist-get secondary :border))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) @@ -183,7 +188,7 @@ (etaf-mount buffer-name (etaf-view - (number-input :label "Rows" :value value :ref 'rows + (etaf-number-input :label "Rows" :value value :ref 'rows :min 1 :max 10 :on-change (lambda (next) (setq value next))))) (cl-letf (((symbol-function 'read-number) @@ -204,7 +209,7 @@ (progn (etaf-mount buffer-name (etaf-view - (button :label "Save" :ref 'save + (etaf-button :label "Save" :ref 'save :class "primary" :color "#FFFFFF" :bgcolor "#2F6B43" @@ -221,11 +226,11 @@ (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 :background-color) "#2F6B43")) (should (equal (plist-get props :border) "#2F6B43")) (should (equal (plist-get props :padding) '(0 2))) (should (equal (plist-get props :font-weight) 'bold)) - (should (string-match-p "primary" (plist-get props :class)))) + (should (etaf-ui-test--has-class-p props "primary"))) (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name) 'save 'press) (should (= presses 1))) @@ -244,22 +249,22 @@ (etaf-mount buffer-name (etaf-view (row - (button :label "Save" :ref 'enabled-save + (etaf-button :label "Save" :ref 'enabled-save :on-press (lambda () (cl-incf presses))) - (button :label "Delete" :ref 'disabled-delete + (etaf-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 :background-color) "#2F6B43")) (should (equal (plist-get props :padding) '(0 1))) (should (equal (plist-get props :font-weight) '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 (equal (plist-get props :background-color) "#E5E7EB")) + (should (etaf-ui-test--has-class-p props "disabled"))) (should-error (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name) 'disabled-delete 'press) @@ -283,7 +288,7 @@ (etaf-mount buffer-name (etaf-view - (button :label "Unavailable" :ref 'themed-disabled + (etaf-button :label "Unavailable" :ref 'themed-disabled :disabled t :color "#F4F7FF" :bgcolor "#202C42" :border "#34435A"))) (let ((position @@ -309,12 +314,12 @@ (etaf-mount buffer-name (etaf-view - (button :label "Run health check" :ref 'health + (etaf-button :label "Run health check" :ref 'health :variant 'secondary :on-press (lambda () (cl-incf presses))))) (let ((props (etaf-ui-test--props buffer-name 'health))) (should (equal (plist-get props :color) "#142235")) - (should (equal (plist-get props :bgcolor) "#D9EEEA"))) + (should (equal (plist-get props :background-color) "#D9EEEA"))) (let* ((runtime (etaf-runtime-for-buffer buffer-name)) (before (cdr (assq 'press (etaf-runtime-handler-for runtime 'health))))) @@ -347,7 +352,7 @@ (progn (etaf-mount buffer-name (etaf-view - (checkbox :label "Done" :ref 'done + (etaf-checkbox :label "Done" :ref 'done :checked (etaf-value checked) :on-change (lambda (value) (setq next value) @@ -382,7 +387,7 @@ (etaf-mount buffer-name (etaf-view - (checkbox :label "Live" :ref 'live-checkbox :checked checked + (etaf-checkbox :label "Live" :ref 'live-checkbox :checked checked :on-change (lambda (value) (setf (etaf-value checked) value))))) (let ((render (symbol-function @@ -410,7 +415,7 @@ (unwind-protect (progn (etaf-mount buffer-name - (etaf-view (label :text text :ref 'live-label))) + (etaf-view (etaf-label :text text :ref 'live-label))) (let ((render (symbol-function 'etaf--runtime-render-dirty-component))) (cl-letf (((symbol-function 'etaf--runtime-render-dirty-component) @@ -434,18 +439,18 @@ (etaf-mount buffer-name (etaf-view (row - (checkbox :label "Open" :ref 'open-box + (etaf-checkbox :label "Open" :ref 'open-box :on-change (lambda (_value) (cl-incf changes))) - (checkbox :label "Closed" :ref 'closed-box + (etaf-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 (equal (plist-get props :background-color) "#EEEAE2")) + (should (etaf-ui-test--has-class-p props "disabled"))) (should-error (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name) 'closed-box 'press) @@ -468,25 +473,28 @@ (etaf-mount buffer-name (etaf-view - (panel :title "Account" :ref 'account-panel - :class "surface" :color "#252A2E" :bgcolor "#FFFDF8" + (etaf-panel :title "Account" :ref 'account-panel + :class "surface" :color "#252A2E" + :background-color "#FFFDF8" :border "#687386" :padding '(1 2) (slot :name 'header - (label :text "Settings" :ref 'settings-label - :class "eyebrow" :color "#66706A" - :font-weight 'bold :width 12)) - (label :text "Body")))) + (box :width 12 :ref 'settings-cell + (etaf-label :text "Settings" :ref 'settings-label + :class "eyebrow" :color "#66706A" + :font-weight 'bold))) + (etaf-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))) + (label (etaf-ui-test--props buffer-name 'settings-label)) + (cell (etaf-ui-test--props buffer-name 'settings-cell))) + (should (etaf-ui-test--has-class-p panel "surface")) (should (equal (plist-get panel :color) "#252A2E")) - (should (equal (plist-get panel :bgcolor) "#FFFDF8")) + (should (equal (plist-get panel :background-color) "#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 (etaf-ui-test--has-class-p label "eyebrow")) (should (equal (plist-get label :color) "#66706A")) (should (equal (plist-get label :font-weight) 'bold)) - (should (equal (plist-get label :width) 12))) + (should (equal (plist-get cell :width) 12))) (dolist (label '("Account" "Settings" "Body")) (should (string-match-p (regexp-quote label) (etaf-ui-test--text buffer-name))))) @@ -508,14 +516,14 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID") (:key :name :label "Name")) :row-key (lambda (row) (plist-get row :id)) :row-ref (lambda (row) (intern (format "row-%d" (plist-get row :id)))) - :selected-key 2 + :row-selected-p (lambda (row) (= (plist-get row :id) 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)) @@ -524,10 +532,8 @@ (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" (or (plist-get second :class) ""))) - (should-not (string-match-p - "selected" (or (plist-get first :class) "")))) + (should (etaf-ui-test--has-class-p second "selected")) + (should-not (etaf-ui-test--has-class-p first "selected"))) (let* ((runtime (etaf-runtime-for-buffer buffer-name)) (handler (cdr (assq 'press (etaf-runtime-handler-for runtime @@ -557,15 +563,13 @@ :id-key :id)) (controller (etaf-data-controller source :auto-load t)) (buffer-name " *etaf-ui-grid-keyed-selection-test*") - (row-renders (make-hash-table :test #'eql)) - (body-renders 0) host-updates) (unwind-protect (progn (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID") (:key :name :label "Name")) @@ -581,23 +585,11 @@ (third-handler (cdr (assq 'press (etaf-runtime-handler-for runtime 'keyed-row-3)))) - (old-grid-row (symbol-function 'etaf-ui--grid-row)) - (old-grid-rows (symbol-function 'etaf-ui--grid-rows)) (old-host (symbol-function 'ebox-candidate-replace-host-ref)) (old-paint (symbol-function 'ebox-candidate-patch-host-paint))) - (cl-letf (((symbol-function 'etaf-ui--grid-row) - (lambda (&rest args) - (let ((key (nth 1 args))) - (puthash key (1+ (gethash key row-renders 0)) - row-renders)) - (apply old-grid-row args))) - ((symbol-function 'etaf-ui--grid-rows) - (lambda (&rest args) - (cl-incf body-renders) - (apply old-grid-rows args))) - ((symbol-function 'ebox-candidate-replace-host-ref) + (cl-letf (((symbol-function 'ebox-candidate-replace-host-ref) (lambda (candidate ref node) (push ref host-updates) (funcall old-host candidate ref node))) @@ -608,11 +600,6 @@ ;; Prove direct public selection ref writes use the same keyed ;; invalidation path as the selection helpers. (setf (etaf-value (etaf-data-selection controller)) '(2))) - (should (zerop (gethash 1 row-renders 0))) - (should (zerop (gethash 2 row-renders 0))) - (should (zerop (gethash 3 row-renders 0))) - (should (zerop (hash-table-count row-renders))) - (should (zerop body-renders)) (should (member 'keyed-row-1 host-updates)) (should (member 'keyed-row-2 host-updates)) (should-not (member 'keyed-row-3 host-updates)) @@ -642,10 +629,10 @@ (ert-deftest etaf-ui-data-grid-follows-inherited-theme-color () "Re-render DataGrid rows when only inherited Theme color changes." - (let* ((theme (etaf-ref '(:color "light-ink" - :ui-grid-border "light-grid-border" - :ui-grid-selected-fg "light-selected" - :ui-grid-selected-bg "light-selected-bg"))) + (let* ((theme (etaf-ref '(:ui-fg "light-ink" + :ui-table-border "light-grid-border" + :ui-table-selected-fg "light-selected" + :ui-table-selected-bg "light-selected-bg"))) (source (etaf-data-memory-source '((:id 1 :name "Ada") (:id 2 :name "Grace")) :id-key :id)) (controller (etaf-data-controller source :auto-load t)) @@ -655,27 +642,36 @@ (etaf-mount buffer-name (etaf-view - (ui-test-grid-theme-fixture :controller controller :theme theme))) + (etaf-ui-test-grid-theme-fixture + :controller controller :theme theme))) (let* ((props (etaf-ui-test--props-with-key buffer-name 1)) - (background-slot (plist-get props :bgcolor)) + (foreground-slot (plist-get props :color)) + (background-slot (plist-get props :background-color)) (border-slot (plist-get props :border-bottom-color))) + (should (equal "light-selected" + (etaf-ui-test--paint-color + foreground-slot :color))) (should (equal "light-selected-bg" (etaf-ui-test--paint-color background-slot :bgcolor))) (should (equal "light-grid-border" (etaf-ui-test--paint-color border-slot :border-bottom-color))) - (let ((row-props - (etaf-ui-test--props-with-key buffer-name 1))) - (should (= (plist-get row-props :border-bottom-width) 1)) - (should (eq (plist-get row-props :border-bottom-style) 'solid))) - (setf (etaf-value theme) '(:color "dark-ink" - :ui-grid-border "dark-grid-border" - :ui-grid-selected-fg "dark-selected" - :ui-grid-selected-bg "dark-selected-bg")) + (should (= (plist-get props :border-bottom-width) 1)) + (should (eq (plist-get props :border-bottom-style) 'solid)) + (setf (etaf-value theme) '(:ui-fg "dark-ink" + :ui-table-border "dark-grid-border" + :ui-table-selected-fg "dark-selected" + :ui-table-selected-bg "dark-selected-bg")) (let ((next (etaf-ui-test--props-with-key buffer-name 1))) - (should (eq background-slot (plist-get next :bgcolor))) - (should (eq border-slot (plist-get next :border-bottom-color))) + (should (eq background-slot + (plist-get next :background-color))) + (should (eq border-slot + (plist-get next :border-bottom-color))) + (should (eq foreground-slot (plist-get next :color))) + (should (equal "dark-selected" + (etaf-ui-test--paint-color + foreground-slot :color))) (should (equal "dark-selected-bg" (etaf-ui-test--paint-color background-slot :bgcolor))) @@ -700,7 +696,7 @@ (etaf-mount buffer-name (etaf-view - (pagination :controller controller + (etaf-pagination :controller controller :previous-ref 'page-previous :next-ref 'page-next))) (should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name))) @@ -750,7 +746,7 @@ (text "Left") (column :width 'stretch :padding '(0 2) :border "#CBD5E1" - (pagination :controller controller + (etaf-pagination :controller controller :previous-ref 'nested-page-previous :next-ref 'nested-page-next)) (text "Right")))) @@ -780,7 +776,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :title :label "Title" :width 22)) :row-key (lambda (row) (plist-get row :id))))) @@ -804,7 +800,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :progress :label "Progress" :width 8) (:key :kind :label "Kind" :width 7)) @@ -817,6 +813,18 @@ (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-ui-table-fixed-row-text-is-exact-and-fail-closed () + "Pad fixed-width rows exactly and retain the general path otherwise." + (should + (equal "Ada Essay " + (etaf-ui--table-fixed-row-text + '(:name "Ada" :kind "Essay") + '((:key :name :width 5) (:key :kind :width 7))))) + (should-not + (etaf-ui--table-fixed-row-text + '(:name "Ada" :kind "Essay") + '((:key :name :width 5) (:key :kind))))) + (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")) @@ -828,7 +836,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID")) :row-key (lambda (row) (plist-get row :id))))) @@ -841,22 +849,34 @@ (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." +(ert-deftest etaf-ui-data-grid-owns-default-interaction-ref () + "Dispatch an interactive DataGrid row through its internal stable ref." (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*")) + (buffer-name " *etaf-ui-grid-row-ref-test*") + pressed) (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))))) + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-data-grid + :controller controller + :columns '((:key :id :label "ID")) + :row-key (lambda (row) (plist-get row :id)) + :on-row-press (lambda (row) (setq pressed row))))) + (let (host-ref) + (maphash + (lambda (ref props) + (when (equal (plist-get props :key) 1) + (setq host-ref ref))) + (etaf-runtime-host-props + (etaf-runtime-for-buffer buffer-name))) + (should host-ref) + (etaf-dispatch-event + (etaf-runtime-for-buffer buffer-name) host-ref 'press) + (should (equal (plist-get pressed :id) 1)))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-unmount runtime)) (etaf-data-stop controller) @@ -874,7 +894,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID")) :row-key (lambda (row) (plist-get row :id)) @@ -904,7 +924,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID")) :row-key (lambda (row) (plist-get row :id)) @@ -934,7 +954,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID")))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) @@ -955,7 +975,7 @@ (etaf-mount buffer-name (etaf-view - (data-grid + (etaf-data-grid :controller controller :columns '((:key :id :label "ID")) :row-key (lambda (_row) nil)))))