geekinney/etaf-ui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: compose UI primitives with canonical Views

Browse Source
This commit is contained in:
Kinneyzhang 2026-08-27 12:14:51 +08:00
parent afa1b251e0
commit c590ed08eb
2 changed files with 106 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

183
etaf-ui.el
View File

@ -174,19 +174,6 @@ plist or a legacy caller-owned string remains untouched for compatibility."
(etaf-value value) (etaf-value value)
value)) value))
(defun etaf-ui--interactive-surface-properties (label disabled)
"Return shared text properties for an interactive LABEL surface.
DISABLED selects a non-pointer help description instead of an activation
affordance.
The properties are deliberately backend-neutral: Ebox turns them into the
native Emacs pointer/hover/help affordances while other renderers may ignore
the optional text properties and keep the semantic role/event contract."
(if disabled
(list 'help-echo (format "%s (disabled)" (or label "Control")))
(list 'pointer 'hand
'mouse-face 'highlight
'help-echo (format "%s · RET or mouse-1" (or label "Activate")))))
(defun etaf-ui--button-variant-values (variant disabled) (defun etaf-ui--button-variant-values (variant disabled)
"Return themed presentation defaults for Button VARIANT and DISABLED." "Return themed presentation defaults for Button VARIANT and DISABLED."
(let* ((fg (cond (disabled :ui-disabled-fg) (let* ((fg (cond (disabled :ui-disabled-fg)
@ -205,10 +192,10 @@ the optional text properties and keep the semantic role/event contract."
(list :color (plist-get theme fg) (list :color (plist-get theme fg)
:bgcolor (plist-get theme bg) :bgcolor (plist-get theme bg)
:border (etaf-ui--theme-border (plist-get theme border)) :border (etaf-ui--theme-border (plist-get theme border))
:face (if (or disabled (eq variant 'ghost)) 'normal 'bold)))) :font-weight (if (or disabled (eq variant 'ghost)) 'normal 'bold))))
(defun etaf-ui--button-view (defun etaf-ui--button-view
(label on-press disabled ref class color bgcolor border padding face (label on-press disabled ref class color bgcolor border padding font-weight
tab-index aria-label use) tab-index aria-label use)
"Return a Button Host showing LABEL. "Return a Button Host showing LABEL.
@ -220,24 +207,22 @@ TAB-INDEX, and ARIA-LABEL provide Host identity and presentation."
(if disabled "disabled" "enabled") (if disabled "disabled" "enabled")
class)) class))
(tab-value (unless disabled (or tab-index 0))) (tab-value (unless disabled (or tab-index 0)))
(label-value (or aria-label label)) (label-value (or aria-label label)))
(surface (etaf-ui--interactive-surface-properties label disabled)))
(if on-press (if on-press
(etaf-view (etaf-view
(text :class class-value :role 'button :ref ref :disabled disabled (box :class class-value :role 'button :ref ref :disabled disabled
:tab-index tab-value :aria-label label-value :tab-index tab-value :aria-label label-value
:color color :bgcolor bgcolor :border border :color color :bgcolor bgcolor :border border
:padding padding :face face :padding padding :font-weight font-weight
:surface-properties surface
:use (unless disabled use) :on-press on-press :use (unless disabled use) :on-press on-press
(expr :value label))) (text (expr :value label))))
(etaf-view (etaf-view
(text :class class-value :role 'button :ref ref :disabled disabled (box :class class-value :role 'button :ref ref :disabled disabled
:tab-index tab-value :aria-label label-value :tab-index tab-value :aria-label label-value
:color color :bgcolor bgcolor :border border :color color :bgcolor bgcolor :border border
:padding padding :face face :padding padding :font-weight font-weight
:surface-properties surface :use (unless disabled use)
:use (unless disabled use) (expr :value label)))))) (text (expr :value label)))))))
(defun etaf-ui--checkbox-variant-values (theme disabled) (defun etaf-ui--checkbox-variant-values (theme disabled)
"Return semantic Theme values from THEME for DISABLED Checkbox state." "Return semantic Theme values from THEME for DISABLED Checkbox state."
@ -296,19 +281,23 @@ too small; the original ROW remains intact for selection and callbacks."
(defun etaf-ui--grid-header-cell (column gap-p) (defun etaf-ui--grid-header-cell (column gap-p)
"Return one header View for COLUMN, adding air when GAP-P is non-nil." "Return one header View for COLUMN, adding air when GAP-P is non-nil."
(etaf-view (etaf--view-call
(text :class "etaf-data-grid-header-cell" 'box
:width (etaf-ui--grid-track-width column gap-p) (list :class "etaf-data-grid-header-cell"
(expr :value :width (etaf-ui--grid-track-width column gap-p))
(etaf-ui--grid-fit-text (list
(or (etaf-ui--column-value column :label) (etaf--view-call
(etaf-ui--column-value column :key)) 'text nil
column))))) (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) (defun etaf-ui--grid-header (columns theme)
"Return a View header row for COLUMNS using semantic THEME colors." "Return a View header row for COLUMNS using semantic THEME colors."
(etaf-view (etaf-view
(box :layout 'row :class "etaf-data-grid-header" (row :class "etaf-data-grid-header"
:border (etaf-ui--theme-border :border (etaf-ui--theme-border
(plist-get theme :ui-grid-border)) (plist-get theme :ui-grid-border))
(expr :value (expr :value
@ -319,9 +308,12 @@ too small; the original ROW remains intact for selection and callbacks."
(defun etaf-ui--grid-cell (row column gap-p host-ref) (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." "Return one data cell View for ROW and COLUMN using HOST-REF and GAP-P."
(etaf-view (etaf--view-call
(text :ref host-ref :width (etaf-ui--grid-track-width column gap-p) 'box
(expr :value (etaf-ui--grid-display-value row column))))) (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) (defun etaf-ui--grid-cells (row columns cell-refs)
"Return data cell Views for ROW and COLUMNS using stable CELL-REFS." "Return data cell Views for ROW and COLUMNS using stable CELL-REFS."
@ -382,9 +374,8 @@ ROW-ACTIONS owns stable keyed callbacks across body reevaluation."
(unless host-ref (unless host-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")))
(etaf--view-call (etaf--view-call
'box 'row
(list :layout 'row (list :key key
:key key
:class :class
(etaf--expr-create (etaf--expr-create
:thunk (lambda () :thunk (lambda ()
@ -530,15 +521,15 @@ customize state messages. The parent Component directly owns the result."
(or (etaf-current-prop :border) (or (etaf-current-prop :border)
(plist-get variant-values :border)) (plist-get variant-values :border))
(etaf-current-prop :padding) (etaf-current-prop :padding)
(or (etaf-current-prop :face) (or (etaf-current-prop :font-weight)
(plist-get variant-values :face)) (plist-get variant-values :font-weight))
(etaf-current-prop :tab-index) (etaf-current-prop :tab-index)
(etaf-current-prop :aria-label) (etaf-current-prop :aria-label)
use)))))) use))))))
;;;###autoload ;;;###autoload
(etaf-define-component etaf-button (etaf-define-component etaf-button
(&key label on-press disabled ref class color bgcolor border padding face (&key label on-press disabled ref class color bgcolor border padding font-weight
tab-index aria-label use variant) tab-index aria-label use variant)
"Render a standard pressable button with LABEL and ON-PRESS. "Render a standard pressable button with LABEL and ON-PRESS.
@ -551,8 +542,8 @@ contract; callers can still override presentation with the ordinary props."
;; State classes carry semantic state only. Resolved presentation props ;; State classes carry semantic state only. Resolved presentation props
;; above remain authoritative, so a themed disabled Button cannot inherit ;; above remain authoritative, so a themed disabled Button cannot inherit
;; the catalog's light default surface. ;; the catalog's light default surface.
("&.disabled" :padding (0 1) :face normal) ("&.disabled" :padding (0 1) :font-weight normal)
("&.enabled" :padding (0 1) :face bold)) ("&.enabled" :padding (0 1) :font-weight bold))
:setup :setup
(etaf-ui--button-setup)) (etaf-ui--button-setup))
@ -594,28 +585,28 @@ validation; the caller owns the value and subsequent state write."
(defun etaf-ui--checkbox-view (defun etaf-ui--checkbox-view
(checked label on-change ref disabled class color bgcolor border padding (checked label on-change ref disabled class color bgcolor border padding
face tab-index aria-label) font-weight tab-index aria-label)
"Return LABEL checkbox View with captured CHECKED and ON-PRESS. "Return LABEL checkbox View with captured CHECKED and ON-PRESS.
REF, DISABLED, CLASS, COLOR, BGCOLOR, BORDER, PADDING, FACE, TAB-INDEX, and REF, DISABLED, CLASS, COLOR, BGCOLOR, BORDER, PADDING, FACE, TAB-INDEX, and
ARIA-LABEL provide its semantic and presentation properties." ARIA-LABEL provide its semantic and presentation properties."
(etaf-view (etaf-view
(box :layout 'row (row
:class (etaf-ui--class-value :class (etaf-ui--class-value
"etaf-checkbox" (if disabled "disabled" "enabled") class) "etaf-checkbox" (if disabled "disabled" "enabled") class)
:role 'checkbox :ref ref :disabled disabled :role 'checkbox :ref ref :disabled disabled
:aria-label (or aria-label label) :aria-label (or aria-label label)
:tab-index (unless disabled (or tab-index 0)) :tab-index (unless disabled (or tab-index 0))
:color color :bgcolor bgcolor :border border :padding padding :face face :color color :bgcolor bgcolor :border border :padding padding :font-weight font-weight
:surface-properties (etaf-ui--interactive-surface-properties label disabled)
:on-press on-change :on-press on-change
(text :class "etaf-checkbox-mark" (box :class "etaf-checkbox-mark"
(expr :value (if (etaf-ui--reactive-value checked) "☑" "☐"))) (text (expr :value
(if (etaf-ui--reactive-value checked) "☑" "☐"))))
(text (expr :value (if label (concat " " label) "")))))) (text (expr :value (if label (concat " " label) ""))))))
;;;###autoload ;;;###autoload
(etaf-define-component etaf-checkbox (etaf-define-component etaf-checkbox
(&key checked label on-change ref disabled class color bgcolor border padding (&key checked label on-change ref disabled class color bgcolor border padding
face tab-index aria-label) font-weight tab-index aria-label)
"Render a controlled checkbox with CHECKED, LABEL, and ON-CHANGE. "Render a controlled checkbox with CHECKED, LABEL, and ON-CHANGE.
CHECKED may be a boolean or an ETAF reactive source. ON-CHANGE receives the CHECKED may be a boolean or an ETAF reactive source. ON-CHANGE receives the
@ -628,7 +619,7 @@ works with local refs or Data-backed forms."
;; Theme map in :setup; styles keep only geometry defaults. ;; Theme map in :setup; styles keep only geometry defaults.
("&.disabled" :padding (0 1)) ("&.disabled" :padding (0 1))
("&.enabled" :padding (0 1)) ("&.enabled" :padding (0 1))
(".etaf-checkbox-mark" :face bold :width 1)) (".etaf-checkbox-mark" :font-weight bold :width 1))
:setup :setup
(let* ((current-checked nil) (let* ((current-checked nil)
(current-callback nil) (current-callback nil)
@ -664,21 +655,27 @@ works with local refs or Data-backed forms."
(plist-get variant-values :bgcolor)) (plist-get variant-values :bgcolor))
(or (etaf-current-prop :border) (or (etaf-current-prop :border)
(plist-get variant-values :border)) (plist-get variant-values :border))
(etaf-current-prop :padding) (etaf-current-prop :face) (etaf-current-prop :padding) (etaf-current-prop :font-weight)
(etaf-current-prop :tab-index) (etaf-current-prop :aria-label)))))) (etaf-current-prop :tab-index) (etaf-current-prop :aria-label))))))
;;;###autoload ;;;###autoload
(etaf-define-component etaf-label (etaf-define-component etaf-label
(&key text face class color bgcolor border padding ref width) (&key text font-weight class color bgcolor border padding ref width)
"Render TEXT as a semantic label with presentation properties. "Render TEXT as a semantic label with presentation properties.
TEXT may be an ordinary value or an ETAF reactive source." TEXT may be an ordinary value or an ETAF reactive source."
:view :view
(expr (expr
:value :value
(etaf-view (if (or border padding width)
(text :class class :face face :color color :bgcolor bgcolor :border border (etaf-view
:padding padding :ref ref :width width (box :class class :font-weight font-weight :color color
(expr :value (etaf-ui--reactive-value text)))))) :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) (defun etaf-ui--panel-view (title class color bgcolor border padding ref)
"Render a themed Panel View. "Render a themed Panel View.
@ -686,7 +683,7 @@ Arguments are TITLE, CLASS, COLOR, BGCOLOR, BORDER, PADDING, and REF."
(let ((theme (etaf-ui-theme-tokens :ui-panel-fg :ui-panel-bg (let ((theme (etaf-ui-theme-tokens :ui-panel-fg :ui-panel-bg
:ui-panel-border))) :ui-panel-border)))
(etaf-view (etaf-view
(box :layout 'column (column
:class (etaf-ui--class-value "etaf-panel" nil class) :class (etaf-ui--class-value "etaf-panel" nil class)
:color (or color (plist-get theme :ui-panel-fg)) :color (or color (plist-get theme :ui-panel-fg))
:bgcolor (or bgcolor (plist-get theme :ui-panel-bg)) :bgcolor (or bgcolor (plist-get theme :ui-panel-bg))
@ -709,7 +706,7 @@ Arguments are TITLE, CLASS, COLOR, BGCOLOR, BORDER, PADDING, and REF."
:styles :styles
(styles (styles
("&" :padding (1 2)) ("&" :padding (1 2))
(".etaf-panel-title" :face bold)) (".etaf-panel-title" :font-weight bold))
:view :view
(expr :value (expr :value
(etaf-ui--panel-view title class color bgcolor border padding ref))) (etaf-ui--panel-view title class color bgcolor border padding ref)))
@ -728,8 +725,8 @@ those values into ordinary Hosts. Interactive rows require ROW-REF to return
a stable Host reference." a stable Host reference."
:styles :styles
(styles (styles
(".etaf-data-grid-header" :face bold :padding (0 1)) (".etaf-data-grid-header" :font-weight bold :padding (0 1))
(".etaf-data-grid-header-cell" :face bold) (".etaf-data-grid-header-cell" :font-weight bold)
(".etaf-data-grid-row" :padding (0 1)) (".etaf-data-grid-row" :padding (0 1))
;; Selection color and error color are dynamic semantic props below, so ;; Selection color and error color are dynamic semantic props below, so
;; this Component style scope contains geometry only. ;; this Component style scope contains geometry only.
@ -822,12 +819,12 @@ a stable Host reference."
:range-key #'car :range-key #'car
:range-item body-range-item))) :range-item body-range-item)))
(etaf--view-call (etaf--view-call
'box 'column
(list :layout 'column :class "etaf-data-grid" :color theme-color) (list :class "etaf-data-grid" :color theme-color)
(list (list
(etaf-ui--grid-header columns theme) (etaf-ui--grid-header columns theme)
(etaf--view-call (etaf--view-call
'box (list :layout 'column :class "etaf-data-grid-body") 'column (list :class "etaf-data-grid-body")
(list body-expr)) (list body-expr))
(etaf--slot-projection-create (etaf--slot-projection-create
:name 'footer :token 'etaf-ui-data-grid-footer :fallback nil))))))) :name 'footer :token 'etaf-ui-data-grid-footer :fallback nil)))))))
@ -846,7 +843,7 @@ readable in both GUI and text review."
:styles :styles
(styles (styles
("&" :width stretch) ("&" :width stretch)
(".etaf-pagination-label" :face bold)) (".etaf-pagination-label" :font-weight bold))
:setup :setup
(let* ((current-controller nil) (let* ((current-controller nil)
(current-parent-color nil) (current-parent-color nil)
@ -905,7 +902,7 @@ readable in both GUI and text review."
current-parent-color parent-color current-parent-color parent-color
current-parent-bgcolor parent-bgcolor) current-parent-bgcolor parent-bgcolor)
(etaf-view (etaf-view
(box :layout 'flex (flex
:class (etaf-ui--class-value "etaf-pagination" nil :class (etaf-ui--class-value "etaf-pagination" nil
(etaf-current-prop :class)) (etaf-current-prop :class))
:width 'stretch :width 'stretch
@ -919,7 +916,7 @@ readable in both GUI and text review."
:box-sizing 'border-box :box-sizing 'border-box
:padding (or (etaf-current-prop :padding) '(0 1)) :padding (or (etaf-current-prop :padding) '(0 1))
:gap '(0 (1)) :gap '(0 (1))
(box :layout 'column :width 'max-content (column :width 'max-content
:flex-grow 0 :flex-shrink 0 :flex-basis 'auto :flex-grow 0 :flex-shrink 0 :flex-basis 'auto
(button :label "←" :ref (etaf-current-prop :previous-ref) (button :label "←" :ref (etaf-current-prop :previous-ref)
:aria-label "Previous page" :aria-label "Previous page"
@ -930,29 +927,33 @@ readable in both GUI and text review."
(plist-get theme :ui-disabled-fg) (plist-get theme :ui-disabled-fg)
current-parent-color) current-parent-color)
:bgcolor current-parent-bgcolor :bgcolor current-parent-bgcolor
:face 'bold :font-weight 'bold
:on-press previous)) :on-press previous))
(box :layout 'column (column
:flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
(text :class "etaf-pagination-label" :text-align 'center (box :class "etaf-pagination-label" :text-align 'center
(expr :value :wrap-mode 'none :min-width 'max-content
(format "Page %d / %d" (text
(funcall page-value) (expr :value
(funcall pages-value)))) (format "Page %d / %d"
(text :class "etaf-pagination-summary" :text-align 'center (funcall page-value)
:color (plist-get theme :ui-pagination-muted-fg) (funcall pages-value)))))
(expr :value (box :class "etaf-pagination-summary" :text-align 'center
(let* ((page (funcall page-value)) :color (plist-get theme :ui-pagination-muted-fg)
(page-size (funcall page-size-value)) :wrap-mode 'none :min-width 'max-content
(total (funcall total-value)) (text
(first-item (expr :value
(if (zerop total) (let* ((page (funcall page-value))
0 (page-size (funcall page-size-value))
(1+ (* (1- page) page-size)))) (total (funcall total-value))
(last-item (min total (* page page-size)))) (first-item
(format "%d–%d of %d" (if (zerop total)
first-item last-item total))))) 0
(box :layout 'column :width 'max-content (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 :flex-grow 0 :flex-shrink 0 :flex-basis 'auto
(button :label "→" :ref (etaf-current-prop :next-ref) (button :label "→" :ref (etaf-current-prop :next-ref)
:aria-label "Next page" :aria-label "Next page"
@ -963,7 +964,7 @@ readable in both GUI and text review."
(plist-get theme :ui-disabled-fg) (plist-get theme :ui-disabled-fg)
current-parent-color) current-parent-color)
:bgcolor current-parent-bgcolor :bgcolor current-parent-bgcolor
:face 'bold :font-weight 'bold
:on-press next)))))))) :on-press next))))))))
(provide 'etaf-ui) (provide 'etaf-ui)

44
tests/etaf-ui-tests.el
View File

@ -34,15 +34,6 @@
(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--surface-properties (buffer-name ref)
"Return interactive text properties at REF's first rendered position."
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(position (etaf-host-ref-position runtime ref)))
(with-current-buffer buffer-name
(list (get-text-property position 'pointer)
(get-text-property position 'mouse-face)
(get-text-property position 'help-echo)))))
(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))
@ -76,7 +67,7 @@
:padding (9 9))) :padding (9 9)))
(lambda () (lambda ()
(etaf-view (etaf-view
(box :layout 'row (row
(button :label "Styled" :ref 'styled-button) (button :label "Styled" :ref 'styled-button)
(button :label "Custom" :ref 'custom-button (button :label "Custom" :ref 'custom-button
:color "explicit-color") :color "explicit-color")
@ -97,7 +88,7 @@
:ui-button-secondary-border "secondary-border")) :ui-button-secondary-border "secondary-border"))
(lambda () (lambda ()
(etaf-view (etaf-view
(box :layout 'row (row
(button :label "Token" :ref 'token-button) (button :label "Token" :ref 'token-button)
(button :label "Secondary" :ref 'token-secondary (button :label "Secondary" :ref 'token-secondary
:variant 'secondary)))))) :variant 'secondary))))))
@ -153,7 +144,7 @@
(should (equal (plist-get custom :bgcolor) "#2F6B43")) (should (equal (plist-get custom :bgcolor) "#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 :bgcolor) "theme-bg"))
(should (equal (plist-get themed :padding) '(9 9))) (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 :bgcolor) "#FFFDF8"))
(should (equal (plist-get panel :padding) '(1 2))))) (should (equal (plist-get panel :padding) '(1 2)))))
@ -219,7 +210,7 @@
:bgcolor "#2F6B43" :bgcolor "#2F6B43"
:border "#2F6B43" :border "#2F6B43"
:padding '(0 2) :padding '(0 2)
:face 'bold :font-weight 'bold
:tab-index 3 :tab-index 3
:aria-label "Save changes" :aria-label "Save changes"
:on-press (lambda () (cl-incf presses))))) :on-press (lambda () (cl-incf presses)))))
@ -233,7 +224,7 @@
(should (equal (plist-get props :bgcolor) "#2F6B43")) (should (equal (plist-get props :bgcolor) "#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 :face) 'bold)) (should (equal (plist-get props :font-weight) 'bold))
(should (string-match-p "primary" (plist-get props :class)))) (should (string-match-p "primary" (plist-get props :class))))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name) (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'save 'press) 'save 'press)
@ -252,7 +243,7 @@
(progn (progn
(etaf-mount buffer-name (etaf-mount buffer-name
(etaf-view (etaf-view
(box :layout 'row (row
(button :label "Save" :ref 'enabled-save (button :label "Save" :ref 'enabled-save
:on-press (lambda () (cl-incf presses))) :on-press (lambda () (cl-incf presses)))
(button :label "Delete" :ref 'disabled-delete (button :label "Delete" :ref 'disabled-delete
@ -263,7 +254,7 @@
(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 :bgcolor) "#2F6B43"))
(should (equal (plist-get props :padding) '(0 1))) (should (equal (plist-get props :padding) '(0 1)))
(should (equal (plist-get props :face) '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))
@ -309,8 +300,8 @@
(when-let* ((buffer (get-buffer buffer-name))) (when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))) (kill-buffer buffer))))))
(ert-deftest etaf-ui-button-owns-native-hover-and-dispatch () (ert-deftest etaf-ui-button-dispatches-without-retained-press-state ()
"Buttons expose native hover affordances without retained press state." "Buttons dispatch through semantic Host state without local press state."
(let ((buffer-name " *etaf-ui-button-surface-test*") (let ((buffer-name " *etaf-ui-button-surface-test*")
(presses 0)) (presses 0))
(unwind-protect (unwind-protect
@ -321,10 +312,6 @@
(button :label "Run health check" :ref 'health (button :label "Run health check" :ref 'health
:variant 'secondary :variant 'secondary
:on-press (lambda () (cl-incf presses))))) :on-press (lambda () (cl-incf presses)))))
(let ((surface (etaf-ui-test--surface-properties buffer-name 'health)))
(should (eq (nth 0 surface) 'hand))
(should (eq (nth 1 surface) 'highlight))
(should (string-match-p "RET" (nth 2 surface))))
(let ((props (etaf-ui-test--props buffer-name 'health))) (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 :bgcolor) "#D9EEEA")))
@ -446,7 +433,7 @@
(progn (progn
(etaf-mount buffer-name (etaf-mount buffer-name
(etaf-view (etaf-view
(box :layout 'row (row
(checkbox :label "Open" :ref 'open-box (checkbox :label "Open" :ref 'open-box
:on-change (lambda (_value) :on-change (lambda (_value)
(cl-incf changes))) (cl-incf changes)))
@ -487,7 +474,7 @@
(slot :name 'header (slot :name 'header
(label :text "Settings" :ref 'settings-label (label :text "Settings" :ref 'settings-label
:class "eyebrow" :color "#66706A" :class "eyebrow" :color "#66706A"
:face 'bold :width 12)) :font-weight 'bold :width 12))
(label :text "Body")))) (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)))
@ -498,7 +485,7 @@
(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 (string-match-p "eyebrow" (plist-get label :class)))
(should (equal (plist-get label :color) "#66706A")) (should (equal (plist-get label :color) "#66706A"))
(should (equal (plist-get label :face) 'bold)) (should (equal (plist-get label :font-weight) 'bold))
(should (equal (plist-get label :width) 12))) (should (equal (plist-get label :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)
@ -728,9 +715,6 @@
(line-end-position))) (line-end-position)))
360)) 360))
(forward-line 1))) (forward-line 1)))
(should (eq (nth 0 (etaf-ui-test--surface-properties
buffer-name 'page-next))
'hand))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name) (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'page-next 'press) 'page-next 'press)
(should (string-match-p "Page 2 / 3" (etaf-ui-test--text buffer-name))) (should (string-match-p "Page 2 / 3" (etaf-ui-test--text buffer-name)))
@ -759,10 +743,10 @@
(etaf-mount (etaf-mount
buffer-name buffer-name
(etaf-view (etaf-view
(box :layout 'grid :width '(360) (grid :width '(360)
:grid-template-columns '((80) (200) (80)) :grid-template-columns '((80) (200) (80))
(text "Left") (text "Left")
(box :layout 'column (column
:width 'stretch :padding '(0 2) :border "#CBD5E1" :width 'stretch :padding '(0 2) :border "#CBD5E1"
(pagination :controller controller (pagination :controller controller
:previous-ref 'nested-page-previous :previous-ref 'nested-page-previous