etaf-ui/tests/etaf-ui-tests.el

1006 lines
46 KiB
EmacsLisp
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; etaf-ui-tests.el --- Official ETAF Component tests -*- lexical-binding: t; -*-
;;; Code:
(require 'ert)
(require 'etaf-ui)
(defun etaf-ui-test--text (buffer-name)
"Return plain text currently published in BUFFER-NAME."
(with-current-buffer buffer-name
(string-trim-right (substring-no-properties (buffer-string)))))
(defun etaf-ui-test--props (buffer-name ref)
"Return mounted Host properties for REF in BUFFER-NAME."
(gethash ref
(etaf-runtime-host-props
(etaf-runtime-for-buffer buffer-name))))
(defun etaf-ui-test--props-with-key (buffer-name key)
"Return mounted Host properties with Host KEY in BUFFER-NAME."
(let (found)
(maphash
(lambda (_ref props)
(when (equal (plist-get props :key) key)
(setq found props)))
(etaf-runtime-host-props (etaf-runtime-for-buffer buffer-name)))
found))
(defun etaf-ui-test--props-with-class (buffer-name class)
"Return mounted Host properties with CLASS in BUFFER-NAME."
(let (found)
(maphash
(lambda (_ref props)
(when (member class (etaf--class-tokens (plist-get props :class)))
(setq found props)))
(etaf-runtime-host-props (etaf-runtime-for-buffer buffer-name)))
found))
(defun etaf-ui-test--has-class-p (props class)
"Return non-nil when PROPS contain CLASS."
(member class (etaf--class-tokens (plist-get props :class))))
(defun etaf-ui-test--paint-color (value property)
"Return effective paint color from VALUE for Ebox PROPERTY."
(if (not (tp-paint-slot-p value))
value
(let ((spec (tp-paint-slot-spec value)))
(pcase property
(:color (plist-get spec :foreground))
((or :bgcolor :background-color) (plist-get spec :background))
(:border-top-color (plist-get spec :overline))
(:border-bottom-color
(plist-get (plist-get spec :underline) :color))
((or :border-left-color :border-right-color)
(plist-get spec :background))))))
(defvar etaf-ui-test-use-count 0)
(etaf-define-behavior etaf-ui-test-press-behavior (&rest attributes)
"Install a press callback that increments `etaf-ui-test-use-count'."
(apply #'etaf-behavior-create
'etaf-ui-test-press
(append attributes
(list :on-press
(lambda () (cl-incf etaf-ui-test-use-count))))))
(etaf-define-component etaf-ui-test-theme-fixture ()
"Provide Theme defaults for official Component presentation tests."
:setup
(progn
(etaf-theme-provide '(:color "theme-color"
:background-color "theme-bg"
:padding (9 9)))
nil)
:view
(row
(etaf-button :label "Styled" :ref 'styled-button)
(etaf-button :label "Custom" :ref 'custom-button
:color "explicit-color")
(etaf-label :text "Themed" :ref 'themed-label
:color nil :bgcolor nil)
(text :ref 'themed-host :color nil :bgcolor nil "Theme defaults")
(etaf-panel :title "Styled panel" :ref 'styled-panel)))
(etaf-define-component etaf-ui-test-token-theme-fixture ()
"Provide explicit UI Button tokens through ETAF Theme."
:setup
(progn
(etaf-theme-provide
'(:ui-button-primary-fg "token-fg"
:ui-button-primary-bg "token-bg"
:ui-button-primary-border "token-border"
:ui-button-secondary-fg "secondary-fg"
:ui-button-secondary-bg "secondary-bg"
:ui-button-secondary-border "secondary-border"))
nil)
:view
(row
(etaf-button :label "Token" :ref 'token-button)
(etaf-button :label "Secondary" :ref 'token-secondary
:variant 'secondary)))
(etaf-define-component etaf-ui-test-grid-theme-fixture
(&key controller theme)
"Provide a reactive Theme around one DataGrid for palette tests."
:setup
(progn
(etaf-theme-provide theme)
nil)
:view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID") (:key :name :label "Name"))
:row-key (lambda (row) (plist-get row :id))
:row-selected-p (lambda (row) (= (plist-get row :id) 1))))
(ert-deftest etaf-ui-button-use-behavior-dispatches-through-host ()
"Install Button `:use' Behavior and dispatch its merged callback."
(let ((buffer-name " *etaf-ui-button-use-test*"))
(setq etaf-ui-test-use-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-button :label "Behavior" :ref 'behavior-button
:use (list (etaf-ui-test-press-behavior)))))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'behavior-button 'press)
(should (= etaf-ui-test-use-count 1)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-defaults-use-styles-and-preserve-theme ()
"Use Component styles for defaults and Theme for omitted properties."
(let ((buffer-name " *etaf-ui-style-default-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-ui-test-theme-fixture)))
(let ((styled (etaf-ui-test--props buffer-name 'styled-button))
(custom (etaf-ui-test--props buffer-name 'custom-button))
(themed (etaf-ui-test--props buffer-name 'themed-label))
(host (etaf-ui-test--props buffer-name 'themed-host))
(panel (etaf-ui-test--props buffer-name 'styled-panel)))
(should (equal (plist-get styled :color) "#FFFFFF"))
(should (equal (plist-get styled :background-color) "#2F6B43"))
(should (equal (plist-get styled :padding) '(0 1)))
(should (equal (plist-get custom :color) "explicit-color"))
(should (equal (plist-get custom :background-color) "#2F6B43"))
;; Nil fallthrough omits an override; it does not erase Label's
;; explicit presentation. An omitted Host value uses Theme.
(should (equal (plist-get themed :color) "#252A2E"))
(should (equal (plist-get themed :background-color) "theme-bg"))
(should (equal (plist-get host :color) "theme-color"))
(should (equal (plist-get host :background-color) "theme-bg"))
(should-not (plist-get themed :padding))
(should (equal (plist-get panel :color) "#252A2E"))
(should (equal (plist-get panel :background-color) "#FFFDF8"))
(should (equal (plist-get panel :padding) '(1 2)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-button-reads-variant-tokens-from-theme ()
"Resolve Button presentation defaults from inherited Theme tokens."
(let ((buffer-name " *etaf-ui-button-token-theme-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-ui-test-token-theme-fixture)))
(let ((token (etaf-ui-test--props buffer-name 'token-button))
(secondary (etaf-ui-test--props buffer-name 'token-secondary)))
(should (equal "token-fg" (plist-get token :color)))
(should (equal "token-bg" (plist-get token :background-color)))
(should (equal "token-border" (plist-get token :border)))
(should (equal "secondary-fg" (plist-get secondary :color)))
(should (equal "secondary-bg"
(plist-get secondary :background-color)))
(should (equal "secondary-border"
(plist-get secondary :border)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-number-input-validates-and-emits-value ()
"Prompt-backed number input owns bounds and emits the accepted value."
(let ((buffer-name " *etaf-ui-number-input-test*")
(value 3))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-number-input :label "Rows" :value value :ref 'rows
:min 1 :max 10
:on-change (lambda (next) (setq value next)))))
(cl-letf (((symbol-function 'read-number)
(lambda (&rest _args) 7)))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'rows 'press))
(should (= 7 value)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-button-dispatches-and-exposes-enabled-props ()
"Render an enabled button with semantic and presentation properties."
(let ((buffer-name " *etaf-ui-button-test*")
(presses 0))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(etaf-button :label "Save" :ref 'save
:class "primary"
:color "#FFFFFF"
:bgcolor "#2F6B43"
:border "#2F6B43"
:padding '(0 2)
:font-weight 'bold
:tab-index 3
:aria-label "Save changes"
:on-press (lambda () (cl-incf presses)))))
(should (string-match-p "Save" (etaf-ui-test--text buffer-name)))
(let ((props (etaf-ui-test--props buffer-name 'save)))
(should (equal (plist-get props :role) 'button))
(should (eq (plist-get props :width) 'max-content))
(should (equal (plist-get props :tab-index) 3))
(should (equal (plist-get props :aria-label) "Save changes"))
(should (equal (plist-get props :color) "#FFFFFF"))
(should (equal (plist-get props :background-color) "#2F6B43"))
(should (equal (plist-get props :border) "#2F6B43"))
(should (equal (plist-get props :padding) '(0 2)))
(should (equal (plist-get props :font-weight) 'bold))
(should (etaf-ui-test--has-class-p props "primary")))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'save 'press)
(should (= presses 1)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-button-disabled-is-not-interactive ()
"A disabled button has no callback and is not a focus candidate."
(let ((buffer-name " *etaf-ui-disabled-button-test*")
(presses 0))
(setq etaf-ui-test-use-count 0)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(row
(etaf-button :label "Save" :ref 'enabled-save
:on-press (lambda () (cl-incf presses)))
(etaf-button :label "Delete" :ref 'disabled-delete
:disabled t
:use (list (etaf-ui-test-press-behavior))
:on-press (lambda () (cl-incf presses))))))
(let ((props (etaf-ui-test--props buffer-name 'enabled-save)))
(should (equal (plist-get props :color) "#FFFFFF"))
(should (equal (plist-get props :background-color) "#2F6B43"))
(should (equal (plist-get props :padding) '(0 1)))
(should (equal (plist-get props :font-weight) 'bold)))
(let ((props (etaf-ui-test--props buffer-name 'disabled-delete)))
(should (eq (plist-get props :disabled) t))
(should-not (plist-get props :tab-index))
(should (equal (plist-get props :background-color) "#E5E7EB"))
(should (etaf-ui-test--has-class-p props "disabled")))
(should-error
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'disabled-delete 'press)
:type 'etaf-event-error)
(etaf-focus-next (etaf-runtime-for-buffer buffer-name))
(should (eq (etaf-focused-host-ref
(etaf-runtime-for-buffer buffer-name))
'enabled-save))
(should (= presses 0))
(should (= etaf-ui-test-use-count 0)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-button-disabled-preserves-explicit-theme-surface ()
"A disabled Button keeps explicit dark presentation props in its surface."
(let ((buffer-name " *etaf-ui-themed-disabled-button-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-button :label "Unavailable" :ref 'themed-disabled
:disabled t :color "#F4F7FF" :bgcolor "#202C42"
:border "#34435A")))
(let ((position
(with-current-buffer buffer-name
(goto-char (point-min))
(search-forward "Unavailable")
(1- (point)))))
(with-current-buffer buffer-name
(let ((face (get-text-property position 'face)))
(should (string-match-p "#202C42" (format "%S" face)))
(should (string-match-p "#F4F7FF" (format "%S" face)))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-button-dispatches-without-retained-press-state ()
"Buttons dispatch through semantic Host state without local press state."
(let ((buffer-name " *etaf-ui-button-surface-test*")
(presses 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-button :label "Run health check" :ref 'health
:variant 'secondary
:on-press (lambda () (cl-incf presses)))))
(let ((props (etaf-ui-test--props buffer-name 'health)))
(should (equal (plist-get props :color) "#142235"))
(should (equal (plist-get props :background-color) "#D9EEEA")))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (cdr (assq 'press
(etaf-runtime-handler-for runtime 'health)))))
(should (functionp before))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'health 'press)
(should (= presses 1))
(should (string-match-p
"enabled"
(plist-get (etaf-ui-test--props buffer-name 'health)
:class)))
(should-not (string-match-p
"pressed"
(plist-get (etaf-ui-test--props buffer-name 'health)
:class)))
(should (eq before
(cdr (assq 'press
(etaf-runtime-handler-for runtime 'health)))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-checkbox-is-controlled-and-focusable ()
"Render a controlled checkbox, toggle it, and retain its focus contract."
(let ((buffer-name " *etaf-ui-checkbox-test*")
(checked (etaf-ref nil))
next)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(etaf-checkbox :label "Done" :ref 'done
:checked (etaf-value checked)
:on-change (lambda (value)
(setq next value)
(setf (etaf-value checked)
value)))))
(should (string-match-p "☐ Done" (etaf-ui-test--text buffer-name)))
(let ((props (etaf-ui-test--props buffer-name 'done)))
(should (equal (plist-get props :role) 'checkbox))
(should (eq (plist-get props :width) 'max-content))
(should (equal (plist-get props :tab-index) 0))
(should (equal (plist-get props :ref) 'done)))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'done 'press)
(should (eq next t))
(should (string-match-p "☑ Done" (etaf-ui-test--text buffer-name)))
(etaf-focus-next (etaf-runtime-for-buffer buffer-name))
(should (eq (etaf-focused-host-ref
(etaf-runtime-for-buffer buffer-name))
'done)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-checkbox-reactive-value-updates-through-inline-range ()
"Update a reactive CHECKED source without rerunning Checkbox Component."
(let ((buffer-name " *etaf-ui-reactive-checkbox-test*")
(checked (etaf-ref nil))
(component-renders 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-checkbox :label "Live" :ref 'live-checkbox :checked checked
:on-change (lambda (value)
(setf (etaf-value checked) value)))))
(let ((render (symbol-function
'etaf--runtime-render-dirty-component)))
(cl-letf (((symbol-function 'etaf--runtime-render-dirty-component)
(lambda (&rest arguments)
(cl-incf component-renders)
(apply render arguments))))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'live-checkbox 'press)))
(should (etaf-value checked))
(should (string-match-p "☑ Live"
(etaf-ui-test--text buffer-name)))
(should (zerop component-renders)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-label-reactive-text-updates-through-inline-range ()
"Update reactive Label text without rerunning its Component."
(let ((buffer-name " *etaf-ui-reactive-label-test*")
(text (etaf-ref "One"))
(component-renders 0))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-label :text text :ref 'live-label)))
(let ((render (symbol-function
'etaf--runtime-render-dirty-component)))
(cl-letf (((symbol-function 'etaf--runtime-render-dirty-component)
(lambda (&rest arguments)
(cl-incf component-renders)
(apply render arguments))))
(setf (etaf-value text) "Two")))
(should (equal "Two" (etaf-ui-test--text buffer-name)))
(should (zerop component-renders)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-checkbox-disabled-is-not-interactive ()
"A disabled checkbox has no callback or tab stop and remains visible."
(let ((buffer-name " *etaf-ui-disabled-checkbox-test*")
(changes 0))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(row
(etaf-checkbox :label "Open" :ref 'open-box
:on-change (lambda (_value)
(cl-incf changes)))
(etaf-checkbox :label "Closed" :ref 'closed-box
:disabled t
:on-change (lambda (_value)
(cl-incf changes))))))
(let ((props (etaf-ui-test--props buffer-name 'closed-box)))
(should (eq (plist-get props :disabled) t))
(should-not (plist-get props :tab-index))
(should (equal (plist-get props :background-color) "#EEEAE2"))
(should (etaf-ui-test--has-class-p props "disabled")))
(should-error
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'closed-box 'press)
:type 'etaf-event-error)
(etaf-focus-next (etaf-runtime-for-buffer buffer-name))
(should (eq (etaf-focused-host-ref
(etaf-runtime-for-buffer buffer-name))
'open-box))
(should (= changes 0)))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-label-and-panel-expose-presentation-and-slots ()
"Render Label and Panel presentation props with named/default slots."
(let ((buffer-name " *etaf-ui-panel-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-panel :title "Account" :ref 'account-panel
:class "surface" :color "#252A2E"
:background-color "#FFFDF8"
:border "#687386" :padding '(1 2)
(slot :name 'header
(box :width 12 :ref 'settings-cell
(etaf-label :text "Settings" :ref 'settings-label
:class "eyebrow" :color "#66706A"
:font-weight 'bold)))
(etaf-label :text "Body"))))
(let ((panel (etaf-ui-test--props buffer-name 'account-panel))
(label (etaf-ui-test--props buffer-name 'settings-label))
(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 :background-color) "#FFFDF8"))
(should (equal (plist-get panel :border) "#687386"))
(should (equal (plist-get panel :padding) '(1 2)))
(should (etaf-ui-test--has-class-p label "eyebrow"))
(should (equal (plist-get label :color) "#66706A"))
(should (equal (plist-get label :font-weight) 'bold))
(should (equal (plist-get cell :width) 12)))
(dolist (label '("Account" "Settings" "Body"))
(should (string-match-p (regexp-quote label)
(etaf-ui-test--text buffer-name)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-projects-reactive-controller ()
"Render DataGrid rows, refs, semantics, selection, and dispatch."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada") (:id 2 :name "Grace"))
:id-key :id))
(controller (etaf-data-controller source :page-size 10 :auto-load t))
(buffer-name " *etaf-ui-grid-test*")
pressed)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID")
(:key :name :label "Name"))
:row-key (lambda (row) (plist-get row :id))
:row-ref (lambda (row)
(intern (format "row-%d" (plist-get row :id))))
:row-selected-p (lambda (row) (= (plist-get row :id) 2))
:on-row-press (lambda (row) (setq pressed row)))))
(should (string-match-p "Ada" (etaf-ui-test--text buffer-name)))
(let ((first (etaf-ui-test--props buffer-name 'row-1))
(second (etaf-ui-test--props buffer-name 'row-2)))
(should (equal (plist-get first :role) 'button))
(should (equal (plist-get first :tab-index) 0))
(should (equal (plist-get second :role) 'button))
(should (equal (plist-get second :tab-index) 0))
(should (etaf-ui-test--has-class-p second "selected"))
(should-not (etaf-ui-test--has-class-p first "selected")))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(handler (cdr (assq 'press
(etaf-runtime-handler-for runtime
'row-1)))))
(etaf-dispatch-event runtime 'row-1 'press)
(should (equal (plist-get pressed :id) 1))
(etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
(should (eq handler
(cdr (assq 'press
(etaf-runtime-handler-for runtime 'row-1)))))
(should (string-match-p "Alan" (etaf-ui-test--text buffer-name)))
(should (equal (plist-get (etaf-ui-test--props buffer-name 'row-3)
:tab-index)
0))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-default-selection-updates-only-delta-hosts ()
"Controller selection updates old/new row Hosts without rebuilding rows."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada")
(:id 2 :name "Grace")
(:id 3 :name "Alan"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-keyed-selection-test*")
host-updates)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID")
(:key :name :label "Name"))
:row-key (lambda (row) (plist-get row :id))
:row-ref (lambda (row)
(intern (format "keyed-row-%d" (plist-get row :id))))
:on-row-press
(lambda (row)
(etaf-data-select-one controller (plist-get row :id))))))
(etaf-data-select-one controller 1)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(text-before (etaf-ui-test--text buffer-name))
(third-handler
(cdr (assq 'press
(etaf-runtime-handler-for runtime 'keyed-row-3))))
(old-host
(symbol-function 'ebox-candidate-replace-host-ref))
(old-paint
(symbol-function 'ebox-candidate-patch-host-paint)))
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (candidate ref node)
(push ref host-updates)
(funcall old-host candidate ref node)))
((symbol-function 'ebox-candidate-patch-host-paint)
(lambda (candidate ref old-node new-node)
(push ref host-updates)
(funcall old-paint candidate ref old-node new-node))))
;; Prove direct public selection ref writes use the same keyed
;; invalidation path as the selection helpers.
(setf (etaf-value (etaf-data-selection controller)) '(2)))
(should (member 'keyed-row-1 host-updates))
(should (member 'keyed-row-2 host-updates))
(should-not (member 'keyed-row-3 host-updates))
(should (equal text-before (etaf-ui-test--text buffer-name)))
(should-not
(string-match-p
"selected"
(or (plist-get (etaf-ui-test--props buffer-name 'keyed-row-1)
:class)
"")))
(should
(string-match-p
"selected"
(or (plist-get (etaf-ui-test--props buffer-name 'keyed-row-2)
:class)
"")))
(should (eq third-handler
(cdr (assq
'press
(etaf-runtime-handler-for runtime
'keyed-row-3)))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-follows-inherited-theme-color ()
"Re-render DataGrid rows when only inherited Theme color changes."
(let* ((theme (etaf-ref '(:ui-fg "light-ink"
:ui-table-border "light-grid-border"
:ui-table-selected-fg "light-selected"
:ui-table-selected-bg "light-selected-bg")))
(source (etaf-data-memory-source
'((:id 1 :name "Ada") (:id 2 :name "Grace")) :id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-theme-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-ui-test-grid-theme-fixture
:controller controller :theme theme)))
(let* ((props (etaf-ui-test--props-with-key buffer-name 1))
(foreground-slot (plist-get props :color))
(background-slot (plist-get props :background-color))
(border-slot (plist-get props :border-bottom-color)))
(should (equal "light-selected"
(etaf-ui-test--paint-color
foreground-slot :color)))
(should (equal "light-selected-bg"
(etaf-ui-test--paint-color
background-slot :bgcolor)))
(should (equal "light-grid-border"
(etaf-ui-test--paint-color
border-slot :border-bottom-color)))
(should (= (plist-get props :border-bottom-width) 1))
(should (eq (plist-get props :border-bottom-style) 'solid))
(setf (etaf-value theme) '(:ui-fg "dark-ink"
:ui-table-border "dark-grid-border"
:ui-table-selected-fg "dark-selected"
:ui-table-selected-bg "dark-selected-bg"))
(let ((next (etaf-ui-test--props-with-key buffer-name 1)))
(should (eq background-slot
(plist-get next :background-color)))
(should (eq border-slot
(plist-get next :border-bottom-color)))
(should (eq foreground-slot (plist-get next :color)))
(should (equal "dark-selected"
(etaf-ui-test--paint-color
foreground-slot :color)))
(should (equal "dark-selected-bg"
(etaf-ui-test--paint-color
background-slot :bgcolor)))
(should (equal "dark-grid-border"
(etaf-ui-test--paint-color
border-slot :border-bottom-color))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-pagination-is-readable-and-boundary-safe ()
"Pagination renders labeled controls, stable refs, and page boundaries."
(let* ((source (etaf-data-memory-source
'((:id 1) (:id 2) (:id 3) (:id 4) (:id 5))
:id-key :id))
(controller (etaf-data-controller source :page-size 2 :auto-load t))
(buffer-name " *etaf-ui-pagination-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-pagination :controller controller
:previous-ref 'page-previous
:next-ref 'page-next)))
(should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name)))
(should (string-match-p " Previous" (etaf-ui-test--text buffer-name)))
(should (string-match-p "Next " (etaf-ui-test--text buffer-name)))
;; Live Ebox windows reserve two pixels for the exclusive display
;; boundary; the pager must stay inside the corresponding 360px row.
(ebox-surface-update-buffer-viewport (get-buffer buffer-name) 358 20)
(with-current-buffer buffer-name
(goto-char (point-min))
(while (< (point) (point-max))
(should (<= (ebox-string-pixel-width
(buffer-substring (line-beginning-position)
(line-end-position)))
360))
(forward-line 1)))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'page-next 'press)
(should (string-match-p "Page 2 / 3" (etaf-ui-test--text buffer-name)))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'page-previous 'press)
(should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name)))
(should-error
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'page-previous 'press)
:type 'etaf-event-error))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-pagination-composes-inside-a-grid-track ()
"Pagination must distribute free space inside its assigned Grid track."
(let* ((source (etaf-data-memory-source
'((:id 1) (:id 2) (:id 3) (:id 4) (:id 5))
:id-key :id))
(controller (etaf-data-controller source :page-size 2 :auto-load t))
(buffer-name " *etaf-ui-pagination-grid-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(grid :width '(360)
:grid-template-columns '((80) (200) (80))
(text "Left")
(column
:width 'stretch :padding '(0 2) :border "#CBD5E1"
(etaf-pagination :controller controller
:previous-ref 'nested-page-previous
:next-ref 'nested-page-next))
(text "Right"))))
(with-current-buffer buffer-name
(goto-char (point-min))
(while (< (point) (point-max))
(should (<= (ebox-string-pixel-width
(buffer-substring (line-beginning-position)
(line-end-position)))
360))
(forward-line 1))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-keeps-long-cells-on-one-line ()
"Long tabular values use an ellipsis instead of increasing row height."
(let* ((source (etaf-data-memory-source
'((:id 1 :title "The Cathedral and the Bazaar"))
:id-key :id))
(controller (etaf-data-controller source :page-size 10 :auto-load t))
(buffer-name " *etaf-ui-grid-truncation-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :title :label "Title" :width 22))
:row-key (lambda (row) (plist-get row :id)))))
(let ((text (etaf-ui-test--text buffer-name)))
(should (string-match-p "The Cathedral and the…" text))
(should-not (string-match-p "The Cathedral and the Bazaar" 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)))))
(ert-deftest etaf-ui-data-grid-converts-character-columns-and-keeps-air ()
"Character column descriptors become pixel widths with a stable gap."
(let* ((source (etaf-data-memory-source
'((:id 1 :progress 64 :kind "Essay")) :id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-column-unit-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :progress :label "Progress" :width 8)
(:key :kind :label "Kind" :width 7))
:row-key (lambda (row) (plist-get row :id)))))
(should (string-match-p "Progress[[:space:]]+Kind"
(etaf-ui-test--text buffer-name))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-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))))
(should
(equal "Name Kind "
(etaf-ui--table-fixed-header-text
'((:key :name :label "Name" :width 5)
(:key :kind :label "Kind" :width 7)))))
(should-not
(etaf-ui--table-fixed-header-text
'((:key :name :width 5) (:key :kind)))))
(ert-deftest etaf-ui-data-grid-noninteractive-rows-have-no-focus-contract ()
"Rows without ON-ROW-PRESS have no role, ref callback, or tab stop."
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-static-row-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))
:row-key (lambda (row) (plist-get row :id)))))
(let ((props (etaf-ui-test--props-with-key buffer-name 1)))
(should-not (plist-get props :role))
(should-not (plist-get props :tab-index))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-owns-default-interaction-ref ()
"Dispatch an interactive DataGrid row through its internal stable ref."
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-row-ref-test*")
pressed)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))
:row-key (lambda (row) (plist-get row :id))
:on-row-press (lambda (row) (setq pressed row)))))
(let (host-ref)
(maphash
(lambda (ref props)
(when (equal (plist-get props :key) 1)
(setq host-ref ref)))
(etaf-runtime-host-props
(etaf-runtime-for-buffer buffer-name)))
(should host-ref)
(etaf-dispatch-event
(etaf-runtime-for-buffer buffer-name) host-ref 'press)
(should (equal (plist-get pressed :id) 1))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-rejects-nil-row-ref ()
"Reject an interactive row-ref callback that returns nil."
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-nil-row-ref-test*"))
(unwind-protect
(should-error
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))
:row-key (lambda (row) (plist-get row :id))
:row-ref (lambda (_row) nil)
:on-row-press (lambda (_row) t)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-projects-loading-error-and-empty ()
"Project the Data Controller loading, error, and empty states."
(dolist (case '((loading . "Loading custom")
(error . "Error custom")
(empty . "Empty custom")))
(let* ((source (etaf-data-memory-source '((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source))
(buffer-name (format " *etaf-ui-grid-%s-test*" (car case))))
(unwind-protect
(progn
(setf (etaf-value (etaf-data-status controller))
(car case))
(setf (etaf-value (etaf-data-items controller)) nil)
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))
:row-key (lambda (row) (plist-get row :id))
:loading-label (when (eq (car case) 'loading)
(cdr case))
:error-label (when (eq (car case) 'error)
(cdr case))
:empty-label (when (eq (car case) 'empty)
(cdr case)))))
(should (string-match-p (regexp-quote (cdr case))
(etaf-ui-test--text buffer-name))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer))))))
(ert-deftest etaf-ui-data-grid-requires-stable-row-key ()
"Reject a DataGrid that cannot identify retained rows."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-row-key-test*"))
(unwind-protect
(should-error
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-rejects-nil-row-key ()
"Reject a DataGrid row-key function that returns no identity."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-nil-row-key-test*"))
(unwind-protect
(should-error
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))
:row-key (lambda (_row) nil)))))
(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-tests)
;;; etaf-ui-tests.el ends here