;;; etaf-ui-table-adaptive-tests.el --- Adaptive Table tracks -*- lexical-binding: t; -*- ;;; Commentary: ;; Mixed character and fractional columns share one header/row allocation. ;;; Code: (require 'ert) (require 'cl-lib) (require 'etaf-ui) (defvar etaf-ui-adaptive-test--states nil) (defvar etaf-ui-adaptive-test--removed nil) (etaf-define-component etaf-ui-adaptive-test-actions (&key row) "Keep independent action state in ROW's adaptive table cell." :setup (let ((state (list (plist-get row :id) (etaf-ref 0) (etaf-inject 'adaptive-table-context nil t)))) (push state etaf-ui-adaptive-test--states) (etaf-on-unmounted (lambda () (push (car state) etaf-ui-adaptive-test--removed))) state) :render (let ((count (cadr (etaf-state))) (id (plist-get row :id))) (etaf-view (row :item-gap 1 (etaf-button :label "Complete" :ref (intern (format "adaptive-complete-%s" id)) :on-press (lambda () (cl-incf (etaf-value count)))) (etaf-button :label "Delete" :ref (intern (format "adaptive-delete-%s" id)) :on-press #'ignore))))) (defun etaf-ui-adaptive-test--action-cell (row) "Build ROW's action cell, rejecting explicit bad candidates." (when (plist-get row :fail) (error "Rejected adaptive cell")) (etaf-node 'etaf-ui-adaptive-test-actions (list :row row) nil)) (etaf-define-component etaf-ui-adaptive-test-provider (&key rows columns controller theme selected) "Render a Table or CONTROLLER's DataGrid in the same themed environment." :setup (progn (etaf-provide 'adaptive-table-context "consumer-context") (etaf-theme-provide theme) nil) :render (let ((selection selected)) (etaf-node (if controller 'etaf-data-grid 'etaf-table) (append (list :columns columns :row-key (lambda (row) (plist-get row :id)) :row-ref (lambda (row) (intern (format "adaptive-row-%s" (plist-get row :id)))) :on-row-press (lambda (row) (setf (etaf-value selection) (plist-get row :id))) :row-selected-p (lambda (row) (equal (etaf-value selection) (plist-get row :id)))) (if controller (list :controller controller) (list :rows rows))) nil))) (defun etaf-ui-adaptive-test--columns () "Return an expanding title and a fixed character action track." (list '(:key :title :label "Task" :width (fr 1)) '(:key :actions :label "Actions" :width 22 :cell etaf-ui-adaptive-test--action-cell))) (defun etaf-ui-adaptive-test--x (buffer position) "Return POSITION's rendered horizontal pixel offset in BUFFER." (with-current-buffer buffer (save-excursion (goto-char position) (ebox-string-pixel-width (buffer-substring (line-beginning-position) (point)))))) (defun etaf-ui-adaptive-test--background (runtime ref) "Return the resolved background of RUNTIME's REF, including live paint." (let ((value (plist-get (gethash ref (etaf-runtime-host-props runtime)) :background-color))) (if (tp-paint-slot-p value) (plist-get (tp-paint-slot-spec value) :background) value))) (defun etaf-ui-adaptive-test--assert-layout (buffer width) "Check BUFFER's WIDTH, header alignment, and complete action hit targets." (let* ((runtime (etaf-runtime-for-buffer buffer)) (header-x (with-current-buffer buffer (save-excursion (goto-char (point-min)) (search-forward "Actions") (etaf-ui-adaptive-test--x buffer (- (point) (length "Actions"))))))) (dolist (id '(1 2)) (let* ((ref (intern (format "adaptive-complete-%s" id))) (bounds (etaf-host-ref-bounds runtime ref)) (row-bounds (etaf-host-ref-bounds runtime (intern (format "adaptive-row-%s" id))))) (should bounds) (should (<= (car row-bounds) (car bounds))) (should (<= (cdr bounds) (cdr row-bounds))) (should (= header-x (etaf-ui-adaptive-test--x buffer (car bounds)))) (dolist (control '(complete delete)) (let* ((button (intern (format "adaptive-%s-%s" control id))) (button-bounds (etaf-host-ref-bounds runtime button))) (should button-bounds) (with-current-buffer buffer (should (string-match-p (if (eq control 'complete) "Complete" "Delete") (buffer-substring-no-properties (car button-bounds) (cdr button-bounds))))))))) (with-current-buffer buffer (save-excursion (goto-char (point-min)) (while (< (point) (point-max)) (should (<= (ebox-string-pixel-width (buffer-substring (line-beginning-position) (line-end-position))) (+ width 2))) (forward-line 1)))))) (ert-deftest etaf-ui-adaptive-columns-reject-invalid-fractional-weights () "Invalid fractional tracks identify the offending column before mounting." (dolist (width '((fr) (fr 0) (fr -1) (fr "wide") (fr 1 extra))) (let ((message (error-message-string (should-error (etaf-render (etaf-view (etaf-table :columns (list (list :key :title :width width)) :rows nil :row-key #'identity))))))) (should (string-match-p "column 1 (:title)" message)) (should (string-match-p "POSITIVE-WEIGHT" message))))) (ert-deftest etaf-ui-adaptive-columns-align-and-preserve-actions-on-resize () "Table and DataGrid allocate matching adaptive tracks through live updates." (dolist (grid-p '(nil t)) (let* ((etaf-ui-adaptive-test--states nil) (etaf-ui-adaptive-test--removed nil) (rows '((:id 1 :title "A long task title that must fit its assigned track without moving actions") (:id 2 :title "Short task"))) (controller (and grid-p (etaf-data-controller (etaf-data-memory-source rows :id-key :id) :page-size 10 :auto-load t))) (selected (etaf-ref nil)) (theme (etaf-ref '(:ui-fg "#152030" :ui-table-border "#CBD5E1" :ui-table-selected-bg "#DBEAFE"))) (buffer (generate-new-buffer " *adaptive-table*"))) (unwind-protect (progn (etaf-mount buffer (etaf-view (etaf-ui-adaptive-test-provider :rows rows :columns (etaf-ui-adaptive-test--columns) :controller controller :theme theme :selected selected))) (let ((runtime (etaf-runtime-for-buffer buffer)) previous-x) (dolist (width '(420 760 280 420)) (ebox-surface-update-buffer-viewport buffer width 30) (etaf-ui-adaptive-test--assert-layout buffer width) (let* ((bounds (etaf-host-ref-bounds runtime 'adaptive-complete-1)) (x (etaf-ui-adaptive-test--x buffer (car bounds)))) (when (= width 760) (should (> x previous-x))) (setq previous-x x)) (etaf-dispatch-event runtime 'adaptive-complete-1 'press) (let* ((id (if (equal (etaf-value selected) 2) 1 2)) (ref (intern (format "adaptive-row-%s" id)))) (etaf-dispatch-event runtime ref 'press) (should (= (etaf-value selected) id)) (should (equal "#DBEAFE" (etaf-ui-adaptive-test--background runtime ref))))) (let ((bounds (etaf-host-ref-bounds runtime 'adaptive-complete-1)) (selected-ref (intern (format "adaptive-row-%s" (etaf-value selected))))) (setf (etaf-value theme) '(:ui-fg "#F1F5F9" :ui-table-border "#475569" :ui-table-selected-bg "#334155" :ui-button-primary-bg "#2563EB")) (etaf-ui-adaptive-test--assert-layout buffer 420) (should (equal bounds (etaf-host-ref-bounds runtime 'adaptive-complete-1))) (should (equal "#334155" (etaf-ui-adaptive-test--background runtime selected-ref))) (should (equal "#2563EB" (etaf-ui-adaptive-test--background runtime 'adaptive-complete-1)))) (should (= 2 (length etaf-ui-adaptive-test--states))) (should-not etaf-ui-adaptive-test--removed) (should (= 4 (etaf-value (cadr (assq 1 etaf-ui-adaptive-test--states))))) (dolist (state etaf-ui-adaptive-test--states) (should (equal "consumer-context" (nth 2 state)))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer))) (etaf-unmount runtime)) (when controller (etaf-data-stop controller)) (kill-buffer buffer))))) (ert-deftest etaf-ui-adaptive-cells-retain-identity-and-failed-candidates () "Adaptive row/column reorders preserve local state and rollback ownership." (let* ((etaf-ui-adaptive-test--states nil) (etaf-ui-adaptive-test--removed nil) (rows (etaf-ref '((:id 1 :title "First") (:id 2 :title "Second")))) (columns (etaf-ref (etaf-ui-adaptive-test--columns))) (theme (etaf-ref nil)) (selected (etaf-ref nil)) (buffer (generate-new-buffer " *adaptive-retention*"))) (unwind-protect (progn (etaf-mount buffer (etaf-view (etaf-ui-adaptive-test-provider :rows (etaf-value rows) :columns (etaf-value columns) :theme theme :selected selected))) (let ((runtime (etaf-runtime-for-buffer buffer))) (ebox-surface-update-buffer-viewport buffer 420 30) (etaf-dispatch-event runtime 'adaptive-complete-1 'press) ;; Width is geometry, not cell ownership. Keep the same keys and ;; action Component through both fixed-to-fr and fr-to-fixed paths. (dolist (width '(18 (fr 1) 26 (fr 2))) (setf (etaf-value columns) (list (list :key :title :label "Task" :width width) (cadr (etaf-ui-adaptive-test--columns)))) (should (= 2 (length etaf-ui-adaptive-test--states))) (should-not etaf-ui-adaptive-test--removed) (should (= 1 (etaf-value (cadr (assq 1 etaf-ui-adaptive-test--states)))))) (setf (etaf-value columns) (reverse (etaf-value columns)) (etaf-value rows) (reverse (etaf-value rows))) (should (= 2 (length etaf-ui-adaptive-test--states))) (should-not etaf-ui-adaptive-test--removed) (let ((text (with-current-buffer buffer (buffer-string))) (generation (etaf-runtime-current-generation runtime))) (should-error (setf (etaf-value rows) '((:id 1 :title "Candidate") (:id 2 :title "Rejected" :fail t)))) (should (eq generation (etaf-runtime-current-generation runtime))) (should (equal-including-properties text (with-current-buffer buffer (buffer-string))))) (etaf-dispatch-event runtime 'adaptive-complete-1 'press) (should (= 2 (etaf-value (cadr (assq 1 etaf-ui-adaptive-test--states))))) (setf (etaf-value rows) '((:id 1 :title "Recovered"))) (should (equal '(2) etaf-ui-adaptive-test--removed)))) (when-let* ((runtime (etaf-runtime-for-buffer buffer))) (etaf-unmount runtime)) (kill-buffer buffer)))) (ert-deftest etaf-ui-table-string-column-keys-read-equal-alist-keys () "Table and DataGrid read string keys in both fixed and adaptive cells." (dolist (grid-p '(nil t)) (dolist (width '(12 (fr 1))) (let* ((column-key (copy-sequence "name")) (row-key (copy-sequence "name")) (rows (list (list (cons :id 1) (cons row-key "Ada")))) (controller (and grid-p (etaf-data-controller (etaf-data-memory-source rows :id-key :id) :page-size 10 :auto-load t))) (buffer (generate-new-buffer " *string-column-key*"))) (should (equal column-key row-key)) (should-not (eq column-key row-key)) (unwind-protect (progn (etaf-mount buffer (etaf-node (if grid-p 'etaf-data-grid 'etaf-table) (append (list :columns (list (list :key column-key :label "Name" :width width)) :row-key (lambda (row) (alist-get :id row))) (if grid-p (list :controller controller) (list :rows rows))) nil) '(:viewport-width 300 :viewport-height 10)) (should (string-match-p "Ada" (with-current-buffer buffer (buffer-string))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer))) (etaf-unmount runtime)) (when controller (etaf-data-stop controller)) (kill-buffer buffer)))))) (provide 'etaf-ui-table-adaptive-tests) ;;; etaf-ui-table-adaptive-tests.el ends here