diff --git a/etaf-ui-data.el b/etaf-ui-data.el new file mode 100644 index 0000000..d5dc267 --- /dev/null +++ b/etaf-ui-data.el @@ -0,0 +1,342 @@ +;;; etaf-ui-data.el --- Data-aware ETAF UI Components -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; DataGrid and Pagination adapt ETAF Data Controller state onto basic +;; Components. They do not duplicate Table or Button behavior. + +;;; Code: + +(require 'etaf-ui-table) + +(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-data-item-identity "etaf-data" (controller item)) + +(defun etaf-ui--data-grid-default-row-ref (controller row) + "Return a stable internal Host reference for CONTROLLER ROW. + +DataGrid owns this fallback so the presentational Table can keep its stricter +interactive-row contract. The controller's validated item identity is the +only input, making the reference stable across keyed Range updates." + (intern (format "etaf-data-grid-row-%s" + (etaf-data-item-identity + controller row)))) + +(defun etaf-ui--data-grid-row-ref (row-ref on-row-press controller row) + "Return a validated stable Host reference for interactive ROW. + +An explicit ROW-REF remains caller-owned. Interactive grids without one use +the CONTROLLER identity fallback; when ON-ROW-PRESS is nil, rows have no Host +reference." + (when on-row-press + (let ((ref (if row-ref + (funcall row-ref row) + (etaf-ui--data-grid-default-row-ref controller row)))) + (unless ref + (error "ETAF DataGrid :row-ref must return a non-nil stable ref")) + ref))) + +(defun etaf-ui--data-grid-row-action (cache key row callback) + "Return CACHE's stable press action for row KEY. + +The vector is retained by DataGrid setup state; only its current ROW and +CALLBACK change across renders. Unchanged keyed rows therefore keep the same +handler identity and avoid rebuilding behavior resources." + (let ((entry (gethash key cache))) + (unless entry + (setq entry (vector row callback nil)) + (aset entry 2 + (lambda () + (let ((current (aref entry 1))) + (when current + (funcall current (aref entry 0)))))) + (puthash key entry cache)) + (aset entry 0 row) + (aset entry 1 callback) + (aref entry 2))) + +(defun etaf-ui--data-grid-row-selected-p (controller row row-selected-p) + "Return whether ROW is selected in CONTROLLER or by ROW-SELECTED-P." + (or (and row-selected-p (funcall row-selected-p row)) + (etaf-value + (etaf-data-selected-ref + controller (etaf-data-item-identity controller row))))) + +(defun etaf-ui--data-grid-row + (controller entry columns row-ref on-row-press row-selected-p row-actions + theme) + "Return one retained DataGrid row for keyed ENTRY. +CONTROLLER owns selection identity; ROW-REF, ON-ROW-PRESS, and ROW-SELECTED-P +define the interaction contract. ROW-ACTIONS retains callback identity, and +THEME is the resolved table-paint snapshot for this item." + (let* ((key (car entry)) + (row (cdr entry)) + (border-color (plist-get theme :ui-table-border)) + (selected-p + (etaf-ui--data-grid-row-selected-p + controller row row-selected-p))) + (unless key + (error "ETAF DataGrid row-key must return a non-nil stable scalar")) + (etaf-node + 'row + (list :key key + :class (concat "etaf-table-row" (when selected-p " selected")) + :ref (etaf-ui--data-grid-row-ref + row-ref on-row-press controller row) + :role (when on-row-press 'button) + :tab-index (when on-row-press 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 border-color + :on-press + (and on-row-press + (etaf-ui--data-grid-row-action + row-actions key row on-row-press))) + (etaf-ui--table-cells row columns border-color)))) + +(defun etaf-ui--data-grid-state-label (key text &optional class color) + "Return TEXT as a non-row DataGrid state label identified by KEY. +CLASS and COLOR optionally style the label." + (etaf-node 'etaf-label + (list :key key :text text :class class :color color) + nil)) + +(defun etaf-ui--data-grid-body-entries + (controller row-key loading-label error-label empty-label) + "Return public keyed Range entries for CONTROLLER and labels. +ROW-KEY identifies successful rows. Loading, error, and empty states use one +stable sentinel entry so every body state remains below the same Range. +LOADING-LABEL, ERROR-LABEL, and EMPTY-LABEL override default state text." + (let* ((status (etaf-value (etaf-data-status controller))) + (items (etaf-value (etaf-data-items controller)))) + (cond + ((and (eq status 'success) items) + (etaf-ui--table-entries items row-key)) + ((and (eq status 'loading) (null items)) + (list (cons 'loading + (list :etaf-data-grid-state 'loading + :text (or loading-label "Loading..."))))) + ((and (eq status 'error) (null items)) + (list (cons 'error + (list :etaf-data-grid-state 'error + :text (or error-label "Unable to load data."))))) + (t + (list (cons 'empty + (list :etaf-data-grid-state 'empty + :text (or empty-label "No data.")))))))) + +(defun etaf-ui--data-grid-state-entry-node (entry) + "Return the state label View represented by keyed ENTRY." + (let* ((state (cdr entry)) + (kind (plist-get state :etaf-data-grid-state)) + (theme (and (eq kind 'error) + (etaf-ui--style-tokens :ui-data-grid-error-fg)))) + (etaf-ui--data-grid-state-label + kind (plist-get state :text) + (when (eq kind 'error) "etaf-data-grid-error") + (and theme (plist-get theme :ui-data-grid-error-fg))))) + +(etaf-define-component etaf-ui--data-grid-body-item + (&key controller entry columns row-ref on-row-press row-selected-p + row-actions) + "Render one retained keyed DataGrid ENTRY with a cached row action." + :view + (expr + (if (plist-get (cdr entry) :etaf-data-grid-state) + (etaf-ui--data-grid-state-entry-node entry) + (etaf-ui--data-grid-row + controller entry columns row-ref on-row-press row-selected-p row-actions + (etaf-ui--style-tokens + :ui-table-border :ui-table-selected-fg :ui-table-selected-bg))))) + +;;;###autoload +(etaf-define-component etaf-data-grid + (&key controller columns row-key on-row-press row-ref row-selected-p + loading-label error-label empty-label) + "Render DATA CONTROLLER state through the public Component DSL. + +DataGrid owns loading, error, empty, and controller-selection adaptation. +Its keyed Range retains row identity across insert, reorder, and update; setup +state only caches stable row action closures." + :setup (list :row-actions (make-hash-table :test #'equal)) + :view + (column + :class "etaf-data-grid 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--data-grid-body-item + :for (entry + (etaf-ui--data-grid-body-entries + controller row-key loading-label error-label empty-label)) + :key (car entry) + :controller controller :entry entry :columns columns + :row-ref row-ref :on-row-press on-row-press + :row-selected-p row-selected-p + :row-actions (plist-get (etaf-state) :row-actions))) + (slot :name 'footer))) + +;;;###autoload +(etaf-define-component etaf-pagination + (&key controller previous-ref next-ref class color bgcolor border padding + aria-label) + "Render a controlled pager for DATA CONTROLLER with retained controls." + :setup + (let* ((state (list :controller nil)) + (page-value + (lambda () + (let ((controller (plist-get state :controller))) + (max 1 (or (and controller + (etaf-value (etaf-data-page controller))) + 1))))) + (page-size-value + (lambda () + (let ((controller (plist-get state :controller))) + (max 1 (or (and controller + (etaf-value (etaf-data-page-size controller))) + 1))))) + (total-value + (lambda () + (let ((controller (plist-get state :controller))) + (max 0 (or (and controller + (etaf-value (etaf-data-total controller))) + 0))))) + (pages-value + (lambda () + (max 1 (ceiling (/ (float (funcall total-value)) + (funcall page-size-value)))))) + (loading-p + (lambda () + (let ((controller (plist-get state :controller))) + (and controller + (eq (etaf-value (etaf-data-status 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 () + (let ((controller (plist-get state :controller))) + (when (and controller + (not (funcall previous-disabled))) + (etaf-data-previous-page controller))))) + (next + (lambda () + (let ((controller (plist-get state :controller))) + (when (and controller + (not (funcall next-disabled))) + (etaf-data-next-page controller)))))) + (plist-put state :page-value page-value) + (plist-put state :page-size-value page-size-value) + (plist-put state :total-value total-value) + (plist-put state :pages-value pages-value) + (plist-put state :loading-p loading-p) + (plist-put state :previous-disabled previous-disabled) + (plist-put state :next-disabled next-disabled) + (plist-put state :previous previous) + (plist-put state :next next) + state) + :render + (let* ((state (etaf-state)) + (controller-value controller)) + (setf (plist-get state :controller) controller-value) + (let* ((theme (etaf-ui--style-tokens + :ui-fg :ui-bg :ui-disabled-fg + :ui-pagination-muted-fg)) + (parent-color (or color (plist-get theme :ui-fg))) + (parent-bgcolor (or bgcolor (plist-get theme :ui-bg))) + (arrow-border (or border '(0 solid "transparent"))) + (page (funcall (plist-get state :page-value))) + (page-size (funcall (plist-get state :page-size-value))) + (total (funcall (plist-get state :total-value))) + (pages (funcall (plist-get state :pages-value))) + (previous-disabled + (funcall (plist-get state :previous-disabled))) + (next-disabled + (funcall (plist-get state :next-disabled))) + (first-item (if (zerop total) 0 + (1+ (* (1- page) page-size)))) + (last-item (min total (* page page-size)))) + (etaf-node + 'flex + (list :class (etaf-ui--class-value "etaf-pagination" nil class) + :width 'stretch :flex-direction 'row :align-items 'center + :role 'navigation :aria-label (or aria-label "Pagination") + :color parent-color :background-color parent-bgcolor + :box-sizing 'border-box :padding (or padding '(0 1)) + :gap '(0 (1))) + (list + (etaf-node + 'column + (list :width 'max-content + :flex-grow 0 :flex-shrink 0 :flex-basis 'auto) + (list + (etaf-node + 'etaf-button + (list :label "←" :ref previous-ref + :aria-label "Previous page" + :disabled previous-disabled :padding '(0 0) + :border arrow-border + :color (if previous-disabled + (plist-get theme :ui-disabled-fg) + parent-color) + :background-color parent-bgcolor :font-weight 'bold + :on-press (plist-get state :previous)) + nil))) + (etaf-node + 'column + (list :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0) + (list + (etaf-node + 'box + (list :class "etaf-pagination-label" :text-align 'center + :wrap-mode 'none :min-width 'max-content) + (list (format "Page %d / %d" page pages))) + (etaf-node + 'box + (list :class "etaf-pagination-summary" :text-align 'center + :color (plist-get theme :ui-pagination-muted-fg) + :wrap-mode 'none :min-width 'max-content) + (list (format "%d–%d of %d" first-item last-item total))))) + (etaf-node + 'column + (list :width 'max-content + :flex-grow 0 :flex-shrink 0 :flex-basis 'auto) + (list + (etaf-node + 'etaf-button + (list :label "→" :ref next-ref + :aria-label "Next page" + :disabled next-disabled :padding '(0 0) + :border arrow-border + :color (if next-disabled + (plist-get theme :ui-disabled-fg) + parent-color) + :background-color parent-bgcolor :font-weight 'bold + :on-press (plist-get state :next)) + nil))))))) + :styles + (styles + ("&" :width stretch) + (".etaf-pagination-label" :font-weight bold))) + +(provide 'etaf-ui-data) +;;; etaf-ui-data.el ends here diff --git a/scripts/etaf-ui-m0a-inventory.el b/scripts/etaf-ui-m0a-inventory.el new file mode 100644 index 0000000..3bb7f50 --- /dev/null +++ b/scripts/etaf-ui-m0a-inventory.el @@ -0,0 +1,267 @@ +;;; etaf-ui-m0a-inventory.el --- M0a Component inventory -*- lexical-binding: t; -*- + +;;; Commentary: +;; Machine-readable current-behavior inventory. This file deliberately +;; records private consumers as drift; M0a does not turn the M0b target into a +;; failing current gate. + +;;; Code: +(require 'cl-lib) +(require 'seq) + +(defconst etaf-ui-m0a--package-root + (file-name-directory + (directory-file-name + (file-name-directory (or load-file-name buffer-file-name)))) + "Absolute etaf-ui package root used by the inventory.") + +(defconst etaf-ui-m0a-public-component-contracts + '((:name etaf-label + :business-props (text variant) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-basic.el") + (:name etaf-button + :business-props (label on-press disabled ref class color bgcolor border + padding font-weight tab-index aria-label use variant) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-basic.el") + (:name etaf-checkbox + :business-props (checked label on-change disabled) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-basic.el") + (:name etaf-panel + :business-props (title variant) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-basic.el") + (:name etaf-number-input + :business-props (value label on-change disabled min max) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-basic.el") + (:name etaf-table + :business-props (columns rows row-key row-ref on-row-press row-selected-p) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-table.el") + (:name etaf-data-grid + :business-props (controller columns row-key on-row-press row-ref + row-selected-p loading-label error-label + empty-label) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-data.el") + (:name etaf-pagination + :business-props (controller previous-ref next-ref class color bgcolor + border padding aria-label) + :forwarded-host-attrs all-valid-host-attrs + :root-guarantee single-host-root + :definition "etaf-ui-data.el")) + "Observed contracts of the eight public etaf-ui Components. + +`all-valid-host-attrs' names the core single-root Component forwarding rule; +it is not a claim that every attribute is a declared business prop.") + +(defconst etaf-ui-m0a-private-production-callsites + '((:symbol etaf--expr-create :scope production + :file "etaf-ui-data.el" :line 93) + (:symbol etaf--expr-create :scope production + :file "etaf-ui-data.el" :line 106) + (:symbol etaf--expr-create :scope production + :file "etaf-ui-data.el" :line 114) + (:symbol etaf--expr-create :scope production + :file "etaf-ui-data.el" :line 234) + (:symbol etaf--view-call :scope production + :file "etaf-ui-data.el" :line 278) + (:symbol etaf--view-call :scope production + :file "etaf-ui-data.el" :line 284) + (:symbol etaf--slot-projection-create :scope production + :file "etaf-ui-data.el" :line 286)) + "Exact M0a baseline of production calls into private ETAF functions.") + +(defconst etaf-ui-m0b-private-production-callsites nil + "M0b target and current production calls into private ETAF functions.") + +(defun etaf-ui-m0a--read-top-level-forms (file) + "Return top-level forms and source lines read from FILE." + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (let (forms form start) + (condition-case nil + (while t + (setq start (point) + form (read (current-buffer))) + (push (list :form form :line (line-number-at-pos start)) forms)) + (end-of-file nil)) + (nreverse forms)))) + +(defun etaf-ui-m0a--component-definitions () + "Return public Component definitions observed in package product files." + (let (result) + (dolist (file (directory-files etaf-ui-m0a--package-root t + "\\`etaf-ui-.*\\.el\\'")) + (dolist (entry (etaf-ui-m0a--read-top-level-forms file)) + (let ((form (plist-get entry :form))) + (when (and (eq (car-safe form) 'etaf-define-component) + (symbolp (cadr form)) + (not (string-prefix-p "etaf-ui--" + (symbol-name (cadr form))))) + (let ((arguments (nth 2 form))) + (push (list :name (cadr form) + :business-props + (seq-filter #'symbolp + (cdr (memq '&key arguments))) + :definition + (file-relative-name file etaf-ui-m0a--package-root) + :line (plist-get entry :line)) + result)))))) + (sort result (lambda (left right) + (string< (symbol-name (plist-get left :name)) + (symbol-name (plist-get right :name))))))) + +(defun etaf-ui-m0a-component-inventory () + "Return the current eight-Component contract with observed source lines." + (let ((definitions (etaf-ui-m0a--component-definitions))) + (mapcar + (lambda (contract) + (let* ((name (plist-get contract :name)) + (observed (seq-find + (lambda (entry) (eq name (plist-get entry :name))) + definitions))) + (append (copy-sequence contract) + (list :observed-business-props + (plist-get observed :business-props) + :observed-definition (plist-get observed :definition) + :line (plist-get observed :line) + :drift + (unless (and observed + (equal (plist-get contract :business-props) + (plist-get observed :business-props)) + (equal (plist-get contract :definition) + (plist-get observed :definition))) + 'contract-mismatch))))) + etaf-ui-m0a-public-component-contracts))) + +(defun etaf-ui-m0a--private-occurrences-in-file (file scope root call-only) + "Return active private occurrences in FILE under SCOPE and ROOT. + +When CALL-ONLY is non-nil, record only symbols in function-call position. +The linear scanner excludes strings and both line and block comments." + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (let ((block-depth 0) + in-string + escaped + result) + (while (< (point) (point-max)) + (cond + ((> block-depth 0) + (cond ((looking-at "#|") + (setq block-depth (1+ block-depth)) + (forward-char 2)) + ((looking-at "|#") + (setq block-depth (1- block-depth)) + (forward-char 2)) + (t (forward-char 1)))) + (in-string + (let ((character (char-after))) + (forward-char 1) + (cond (escaped (setq escaped nil)) + ((eq character ?\\) (setq escaped t)) + ((eq character ?\") (setq in-string nil))))) + ((looking-at "#|") + (setq block-depth 1) + (forward-char 2)) + ((eq (char-after) ?\;) + (forward-line 1)) + ((eq (char-after) ?\") + (setq in-string t) + (forward-char 1)) + ((eq (char-after) ??) + ;; Skip an Emacs Lisp character literal, including ?\\X. + (forward-char (min (if (eq (char-after (1+ (point))) ?\\) 3 2) + (- (point-max) (point))))) + ((and call-only (eq (char-after) ?\()) + (forward-char 1) + (skip-chars-forward " \t\r\n") + (when (looking-at "\\(etaf--[[:alnum:]-]+\\)\\_>") + (push (list :symbol (intern (match-string-no-properties 1)) + :scope scope + :file (file-relative-name file root) + :line (line-number-at-pos (point))) + result))) + ((and (not call-only) + (looking-at "\\_<\\(etaf--[[:alnum:]-]+\\)\\_>")) + (push (list :symbol (intern (match-string-no-properties 1)) + :scope scope + :file (file-relative-name file root) + :line (line-number-at-pos (point))) + result) + (goto-char (match-end 1))) + (t (forward-char 1)))) + (nreverse result)))) + +(defun etaf-ui-m0a-private-consumers (&optional root) + "Return active core-private consumers below ROOT. + +ROOT defaults to the etaf-ui package root." + (let* ((root (file-name-as-directory + (or root etaf-ui-m0a--package-root))) + (tests-directory (expand-file-name "tests" root)) + (files (append + (directory-files root t + "\\`etaf-ui-.*\\.el\\'") + (when (file-directory-p tests-directory) + (directory-files tests-directory t "\\.el\\'")))) + result) + (dolist (file files) + ;; The inventory's own expectation literals are evidence vocabulary, + ;; not calls into the private API under inventory. + (unless (string-suffix-p "etaf-ui-m0a-inventory-tests.el" file) + (setq result + (nconc result + (if (string-match-p "/tests/" file) + (etaf-ui-m0a--private-occurrences-in-file + file 'test root nil) + (etaf-ui-m0a--private-occurrences-in-file + file 'production root t)))))) + result)) + +(defun etaf-ui-m0a-private-consumer-drift (&optional root) + "Return current M0b production private-call drift below optional ROOT." + (let ((observed + (seq-filter + (lambda (entry) (eq 'production (plist-get entry :scope))) + (etaf-ui-m0a-private-consumers root)))) + (list :expected etaf-ui-m0b-private-production-callsites + :observed observed + :missing (seq-remove (lambda (entry) (member entry observed)) + etaf-ui-m0b-private-production-callsites) + :unexpected + (seq-remove (lambda (entry) + (member entry etaf-ui-m0b-private-production-callsites)) + observed)))) + +(defun etaf-ui-m0a-inventory () + "Return the complete machine-readable etaf-ui M0a inventory." + (list :schema-version 1 + :milestone 'M0b + :evidence-mode 'migrated-public-extension-seam + :components (etaf-ui-m0a-component-inventory) + :m0a-private-production-baseline + etaf-ui-m0a-private-production-callsites + :private-consumers (etaf-ui-m0a-private-consumers) + :private-production-drift (etaf-ui-m0a-private-consumer-drift))) + +(defun etaf-ui-m0a-inventory-batch () + "Print `etaf-ui-m0a-inventory' for a batch evidence run." + (prin1 (etaf-ui-m0a-inventory)) + (terpri)) + +(provide 'etaf-ui-m0a-inventory) +;;; etaf-ui-m0a-inventory.el ends here diff --git a/tests/etaf-ui-m0a-inventory-tests.el b/tests/etaf-ui-m0a-inventory-tests.el new file mode 100644 index 0000000..7533522 --- /dev/null +++ b/tests/etaf-ui-m0a-inventory-tests.el @@ -0,0 +1,182 @@ +;;; etaf-ui-m0a-inventory-tests.el --- M0a inventory tests -*- lexical-binding: t; -*- + +;;; Code: +(require 'ert) +(require 'seq) +(require 'etaf-ui) +(declare-function etaf-ui-m0a-component-inventory + "../scripts/etaf-ui-m0a-inventory") +(declare-function etaf-ui-m0a-private-consumers + "../scripts/etaf-ui-m0a-inventory") +(declare-function etaf-ui-m0a-private-consumer-drift + "../scripts/etaf-ui-m0a-inventory") +(declare-function etaf-ui-m0a-inventory + "../scripts/etaf-ui-m0a-inventory") +(load-file (expand-file-name "scripts/etaf-ui-m0a-inventory.el" + default-directory)) + +(ert-deftest etaf-ui-m0a-inventory-records-eight-public-components () + "Record exactly the eight current public etaf-ui Components." + (let ((components (etaf-ui-m0a-component-inventory))) + (should (= 8 (length components))) + (should + (equal '(etaf-button etaf-checkbox etaf-data-grid etaf-label + etaf-number-input etaf-pagination etaf-panel etaf-table) + (sort (mapcar (lambda (entry) (plist-get entry :name)) components) + (lambda (left right) + (string< (symbol-name left) (symbol-name right)))))))) + +(ert-deftest etaf-ui-m0a-inventory-matches-current-business-props () + "Match each declared business prop list to its source definition." + (dolist (component (etaf-ui-m0a-component-inventory)) + (should (equal (plist-get component :business-props) + (plist-get component :observed-business-props))) + (should-not (plist-get component :drift)))) + +(ert-deftest etaf-ui-m0a-inventory-separates-host-forwarding-from-props () + "Record Host forwarding and single-root guarantees separately from props." + (dolist (component (etaf-ui-m0a-component-inventory)) + (should (eq 'all-valid-host-attrs + (plist-get component :forwarded-host-attrs))) + (should (eq 'single-host-root + (plist-get component :root-guarantee))))) + +(ert-deftest etaf-ui-m0a-components-forward-host-attrs-to-one-mounted-root () + "Forward ref, class, and aria-label through every public Component root." + (let* ((source (etaf-data-memory-source + '((:id 1 :name "Ada")) :id-key :id)) + (controller (etaf-data-controller source :auto-load t)) + (buffer (generate-new-buffer-name " *etaf-ui-m0a-forwarding*")) + (components (etaf-ui-m0a-component-inventory))) + (unwind-protect + (progn + (etaf-mount + buffer + (etaf-view + (column + (etaf-label :text "Label" :ref 'm0a-label + :class "m0a-forwarded" :aria-label "m0a-label") + (etaf-button :label "Button" :ref 'm0a-button + :class "m0a-forwarded" :aria-label "m0a-button") + (etaf-checkbox :checked nil :label "Checkbox" + :ref 'm0a-checkbox :class "m0a-forwarded" + :aria-label "m0a-checkbox") + (etaf-panel :title "Panel" :ref 'm0a-panel + :class "m0a-forwarded" :aria-label "m0a-panel" + (etaf-label :text "Nested")) + (etaf-number-input :value 1 :label "Number" + :ref 'm0a-number-input + :class "m0a-forwarded" + :aria-label "m0a-number-input") + (etaf-table :columns '((:key :name :label "Name")) + :rows '((:id 1 :name "Ada")) + :row-key (lambda (row) (plist-get row :id)) + :ref 'm0a-table :class "m0a-forwarded" + :aria-label "m0a-table") + (etaf-data-grid + :controller controller + :columns '((:key :name :label "Name")) + :row-key (lambda (row) (plist-get row :id)) + :ref 'm0a-data-grid :class "m0a-forwarded" + :aria-label "m0a-data-grid") + (etaf-pagination :controller controller + :ref 'm0a-pagination + :class "m0a-forwarded" + :aria-label "m0a-pagination")))) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (should (= 8 (length components))) + (dolist (component components) + (let* ((name (plist-get component :name)) + (suffix (string-remove-prefix "etaf-" + (symbol-name name))) + (ref (intern (concat "m0a-" suffix))) + (props (etaf-runtime-host-props-for runtime ref))) + (should props) + (should (eq ref (plist-get props :ref))) + (should (member "m0a-forwarded" + (etaf--class-tokens + (plist-get props :class)))) + (should (equal (symbol-name ref) + (plist-get props :aria-label))))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-unmount runtime)) + (when (get-buffer buffer) (kill-buffer buffer)) + (etaf-data-stop controller)))) + +(ert-deftest etaf-ui-m0b-inventory-records-private-production-closure () + "Record zero current production private consumers and retain M0a history." + (let* ((entries (seq-filter + (lambda (entry) (eq 'production (plist-get entry :scope))) + (etaf-ui-m0a-private-consumers))) + (symbols (delete-dups + (mapcar (lambda (entry) (plist-get entry :symbol)) entries)))) + (should-not entries) + (should-not symbols) + (should (cl-every (lambda (entry) + (and (stringp (plist-get entry :file)) + (integerp (plist-get entry :line)))) + entries)) + (let ((drift (etaf-ui-m0a-private-consumer-drift))) + (should-not (plist-get drift :missing)) + (should-not (plist-get drift :unexpected))) + (should (= 7 (length etaf-ui-m0a-private-production-callsites))))) + +(ert-deftest etaf-ui-m0a-inventory-rejects-an-undeclared-production-callsite () + "Report a newly added private production call even when its symbol is known." + (let ((temporary-root (make-temp-file "etaf-ui-m0a-private-" t))) + (unwind-protect + (progn + (copy-file (expand-file-name "etaf-ui-data.el" default-directory) + (expand-file-name "etaf-ui-data.el" temporary-root)) + (with-temp-buffer + (insert "\n(etaf--expr-create 'undeclared-callsite)\n") + (append-to-file (point-min) (point-max) + (expand-file-name "etaf-ui-data.el" + temporary-root))) + (should (plist-get + (etaf-ui-m0a-private-consumer-drift temporary-root) + :unexpected))) + (delete-directory temporary-root t)))) + +(ert-deftest etaf-ui-m0a-inventory-records-current-test-consumers () + "Record existing private test consumers without counting inventory data." + (let* ((entries (seq-filter + (lambda (entry) (eq 'test (plist-get entry :scope))) + (etaf-ui-m0a-private-consumers))) + (symbols (delete-dups + (mapcar (lambda (entry) (plist-get entry :symbol)) entries)))) + (should (= 10 (length entries))) + (should (= 2 (cl-count 'etaf--class-tokens entries + :key (lambda (entry) + (plist-get entry :symbol))))) + (should (= 4 (cl-count 'etaf--runtime-render-dirty-component entries + :key (lambda (entry) + (plist-get entry :symbol))))) + (should (= 2 (cl-count 'etaf--ebox-box-node entries + :key (lambda (entry) + (plist-get entry :symbol))))) + (should (= 2 (cl-count 'etaf--ebox-text-node entries + :key (lambda (entry) + (plist-get entry :symbol))))) + (should (equal '(etaf--class-tokens etaf--ebox-box-node + etaf--ebox-text-node + etaf--runtime-render-dirty-component) + (sort symbols (lambda (left right) + (string< (symbol-name left) + (symbol-name right)))))))) + +(ert-deftest etaf-ui-m0b-inventory-labels-public-seam-migration () + "Label the zero-private-consumer state as the completed M0b migration." + (let ((inventory (etaf-ui-m0a-inventory))) + (should (eq 'M0b (plist-get inventory :milestone))) + (should (eq 'migrated-public-extension-seam + (plist-get inventory :evidence-mode))) + (should (= 7 (length (plist-get inventory + :m0a-private-production-baseline)))) + (should-not + (seq-filter + (lambda (entry) (eq 'production (plist-get entry :scope))) + (plist-get inventory :private-consumers))))) + +(provide 'etaf-ui-m0a-inventory-tests) +;;; etaf-ui-m0a-inventory-tests.el ends here diff --git a/tests/etaf-ui-m0b-extension-tests.el b/tests/etaf-ui-m0b-extension-tests.el new file mode 100644 index 0000000..7c7b565 --- /dev/null +++ b/tests/etaf-ui-m0b-extension-tests.el @@ -0,0 +1,204 @@ +;;; etaf-ui-m0b-extension-tests.el --- M0b public extension seam -*- lexical-binding: t; -*- + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'etaf-ui) + +(defconst etaf-ui-m0b--data-source-file + (expand-file-name "../etaf-ui-data.el" + (file-name-directory (or load-file-name buffer-file-name))) + "DataGrid production source inspected by the M0b seam tests.") + +(defun etaf-ui-m0b--walk (form predicate) + "Return non-nil when PREDICATE matches FORM or one of its children." + (or (funcall predicate form) + (and (consp form) + (or (etaf-ui-m0b--walk (car form) predicate) + (etaf-ui-m0b--walk (cdr form) predicate))))) + +(defun etaf-ui-m0b--source-forms (file) + "Read and return every Lisp form in FILE." + (with-temp-buffer + (insert-file-contents file) + (let (forms form) + (condition-case nil + (while t + (setq form (read (current-buffer))) + (push form forms)) + (end-of-file (nreverse forms)))))) + +(ert-deftest etaf-ui-m0b-data-grid-production-uses-public-extension-seam () + "DataGrid production code contains no ETAF private API call." + (let ((private + (cl-loop for form in (etaf-ui-m0b--source-forms + etaf-ui-m0b--data-source-file) + when (etaf-ui-m0b--walk + form + (lambda (node) + (and (symbolp node) + (string-prefix-p "etaf--" (symbol-name node))))) + collect form))) + (should-not private))) + +(ert-deftest etaf-ui-m0b-data-grid-public-range-retains-handler-and-root () + "Insert/reorder/update retain handlers and avoid a root replacement." + (let* ((rows (cl-loop for id from 1 to 12 + collect (list :id id :name (format "Row %d" id)))) + (source (etaf-data-memory-source rows :id-key :id)) + (controller (etaf-data-controller source :page-size 120 :auto-load t)) + (buffer-name " *etaf-ui-m0b-grid-retention*") + (root-replacements 0) + (materialized 0) + update-materialized + 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 "m0b-row-%d" (plist-get row :id)))) + :on-row-press (lambda (row) (setq pressed row))))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (handler + (cdr (assq 'press + (etaf-runtime-handler-for runtime 'm0b-row-6)))) + (old-root (symbol-function 'ebox-candidate-replace-root)) + (old-box (symbol-function 'etaf--ebox-box-node)) + (old-text (symbol-function 'etaf--ebox-text-node))) + (cl-letf (((symbol-function 'ebox-candidate-replace-root) + (lambda (&rest arguments) + (cl-incf root-replacements) + (apply old-root arguments))) + ((symbol-function 'etaf--ebox-box-node) + (lambda (&rest arguments) + (cl-incf materialized) + (apply old-box arguments))) + ((symbol-function 'etaf--ebox-text-node) + (lambda (&rest arguments) + (cl-incf materialized) + (apply old-text arguments)))) + (setf (etaf-value (etaf-data-items controller)) + (cl-loop for row in rows + if (= 6 (plist-get row :id)) + collect '(:id 6 :name "Row six updated") + else collect row)) + (setq update-materialized materialized) + (etaf-data-mutate controller 'insert + '(:id 13 :name "Row 13")) + (etaf-data-mutate controller 'update + '(:id 6 :name "Row six updated"))) + (should (zerop root-replacements)) + ;; One local update stays well below materializing all 12 rows and + ;; their two cells (at least 60 Ebox nodes). + (should (< update-materialized 30)) + (should (eq handler + (cdr (assq + 'press + (etaf-runtime-handler-for runtime 'm0b-row-6))))) + (etaf-dispatch-event runtime 'm0b-row-6 'press) + (should (equal "Row six updated" (plist-get pressed :name))) + (should (string-match-p + "Row six updated" + (with-current-buffer buffer-name + (substring-no-properties (buffer-string))))))) + (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-enumerates-120-items-once-per-turn () + "A 120-row update enumerates the public Range once and stays item-local." + (let* ((row-key-calls 0) + (rows (cl-loop for id from 1 to 120 + collect (list :id id :name (format "Row %d" id)))) + (source (etaf-data-memory-source rows :id-key :id)) + (controller (etaf-data-controller source :page-size 120 :auto-load t)) + (buffer-name " *etaf-ui-m0b-grid-scale*")) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-data-grid + :controller controller + :columns '((:key :id :label "ID")) + :row-key (lambda (row) + (cl-incf row-key-calls) + (plist-get row :id))))) + (setq row-key-calls 0) + (etaf-data-mutate controller 'update + '(:id 60 :name "Changed")) + (should (= 120 row-key-calls))) + (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-footer-reorder-and-key-rollback () + "Public slot projection and keyed rollback preserve the committed grid." + (let* ((rows '((:id 1 :name "Ada") (:id 2 :name "Grace"))) + (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-footer*") + 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) + (intern (format "m0b-footer-row-%d" + (plist-get row :id)))) + :on-row-press (lambda (row) (setq pressed row)) + (slot :name 'footer (etaf-label :text "Grid footer"))))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (handler + (cdr (assq 'press + (etaf-runtime-handler-for + runtime 'm0b-footer-row-1))))) + (should (string-match-p + "Grid footer" + (with-current-buffer buffer-name + (substring-no-properties (buffer-string))))) + (setf (etaf-value (etaf-data-items controller)) + (reverse rows)) + (should (eq handler + (cdr (assq + 'press + (etaf-runtime-handler-for + runtime 'm0b-footer-row-1))))) + (etaf-dispatch-event runtime 'm0b-footer-row-1 'press) + (should (= 1 (plist-get pressed :id))) + (let ((generation (etaf-runtime-current-generation runtime)) + (text (with-current-buffer buffer-name (buffer-string)))) + (should-error + (setf (etaf-value (etaf-data-items controller)) + '((:id 1 :name "A") (:id 1 :name "duplicate"))) + :type 'etaf-component-call-error) + (should (eq generation + (etaf-runtime-current-generation runtime))) + (should (equal-including-properties + text (with-current-buffer buffer-name + (buffer-string))))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (etaf-data-stop controller) + (when-let* ((buffer (get-buffer buffer-name))) + (kill-buffer buffer))))) + +(provide 'etaf-ui-m0b-extension-tests) +;;; etaf-ui-m0b-extension-tests.el ends here