fix: close M0b DataGrid publication contract
This commit is contained in:
parent
46617cc8b2
commit
a35b3dc469
19
Makefile
19
Makefile
@ -1,25 +1,34 @@
|
|||||||
EMACS ?= emacs
|
EMACS ?= emacs
|
||||||
LOAD_PATH = -L . -L ../etaf -L ../ebox -L ../ecss -L ../tp
|
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
|
all: check
|
||||||
|
|
||||||
compile:
|
compile:
|
||||||
rm -f *.elc tests/*.elc
|
rm -f *.elc tests/*.elc
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
|
$(EMACS) -Q --batch $(LOAD_PATH) \
|
||||||
--eval '(load-file "etaf-ui.el")' --eval '(byte-compile-file "etaf-ui.el")'
|
--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
|
test: compile
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
|
$(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
|
load: compile
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-ui))' \
|
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-ui))' \
|
||||||
--eval '(princ "etaf-ui load OK\n")'
|
--eval '(princ "etaf-ui load OK\n")'
|
||||||
|
|
||||||
checkdoc:
|
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
|
check: checkdoc compile test
|
||||||
|
|
||||||
|
|||||||
@ -107,8 +107,10 @@ the row. Without `:on-row-press`, rows have no callback or tab stop.
|
|||||||
<!-- M0b1: row-ref-optional -->
|
<!-- M0b1: row-ref-optional -->
|
||||||
`:row-ref` is optional for DataGrid. When it is omitted on an interactive
|
`: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
|
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
|
owned by the controller. Fallback refs are uninterned and scoped to each
|
||||||
and must return a non-nil stable Host reference for every row. `:row-key`
|
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
|
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
|
retains one action closure per row key, so selection or Data Range updates do
|
||||||
not recreate handlers for unchanged rows.
|
not recreate handlers for unchanged rows.
|
||||||
|
|||||||
@ -94,8 +94,10 @@ DataGrid 支持列描述、函数型 `:row-key`,以及可选的
|
|||||||
|
|
||||||
<!-- M0b1: row-ref-optional -->
|
<!-- M0b1: row-ref-optional -->
|
||||||
DataGrid 的 `:row-ref` 是可选项。交互式 grid 省略它时,DataGrid 会根据
|
DataGrid 的 `:row-ref` 是可选项。交互式 grid 省略它时,DataGrid 会根据
|
||||||
controller 持有的 row identity 派生稳定的内部 Host ref;显式提供它时,
|
controller 持有的 row identity 派生稳定的内部 Host ref。fallback ref 不会
|
||||||
该回调拥有 identity,并且必须为每一行返回非 nil 的稳定 Host ref。
|
进入全局 symbol table,并按每个 retained DataGrid instance 隔离,因此多个 grid
|
||||||
|
可以安全复用相同行 identity;显式提供它时,该回调拥有 identity,并且必须为
|
||||||
|
每一行返回非 nil 的稳定 Host ref。
|
||||||
`:row-key` 仍然是 retained row 必须具备的非 nil 稳定标量 identity。
|
`:row-key` 仍然是 retained row 必须具备的非 nil 稳定标量 identity。
|
||||||
DataGrid 按 row key 保留唯一 action closure,因此 selection 或 Data Range
|
DataGrid 按 row key 保留唯一 action closure,因此 selection 或 Data Range
|
||||||
更新不会为未变化的行重建 handler。
|
更新不会为未变化的行重建 handler。
|
||||||
|
|||||||
248
etaf-ui-basic.el
Normal file
248
etaf-ui-basic.el
Normal file
@ -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
|
||||||
234
etaf-ui-data.el
234
etaf-ui-data.el
@ -21,48 +21,122 @@
|
|||||||
(declare-function etaf-data-selected-ref "etaf-data" (controller identity))
|
(declare-function etaf-data-selected-ref "etaf-data" (controller identity))
|
||||||
(declare-function etaf-data-item-identity "etaf-data" (controller item))
|
(declare-function etaf-data-item-identity "etaf-data" (controller item))
|
||||||
|
|
||||||
(defun etaf-ui--data-grid-default-row-ref (controller row)
|
(defun etaf-ui--data-grid-default-row-ref (state controller row)
|
||||||
"Return a stable internal Host reference for 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
|
DataGrid owns this fallback so the presentational Table can keep its stricter
|
||||||
interactive-row contract. The controller's validated item identity is the
|
interactive-row contract. The controller's validated item identity is the
|
||||||
only input, making the reference stable across keyed Range updates."
|
row input. Per-instance uninterned symbols prevent cross-grid collisions and
|
||||||
(intern (format "etaf-data-grid-row-%s"
|
avoid process-global symbol-table growth."
|
||||||
(etaf-data-item-identity
|
(let* ((identity (etaf-data-item-identity controller row))
|
||||||
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.
|
"Return a validated stable Host reference for interactive ROW.
|
||||||
|
|
||||||
An explicit ROW-REF remains caller-owned. Interactive grids without one use
|
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
|
STATE's CONTROLLER identity fallback; when ON-ROW-PRESS is nil, rows have no
|
||||||
reference."
|
Host reference."
|
||||||
(when on-row-press
|
(when on-row-press
|
||||||
(let ((ref (if row-ref
|
(let ((ref (if row-ref
|
||||||
(funcall row-ref row)
|
(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
|
(unless ref
|
||||||
(error "ETAF DataGrid :row-ref must return a non-nil stable ref"))
|
(error "ETAF DataGrid :row-ref must return a non-nil stable ref"))
|
||||||
ref)))
|
ref)))
|
||||||
|
|
||||||
(defun etaf-ui--data-grid-row-action (cache key row callback)
|
(defun etaf-ui--data-grid-row-action-entry ()
|
||||||
"Return CACHE's stable press action for row KEY.
|
"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
|
(defun etaf-ui--data-grid-row-action (state key row callback)
|
||||||
CALLBACK change across renders. Unchanged keyed rows therefore keep the same
|
"Return STATE's stable action for row KEY, staging ROW and CALLBACK.
|
||||||
handler identity and avoid rebuilding behavior resources."
|
|
||||||
(let ((entry (gethash key cache)))
|
Committed handlers read only committed cells. Candidate rendering writes a
|
||||||
(unless entry
|
private stage that lifecycle hooks promote after successful publication."
|
||||||
(setq entry (vector row callback nil))
|
(let* ((cache (plist-get state :row-actions))
|
||||||
(aset entry 2
|
(stage (plist-get state :row-action-stage))
|
||||||
(lambda ()
|
(committed (gethash key cache)))
|
||||||
(let ((current (aref entry 1)))
|
(if (and committed
|
||||||
(when current
|
(equal-including-properties row (aref committed 0))
|
||||||
(funcall current (aref entry 0))))))
|
(eq callback (aref committed 1)))
|
||||||
(puthash key entry cache))
|
(aref committed 2)
|
||||||
(aset entry 0 row)
|
(unless (hash-table-p stage)
|
||||||
(aset entry 1 callback)
|
(error "ETAF DataGrid handler changed outside a keyed candidate"))
|
||||||
(aref entry 2)))
|
(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)
|
(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."
|
"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)))))
|
controller (etaf-data-item-identity controller row)))))
|
||||||
|
|
||||||
(defun etaf-ui--data-grid-row
|
(defun etaf-ui--data-grid-row
|
||||||
(controller entry columns row-ref on-row-press row-selected-p row-actions
|
(state controller entry columns row-ref on-row-press row-selected-p theme)
|
||||||
theme)
|
|
||||||
"Return one retained DataGrid row for keyed ENTRY.
|
"Return one retained DataGrid row for keyed ENTRY.
|
||||||
CONTROLLER owns selection identity; ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P
|
CONTROLLER owns selection identity; ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P
|
||||||
define the interaction contract. ROW-ACTIONS retains callback identity, and
|
define the interaction contract. STATE retains callback identity and stages
|
||||||
THEME is the resolved table-paint snapshot for this item."
|
candidate values; THEME is the resolved table-paint snapshot for this item."
|
||||||
(let* ((key (car entry))
|
(let* ((key (car entry))
|
||||||
(row (cdr entry))
|
(row (cdr entry))
|
||||||
(border-color (plist-get theme :ui-table-border))
|
(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
|
(list :key key
|
||||||
:class (concat "etaf-table-row" (when selected-p " selected"))
|
:class (concat "etaf-table-row" (when selected-p " selected"))
|
||||||
:ref (etaf-ui--data-grid-row-ref
|
: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)
|
:role (when on-row-press 'button)
|
||||||
:tab-index (when on-row-press 0)
|
:tab-index (when on-row-press 0)
|
||||||
:color (when selected-p
|
:color (when selected-p
|
||||||
@ -104,8 +177,8 @@ THEME is the resolved table-paint snapshot for this item."
|
|||||||
:on-press
|
:on-press
|
||||||
(and on-row-press
|
(and on-row-press
|
||||||
(etaf-ui--data-grid-row-action
|
(etaf-ui--data-grid-row-action
|
||||||
row-actions key row on-row-press)))
|
state key row on-row-press)))
|
||||||
(etaf-ui--table-cells row columns border-color))))
|
(etaf-ui--table-row-children row columns border-color))))
|
||||||
|
|
||||||
(defun etaf-ui--data-grid-state-label (key text &optional class 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.
|
"Return TEXT as a non-row DataGrid state label identified by KEY.
|
||||||
@ -115,28 +188,46 @@ CLASS and COLOR optionally style the label."
|
|||||||
nil))
|
nil))
|
||||||
|
|
||||||
(defun etaf-ui--data-grid-body-entries
|
(defun etaf-ui--data-grid-body-entries
|
||||||
(controller row-key loading-label error-label empty-label)
|
(state controller row-key on-row-press row-ref
|
||||||
"Return public keyed Range entries for CONTROLLER and labels.
|
loading-label error-label empty-label)
|
||||||
ROW-KEY identifies successful rows. Loading, error, and empty states use one
|
"Return keyed Range entries and begin STATE's candidate action stage.
|
||||||
stable sentinel entry so every body state remains below the same Range.
|
CONTROLLER and ROW-KEY identify successful rows. ON-ROW-PRESS and ROW-REF
|
||||||
LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override default state text."
|
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)))
|
(let* ((status (etaf-value (etaf-data-status controller)))
|
||||||
(items (etaf-value (etaf-data-items controller))))
|
(items (etaf-value (etaf-data-items controller)))
|
||||||
(cond
|
(entries
|
||||||
((and (eq status 'success) items)
|
(cond
|
||||||
(etaf-ui--table-entries items row-key))
|
((eq status 'loading)
|
||||||
((and (eq status 'loading) (null items))
|
(list (cons 'loading
|
||||||
(list (cons 'loading
|
(list :etaf-data-grid-state 'loading
|
||||||
(list :etaf-data-grid-state 'loading
|
:text (or loading-label "Loading...")))))
|
||||||
:text (or loading-label "Loading...")))))
|
((eq status 'error)
|
||||||
((and (eq status 'error) (null items))
|
(list (cons 'error
|
||||||
(list (cons 'error
|
(list :etaf-data-grid-state 'error
|
||||||
(list :etaf-data-grid-state 'error
|
:text (or error-label
|
||||||
:text (or error-label "Unable to load data.")))))
|
"Unable to load data.")))))
|
||||||
(t
|
(items (etaf-ui--table-entries items row-key))
|
||||||
(list (cons 'empty
|
(t
|
||||||
(list :etaf-data-grid-state 'empty
|
(list (cons 'empty
|
||||||
:text (or empty-label "No data."))))))))
|
(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)
|
(defun etaf-ui--data-grid-state-entry-node (entry)
|
||||||
"Return the state label View represented by keyed 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
|
(etaf-define-component etaf-ui--data-grid-body-item
|
||||||
(&key controller entry columns row-ref on-row-press row-selected-p
|
(&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."
|
"Render one retained keyed DataGrid ENTRY with a cached row action."
|
||||||
:view
|
:view
|
||||||
(expr
|
(expr
|
||||||
(if (plist-get (cdr entry) :etaf-data-grid-state)
|
(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
|
(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
|
(etaf-ui--style-tokens
|
||||||
:ui-table-border :ui-table-selected-fg :ui-table-selected-bg)))))
|
: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.
|
"Render DATA CONTROLLER state through the public Component DSL.
|
||||||
|
|
||||||
DataGrid owns loading, error, empty, and controller-selection adaptation.
|
DataGrid owns loading, error, empty, and controller-selection adaptation.
|
||||||
Its keyed Range retains row identity across insert, reorder, and update; setup
|
Its keyed Range retains row identity across insert, reorder, and update.
|
||||||
state only caches stable row action closures."
|
Setup state owns per-instance fallback refs plus commit-staged stable row
|
||||||
:setup (list :row-actions (make-hash-table :test #'equal))
|
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
|
:view
|
||||||
(column
|
(column
|
||||||
:class "etaf-data-grid etaf-table"
|
:class "etaf-data-grid etaf-table"
|
||||||
@ -182,12 +289,13 @@ state only caches stable row action closures."
|
|||||||
(etaf-ui--data-grid-body-item
|
(etaf-ui--data-grid-body-item
|
||||||
:for (entry
|
:for (entry
|
||||||
(etaf-ui--data-grid-body-entries
|
(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)
|
:key (car entry)
|
||||||
:controller controller :entry entry :columns columns
|
:controller controller :entry entry :columns columns
|
||||||
:row-ref row-ref :on-row-press on-row-press
|
:row-ref row-ref :on-row-press on-row-press
|
||||||
:row-selected-p row-selected-p
|
:row-selected-p row-selected-p
|
||||||
:row-actions (plist-get (etaf-state) :row-actions)))
|
:grid-state (etaf-state)))
|
||||||
(slot :name 'footer)))
|
(slot :name 'footer)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|||||||
71
etaf-ui-style.el
Normal file
71
etaf-ui-style.el
Normal file
@ -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
|
||||||
235
etaf-ui-table.el
Normal file
235
etaf-ui-table.el
Normal file
@ -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
|
||||||
963
etaf-ui.el
963
etaf-ui.el
@ -8,967 +8,14 @@
|
|||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
|
||||||
;; The official ETAF catalog is one ordinary Component library. It does not
|
;; Public facade for Components defined with ETAF. The catalog exposes no
|
||||||
;; expose a parallel Control/Widget taxonomy: a DataGrid is a compound
|
;; second Widget runtime, Theme system, data store, or layout engine.
|
||||||
;; Component built from the same View, props, slots, events, and Data APIs.
|
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'cl-lib)
|
(require 'etaf-ui-basic)
|
||||||
(require 'etaf)
|
(require 'etaf-ui-table)
|
||||||
|
(require 'etaf-ui-data)
|
||||||
(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))))))))
|
|
||||||
|
|
||||||
(provide 'etaf-ui)
|
(provide 'etaf-ui)
|
||||||
|
|
||||||
;;; etaf-ui.el ends here
|
;;; etaf-ui.el ends here
|
||||||
|
|||||||
@ -252,6 +252,10 @@ ROOT defaults to the etaf-ui package root."
|
|||||||
(list :schema-version 1
|
(list :schema-version 1
|
||||||
:milestone 'M0b
|
:milestone 'M0b
|
||||||
:evidence-mode 'migrated-public-extension-seam
|
: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)
|
:components (etaf-ui-m0a-component-inventory)
|
||||||
:m0a-private-production-baseline
|
:m0a-private-production-baseline
|
||||||
etaf-ui-m0a-private-production-callsites
|
etaf-ui-m0a-private-production-callsites
|
||||||
|
|||||||
@ -171,6 +171,11 @@
|
|||||||
(should (eq 'M0b (plist-get inventory :milestone)))
|
(should (eq 'M0b (plist-get inventory :milestone)))
|
||||||
(should (eq 'migrated-public-extension-seam
|
(should (eq 'migrated-public-extension-seam
|
||||||
(plist-get inventory :evidence-mode)))
|
(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
|
(should (= 7 (length (plist-get inventory
|
||||||
:m0a-private-production-baseline))))
|
:m0a-private-production-baseline))))
|
||||||
(should-not
|
(should-not
|
||||||
|
|||||||
@ -200,5 +200,178 @@
|
|||||||
(when-let* ((buffer (get-buffer buffer-name)))
|
(when-let* ((buffer (get-buffer buffer-name)))
|
||||||
(kill-buffer buffer)))))
|
(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)
|
(provide 'etaf-ui-m0b-extension-tests)
|
||||||
;;; etaf-ui-m0b-extension-tests.el ends here
|
;;; etaf-ui-m0b-extension-tests.el ends here
|
||||||
|
|||||||
@ -29,11 +29,15 @@
|
|||||||
(let (found)
|
(let (found)
|
||||||
(maphash
|
(maphash
|
||||||
(lambda (_ref props)
|
(lambda (_ref props)
|
||||||
(when (equal (plist-get props :class) class)
|
(when (member class (etaf--class-tokens (plist-get props :class)))
|
||||||
(setq found props)))
|
(setq found props)))
|
||||||
(etaf-runtime-host-props (etaf-runtime-for-buffer buffer-name)))
|
(etaf-runtime-host-props (etaf-runtime-for-buffer buffer-name)))
|
||||||
found))
|
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)
|
(defun etaf-ui-test--paint-color (value property)
|
||||||
"Return effective paint color from VALUE for Ebox PROPERTY."
|
"Return effective paint color from VALUE for Ebox PROPERTY."
|
||||||
(if (not (tp-paint-slot-p value))
|
(if (not (tp-paint-slot-p value))
|
||||||
@ -63,49 +67,49 @@
|
|||||||
:setup
|
:setup
|
||||||
(progn
|
(progn
|
||||||
(etaf-theme-provide '(:color "theme-color"
|
(etaf-theme-provide '(:color "theme-color"
|
||||||
:bgcolor "theme-bg"
|
:background-color "theme-bg"
|
||||||
:padding (9 9)))
|
:padding (9 9)))
|
||||||
(lambda ()
|
nil)
|
||||||
(etaf-view
|
:view
|
||||||
(row
|
(row
|
||||||
(button :label "Styled" :ref 'styled-button)
|
(etaf-button :label "Styled" :ref 'styled-button)
|
||||||
(button :label "Custom" :ref 'custom-button
|
(etaf-button :label "Custom" :ref 'custom-button
|
||||||
:color "explicit-color")
|
:color "explicit-color")
|
||||||
(label :text "Themed" :ref 'themed-label
|
(etaf-label :text "Themed" :ref 'themed-label
|
||||||
:color nil :bgcolor nil)
|
: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 ()
|
(etaf-define-component etaf-ui-test-token-theme-fixture ()
|
||||||
"Provide explicit UI Button tokens through ETAF Theme."
|
"Provide explicit UI Button tokens through ETAF Theme."
|
||||||
:setup
|
:setup
|
||||||
(progn
|
(progn
|
||||||
(etaf-theme-provide
|
(etaf-theme-provide
|
||||||
'(:ui-button-color "token-fg"
|
'(:ui-button-primary-fg "token-fg"
|
||||||
:ui-button-bgcolor "token-bg"
|
:ui-button-primary-bg "token-bg"
|
||||||
:ui-button-border "token-border"
|
:ui-button-primary-border "token-border"
|
||||||
:ui-button-secondary-color "secondary-fg"
|
:ui-button-secondary-fg "secondary-fg"
|
||||||
:ui-button-secondary-bgcolor "secondary-bg"
|
:ui-button-secondary-bg "secondary-bg"
|
||||||
:ui-button-secondary-border "secondary-border"))
|
:ui-button-secondary-border "secondary-border"))
|
||||||
(lambda ()
|
nil)
|
||||||
(etaf-view
|
:view
|
||||||
(row
|
(row
|
||||||
(button :label "Token" :ref 'token-button)
|
(etaf-button :label "Token" :ref 'token-button)
|
||||||
(button :label "Secondary" :ref 'token-secondary
|
(etaf-button :label "Secondary" :ref 'token-secondary
|
||||||
:variant 'secondary))))))
|
:variant 'secondary)))
|
||||||
|
|
||||||
(etaf-define-component etaf-ui-test-grid-theme-fixture
|
(etaf-define-component etaf-ui-test-grid-theme-fixture
|
||||||
(&key controller theme)
|
(&key controller theme)
|
||||||
"Provide a reactive Theme around one DataGrid for palette tests."
|
"Provide a reactive Theme around one DataGrid for palette tests."
|
||||||
:setup
|
:setup
|
||||||
(progn
|
(progn
|
||||||
(etaf-theme-provide (etaf-current-prop :theme))
|
(etaf-theme-provide theme)
|
||||||
(lambda ()
|
nil)
|
||||||
(etaf-view
|
:view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller (etaf-current-prop :controller)
|
:controller controller
|
||||||
:columns '((:key :id :label "ID") (:key :name :label "Name"))
|
:columns '((:key :id :label "ID") (:key :name :label "Name"))
|
||||||
:row-key (lambda (row) (plist-get row :id))
|
:row-key (lambda (row) (plist-get row :id))
|
||||||
:selected-key 1)))))
|
:row-selected-p (lambda (row) (= (plist-get row :id) 1))))
|
||||||
|
|
||||||
(ert-deftest etaf-ui-button-use-behavior-dispatches-through-host ()
|
(ert-deftest etaf-ui-button-use-behavior-dispatches-through-host ()
|
||||||
"Install Button `:use' Behavior and dispatch its merged callback."
|
"Install Button `:use' Behavior and dispatch its merged callback."
|
||||||
@ -116,7 +120,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(button :label "Behavior" :ref 'behavior-button
|
(etaf-button :label "Behavior" :ref 'behavior-button
|
||||||
:use (list (etaf-ui-test-press-behavior)))))
|
:use (list (etaf-ui-test-press-behavior)))))
|
||||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||||
'behavior-button 'press)
|
'behavior-button 'press)
|
||||||
@ -132,21 +136,21 @@
|
|||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(etaf-mount buffer-name
|
(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))
|
(let ((styled (etaf-ui-test--props buffer-name 'styled-button))
|
||||||
(custom (etaf-ui-test--props buffer-name 'custom-button))
|
(custom (etaf-ui-test--props buffer-name 'custom-button))
|
||||||
(themed (etaf-ui-test--props buffer-name 'themed-label))
|
(themed (etaf-ui-test--props buffer-name 'themed-label))
|
||||||
(panel (etaf-ui-test--props buffer-name 'styled-panel)))
|
(panel (etaf-ui-test--props buffer-name 'styled-panel)))
|
||||||
(should (equal (plist-get styled :color) "#FFFFFF"))
|
(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 styled :padding) '(0 1)))
|
||||||
(should (equal (plist-get custom :color) "explicit-color"))
|
(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 :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-not (plist-get themed :padding))
|
||||||
(should (equal (plist-get panel :color) "#252A2E"))
|
(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)))))
|
(should (equal (plist-get panel :padding) '(1 2)))))
|
||||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||||
(etaf-unmount runtime))
|
(etaf-unmount runtime))
|
||||||
@ -159,14 +163,15 @@
|
|||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(etaf-mount buffer-name
|
(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))
|
(let ((token (etaf-ui-test--props buffer-name 'token-button))
|
||||||
(secondary (etaf-ui-test--props buffer-name 'token-secondary)))
|
(secondary (etaf-ui-test--props buffer-name 'token-secondary)))
|
||||||
(should (equal "token-fg" (plist-get token :color)))
|
(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 "token-border" (plist-get token :border)))
|
||||||
(should (equal "secondary-fg" (plist-get secondary :color)))
|
(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"
|
(should (equal "secondary-border"
|
||||||
(plist-get secondary :border)))))
|
(plist-get secondary :border)))))
|
||||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||||
@ -183,7 +188,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(number-input :label "Rows" :value value :ref 'rows
|
(etaf-number-input :label "Rows" :value value :ref 'rows
|
||||||
:min 1 :max 10
|
:min 1 :max 10
|
||||||
:on-change (lambda (next) (setq value next)))))
|
:on-change (lambda (next) (setq value next)))))
|
||||||
(cl-letf (((symbol-function 'read-number)
|
(cl-letf (((symbol-function 'read-number)
|
||||||
@ -204,7 +209,7 @@
|
|||||||
(progn
|
(progn
|
||||||
(etaf-mount buffer-name
|
(etaf-mount buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(button :label "Save" :ref 'save
|
(etaf-button :label "Save" :ref 'save
|
||||||
:class "primary"
|
:class "primary"
|
||||||
:color "#FFFFFF"
|
:color "#FFFFFF"
|
||||||
:bgcolor "#2F6B43"
|
:bgcolor "#2F6B43"
|
||||||
@ -221,11 +226,11 @@
|
|||||||
(should (equal (plist-get props :tab-index) 3))
|
(should (equal (plist-get props :tab-index) 3))
|
||||||
(should (equal (plist-get props :aria-label) "Save changes"))
|
(should (equal (plist-get props :aria-label) "Save changes"))
|
||||||
(should (equal (plist-get props :color) "#FFFFFF"))
|
(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 :border) "#2F6B43"))
|
||||||
(should (equal (plist-get props :padding) '(0 2)))
|
(should (equal (plist-get props :padding) '(0 2)))
|
||||||
(should (equal (plist-get props :font-weight) 'bold))
|
(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)
|
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||||
'save 'press)
|
'save 'press)
|
||||||
(should (= presses 1)))
|
(should (= presses 1)))
|
||||||
@ -244,22 +249,22 @@
|
|||||||
(etaf-mount buffer-name
|
(etaf-mount buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(row
|
(row
|
||||||
(button :label "Save" :ref 'enabled-save
|
(etaf-button :label "Save" :ref 'enabled-save
|
||||||
:on-press (lambda () (cl-incf presses)))
|
:on-press (lambda () (cl-incf presses)))
|
||||||
(button :label "Delete" :ref 'disabled-delete
|
(etaf-button :label "Delete" :ref 'disabled-delete
|
||||||
:disabled t
|
:disabled t
|
||||||
:use (list (etaf-ui-test-press-behavior))
|
:use (list (etaf-ui-test-press-behavior))
|
||||||
:on-press (lambda () (cl-incf presses))))))
|
:on-press (lambda () (cl-incf presses))))))
|
||||||
(let ((props (etaf-ui-test--props buffer-name 'enabled-save)))
|
(let ((props (etaf-ui-test--props buffer-name 'enabled-save)))
|
||||||
(should (equal (plist-get props :color) "#FFFFFF"))
|
(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 :padding) '(0 1)))
|
||||||
(should (equal (plist-get props :font-weight) 'bold)))
|
(should (equal (plist-get props :font-weight) 'bold)))
|
||||||
(let ((props (etaf-ui-test--props buffer-name 'disabled-delete)))
|
(let ((props (etaf-ui-test--props buffer-name 'disabled-delete)))
|
||||||
(should (eq (plist-get props :disabled) t))
|
(should (eq (plist-get props :disabled) t))
|
||||||
(should-not (plist-get props :tab-index))
|
(should-not (plist-get props :tab-index))
|
||||||
(should (equal (plist-get props :bgcolor) "#E5E7EB"))
|
(should (equal (plist-get props :background-color) "#E5E7EB"))
|
||||||
(should (string-match-p "disabled" (plist-get props :class))))
|
(should (etaf-ui-test--has-class-p props "disabled")))
|
||||||
(should-error
|
(should-error
|
||||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||||
'disabled-delete 'press)
|
'disabled-delete 'press)
|
||||||
@ -283,7 +288,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(button :label "Unavailable" :ref 'themed-disabled
|
(etaf-button :label "Unavailable" :ref 'themed-disabled
|
||||||
:disabled t :color "#F4F7FF" :bgcolor "#202C42"
|
:disabled t :color "#F4F7FF" :bgcolor "#202C42"
|
||||||
:border "#34435A")))
|
:border "#34435A")))
|
||||||
(let ((position
|
(let ((position
|
||||||
@ -309,12 +314,12 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(button :label "Run health check" :ref 'health
|
(etaf-button :label "Run health check" :ref 'health
|
||||||
:variant 'secondary
|
:variant 'secondary
|
||||||
:on-press (lambda () (cl-incf presses)))))
|
:on-press (lambda () (cl-incf presses)))))
|
||||||
(let ((props (etaf-ui-test--props buffer-name 'health)))
|
(let ((props (etaf-ui-test--props buffer-name 'health)))
|
||||||
(should (equal (plist-get props :color) "#142235"))
|
(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))
|
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||||
(before (cdr (assq 'press
|
(before (cdr (assq 'press
|
||||||
(etaf-runtime-handler-for runtime 'health)))))
|
(etaf-runtime-handler-for runtime 'health)))))
|
||||||
@ -347,7 +352,7 @@
|
|||||||
(progn
|
(progn
|
||||||
(etaf-mount buffer-name
|
(etaf-mount buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(checkbox :label "Done" :ref 'done
|
(etaf-checkbox :label "Done" :ref 'done
|
||||||
:checked (etaf-value checked)
|
:checked (etaf-value checked)
|
||||||
:on-change (lambda (value)
|
:on-change (lambda (value)
|
||||||
(setq next value)
|
(setq next value)
|
||||||
@ -382,7 +387,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(checkbox :label "Live" :ref 'live-checkbox :checked checked
|
(etaf-checkbox :label "Live" :ref 'live-checkbox :checked checked
|
||||||
:on-change (lambda (value)
|
:on-change (lambda (value)
|
||||||
(setf (etaf-value checked) value)))))
|
(setf (etaf-value checked) value)))))
|
||||||
(let ((render (symbol-function
|
(let ((render (symbol-function
|
||||||
@ -410,7 +415,7 @@
|
|||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(etaf-mount buffer-name
|
(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
|
(let ((render (symbol-function
|
||||||
'etaf--runtime-render-dirty-component)))
|
'etaf--runtime-render-dirty-component)))
|
||||||
(cl-letf (((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-mount buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(row
|
(row
|
||||||
(checkbox :label "Open" :ref 'open-box
|
(etaf-checkbox :label "Open" :ref 'open-box
|
||||||
:on-change (lambda (_value)
|
:on-change (lambda (_value)
|
||||||
(cl-incf changes)))
|
(cl-incf changes)))
|
||||||
(checkbox :label "Closed" :ref 'closed-box
|
(etaf-checkbox :label "Closed" :ref 'closed-box
|
||||||
:disabled t
|
:disabled t
|
||||||
:on-change (lambda (_value)
|
:on-change (lambda (_value)
|
||||||
(cl-incf changes))))))
|
(cl-incf changes))))))
|
||||||
(let ((props (etaf-ui-test--props buffer-name 'closed-box)))
|
(let ((props (etaf-ui-test--props buffer-name 'closed-box)))
|
||||||
(should (eq (plist-get props :disabled) t))
|
(should (eq (plist-get props :disabled) t))
|
||||||
(should-not (plist-get props :tab-index))
|
(should-not (plist-get props :tab-index))
|
||||||
(should (equal (plist-get props :bgcolor) "#EEEAE2"))
|
(should (equal (plist-get props :background-color) "#EEEAE2"))
|
||||||
(should (string-match-p "disabled" (plist-get props :class))))
|
(should (etaf-ui-test--has-class-p props "disabled")))
|
||||||
(should-error
|
(should-error
|
||||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
|
||||||
'closed-box 'press)
|
'closed-box 'press)
|
||||||
@ -468,25 +473,28 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(panel :title "Account" :ref 'account-panel
|
(etaf-panel :title "Account" :ref 'account-panel
|
||||||
:class "surface" :color "#252A2E" :bgcolor "#FFFDF8"
|
:class "surface" :color "#252A2E"
|
||||||
|
:background-color "#FFFDF8"
|
||||||
:border "#687386" :padding '(1 2)
|
:border "#687386" :padding '(1 2)
|
||||||
(slot :name 'header
|
(slot :name 'header
|
||||||
(label :text "Settings" :ref 'settings-label
|
(box :width 12 :ref 'settings-cell
|
||||||
:class "eyebrow" :color "#66706A"
|
(etaf-label :text "Settings" :ref 'settings-label
|
||||||
:font-weight 'bold :width 12))
|
:class "eyebrow" :color "#66706A"
|
||||||
(label :text "Body"))))
|
:font-weight 'bold)))
|
||||||
|
(etaf-label :text "Body"))))
|
||||||
(let ((panel (etaf-ui-test--props buffer-name 'account-panel))
|
(let ((panel (etaf-ui-test--props buffer-name 'account-panel))
|
||||||
(label (etaf-ui-test--props buffer-name 'settings-label)))
|
(label (etaf-ui-test--props buffer-name 'settings-label))
|
||||||
(should (string-match-p "surface" (plist-get panel :class)))
|
(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 :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 :border) "#687386"))
|
||||||
(should (equal (plist-get panel :padding) '(1 2)))
|
(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 :color) "#66706A"))
|
||||||
(should (equal (plist-get label :font-weight) 'bold))
|
(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"))
|
(dolist (label '("Account" "Settings" "Body"))
|
||||||
(should (string-match-p (regexp-quote label)
|
(should (string-match-p (regexp-quote label)
|
||||||
(etaf-ui-test--text buffer-name)))))
|
(etaf-ui-test--text buffer-name)))))
|
||||||
@ -508,14 +516,14 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID")
|
:columns '((:key :id :label "ID")
|
||||||
(:key :name :label "Name"))
|
(:key :name :label "Name"))
|
||||||
:row-key (lambda (row) (plist-get row :id))
|
:row-key (lambda (row) (plist-get row :id))
|
||||||
:row-ref (lambda (row)
|
:row-ref (lambda (row)
|
||||||
(intern (format "row-%d" (plist-get row :id))))
|
(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)))))
|
:on-row-press (lambda (row) (setq pressed row)))))
|
||||||
(should (string-match-p "Ada" (etaf-ui-test--text buffer-name)))
|
(should (string-match-p "Ada" (etaf-ui-test--text buffer-name)))
|
||||||
(let ((first (etaf-ui-test--props buffer-name 'row-1))
|
(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 first :tab-index) 0))
|
||||||
(should (equal (plist-get second :role) 'button))
|
(should (equal (plist-get second :role) 'button))
|
||||||
(should (equal (plist-get second :tab-index) 0))
|
(should (equal (plist-get second :tab-index) 0))
|
||||||
(should (string-match-p
|
(should (etaf-ui-test--has-class-p second "selected"))
|
||||||
"selected" (or (plist-get second :class) "")))
|
(should-not (etaf-ui-test--has-class-p first "selected")))
|
||||||
(should-not (string-match-p
|
|
||||||
"selected" (or (plist-get first :class) ""))))
|
|
||||||
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||||
(handler (cdr (assq 'press
|
(handler (cdr (assq 'press
|
||||||
(etaf-runtime-handler-for runtime
|
(etaf-runtime-handler-for runtime
|
||||||
@ -557,15 +563,13 @@
|
|||||||
:id-key :id))
|
:id-key :id))
|
||||||
(controller (etaf-data-controller source :auto-load t))
|
(controller (etaf-data-controller source :auto-load t))
|
||||||
(buffer-name " *etaf-ui-grid-keyed-selection-test*")
|
(buffer-name " *etaf-ui-grid-keyed-selection-test*")
|
||||||
(row-renders (make-hash-table :test #'eql))
|
|
||||||
(body-renders 0)
|
|
||||||
host-updates)
|
host-updates)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID")
|
:columns '((:key :id :label "ID")
|
||||||
(:key :name :label "Name"))
|
(:key :name :label "Name"))
|
||||||
@ -581,23 +585,11 @@
|
|||||||
(third-handler
|
(third-handler
|
||||||
(cdr (assq 'press
|
(cdr (assq 'press
|
||||||
(etaf-runtime-handler-for runtime 'keyed-row-3))))
|
(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
|
(old-host
|
||||||
(symbol-function 'ebox-candidate-replace-host-ref))
|
(symbol-function 'ebox-candidate-replace-host-ref))
|
||||||
(old-paint
|
(old-paint
|
||||||
(symbol-function 'ebox-candidate-patch-host-paint)))
|
(symbol-function 'ebox-candidate-patch-host-paint)))
|
||||||
(cl-letf (((symbol-function 'etaf-ui--grid-row)
|
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
|
||||||
(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)
|
|
||||||
(lambda (candidate ref node)
|
(lambda (candidate ref node)
|
||||||
(push ref host-updates)
|
(push ref host-updates)
|
||||||
(funcall old-host candidate ref node)))
|
(funcall old-host candidate ref node)))
|
||||||
@ -608,11 +600,6 @@
|
|||||||
;; Prove direct public selection ref writes use the same keyed
|
;; Prove direct public selection ref writes use the same keyed
|
||||||
;; invalidation path as the selection helpers.
|
;; invalidation path as the selection helpers.
|
||||||
(setf (etaf-value (etaf-data-selection controller)) '(2)))
|
(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-1 host-updates))
|
||||||
(should (member 'keyed-row-2 host-updates))
|
(should (member 'keyed-row-2 host-updates))
|
||||||
(should-not (member 'keyed-row-3 host-updates))
|
(should-not (member 'keyed-row-3 host-updates))
|
||||||
@ -642,10 +629,10 @@
|
|||||||
|
|
||||||
(ert-deftest etaf-ui-data-grid-follows-inherited-theme-color ()
|
(ert-deftest etaf-ui-data-grid-follows-inherited-theme-color ()
|
||||||
"Re-render DataGrid rows when only inherited Theme color changes."
|
"Re-render DataGrid rows when only inherited Theme color changes."
|
||||||
(let* ((theme (etaf-ref '(:color "light-ink"
|
(let* ((theme (etaf-ref '(:ui-fg "light-ink"
|
||||||
:ui-grid-border "light-grid-border"
|
:ui-table-border "light-grid-border"
|
||||||
:ui-grid-selected-fg "light-selected"
|
:ui-table-selected-fg "light-selected"
|
||||||
:ui-grid-selected-bg "light-selected-bg")))
|
:ui-table-selected-bg "light-selected-bg")))
|
||||||
(source (etaf-data-memory-source
|
(source (etaf-data-memory-source
|
||||||
'((:id 1 :name "Ada") (:id 2 :name "Grace")) :id-key :id))
|
'((:id 1 :name "Ada") (:id 2 :name "Grace")) :id-key :id))
|
||||||
(controller (etaf-data-controller source :auto-load t))
|
(controller (etaf-data-controller source :auto-load t))
|
||||||
@ -655,27 +642,36 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(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))
|
(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)))
|
(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"
|
(should (equal "light-selected-bg"
|
||||||
(etaf-ui-test--paint-color
|
(etaf-ui-test--paint-color
|
||||||
background-slot :bgcolor)))
|
background-slot :bgcolor)))
|
||||||
(should (equal "light-grid-border"
|
(should (equal "light-grid-border"
|
||||||
(etaf-ui-test--paint-color
|
(etaf-ui-test--paint-color
|
||||||
border-slot :border-bottom-color)))
|
border-slot :border-bottom-color)))
|
||||||
(let ((row-props
|
(should (= (plist-get props :border-bottom-width) 1))
|
||||||
(etaf-ui-test--props-with-key buffer-name 1)))
|
(should (eq (plist-get props :border-bottom-style) 'solid))
|
||||||
(should (= (plist-get row-props :border-bottom-width) 1))
|
(setf (etaf-value theme) '(:ui-fg "dark-ink"
|
||||||
(should (eq (plist-get row-props :border-bottom-style) 'solid)))
|
:ui-table-border "dark-grid-border"
|
||||||
(setf (etaf-value theme) '(:color "dark-ink"
|
:ui-table-selected-fg "dark-selected"
|
||||||
:ui-grid-border "dark-grid-border"
|
:ui-table-selected-bg "dark-selected-bg"))
|
||||||
:ui-grid-selected-fg "dark-selected"
|
|
||||||
:ui-grid-selected-bg "dark-selected-bg"))
|
|
||||||
(let ((next (etaf-ui-test--props-with-key buffer-name 1)))
|
(let ((next (etaf-ui-test--props-with-key buffer-name 1)))
|
||||||
(should (eq background-slot (plist-get next :bgcolor)))
|
(should (eq background-slot
|
||||||
(should (eq border-slot (plist-get next :border-bottom-color)))
|
(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"
|
(should (equal "dark-selected-bg"
|
||||||
(etaf-ui-test--paint-color
|
(etaf-ui-test--paint-color
|
||||||
background-slot :bgcolor)))
|
background-slot :bgcolor)))
|
||||||
@ -700,7 +696,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(pagination :controller controller
|
(etaf-pagination :controller controller
|
||||||
:previous-ref 'page-previous
|
:previous-ref 'page-previous
|
||||||
:next-ref 'page-next)))
|
:next-ref 'page-next)))
|
||||||
(should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name)))
|
(should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name)))
|
||||||
@ -750,7 +746,7 @@
|
|||||||
(text "Left")
|
(text "Left")
|
||||||
(column
|
(column
|
||||||
:width 'stretch :padding '(0 2) :border "#CBD5E1"
|
:width 'stretch :padding '(0 2) :border "#CBD5E1"
|
||||||
(pagination :controller controller
|
(etaf-pagination :controller controller
|
||||||
:previous-ref 'nested-page-previous
|
:previous-ref 'nested-page-previous
|
||||||
:next-ref 'nested-page-next))
|
:next-ref 'nested-page-next))
|
||||||
(text "Right"))))
|
(text "Right"))))
|
||||||
@ -780,7 +776,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :title :label "Title" :width 22))
|
:columns '((:key :title :label "Title" :width 22))
|
||||||
:row-key (lambda (row) (plist-get row :id)))))
|
:row-key (lambda (row) (plist-get row :id)))))
|
||||||
@ -804,7 +800,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :progress :label "Progress" :width 8)
|
:columns '((:key :progress :label "Progress" :width 8)
|
||||||
(:key :kind :label "Kind" :width 7))
|
(:key :kind :label "Kind" :width 7))
|
||||||
@ -817,6 +813,18 @@
|
|||||||
(when-let* ((buffer (get-buffer buffer-name)))
|
(when-let* ((buffer (get-buffer buffer-name)))
|
||||||
(kill-buffer buffer)))))
|
(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 ()
|
(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."
|
"Rows without ON-ROW-PRESS have no role, ref callback, or tab stop."
|
||||||
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
||||||
@ -828,7 +836,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID"))
|
:columns '((:key :id :label "ID"))
|
||||||
:row-key (lambda (row) (plist-get row :id)))))
|
:row-key (lambda (row) (plist-get row :id)))))
|
||||||
@ -841,22 +849,34 @@
|
|||||||
(when-let* ((buffer (get-buffer buffer-name)))
|
(when-let* ((buffer (get-buffer buffer-name)))
|
||||||
(kill-buffer buffer)))))
|
(kill-buffer buffer)))))
|
||||||
|
|
||||||
(ert-deftest etaf-ui-data-grid-requires-row-ref-for-interaction ()
|
(ert-deftest etaf-ui-data-grid-owns-default-interaction-ref ()
|
||||||
"Reject an interactive DataGrid without a row-ref callback."
|
"Dispatch an interactive DataGrid row through its internal stable ref."
|
||||||
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
|
||||||
:id-key :id))
|
:id-key :id))
|
||||||
(controller (etaf-data-controller source :auto-load t))
|
(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
|
(unwind-protect
|
||||||
(should-error
|
(progn
|
||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID"))
|
:columns '((:key :id :label "ID"))
|
||||||
:row-key (lambda (row) (plist-get row :id))
|
:row-key (lambda (row) (plist-get row :id))
|
||||||
:on-row-press (lambda (_row) t)))))
|
: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)))
|
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||||
(etaf-unmount runtime))
|
(etaf-unmount runtime))
|
||||||
(etaf-data-stop controller)
|
(etaf-data-stop controller)
|
||||||
@ -874,7 +894,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID"))
|
:columns '((:key :id :label "ID"))
|
||||||
:row-key (lambda (row) (plist-get row :id))
|
:row-key (lambda (row) (plist-get row :id))
|
||||||
@ -904,7 +924,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID"))
|
:columns '((:key :id :label "ID"))
|
||||||
:row-key (lambda (row) (plist-get row :id))
|
:row-key (lambda (row) (plist-get row :id))
|
||||||
@ -934,7 +954,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID"))))))
|
:columns '((:key :id :label "ID"))))))
|
||||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
||||||
@ -955,7 +975,7 @@
|
|||||||
(etaf-mount
|
(etaf-mount
|
||||||
buffer-name
|
buffer-name
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(data-grid
|
(etaf-data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns '((:key :id :label "ID"))
|
:columns '((:key :id :label "ID"))
|
||||||
:row-key (lambda (_row) nil)))))
|
:row-key (lambda (_row) nil)))))
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user