Retain DataGrid actions and bound Pagination

README.md

@@ -66,7 +66,9 @@ row is an interactive button: `:row-ref` is required, must return a non-nil
 stable Host reference for each row, and the row receives role `button` and
 tab index `0`. `:on-row-press` receives the row. Without `:on-row-press`, rows
 have no callback or tab stop. `:row-key` remains a required non-nil stable
-scalar identity for retained rows.
+scalar identity for retained rows. DataGrid retains one action closure per
+row key, so selection or data Range updates do not recreate handlers for
+unchanged rows.
 
 `etaf-pagination` is a controlled Data Component. It accepts a Data controller
 plus stable `:previous-ref` and `:next-ref` values, renders readable `‹`/`›`

README.zh-CN.md

@@ -57,7 +57,8 @@ DataGrid 支持列描述、函数型 `:row-key`，以及可选的
 提供 `:row-ref`，它对每一行返回非 nil 的稳定 Host ref；行会获得
 `button` role 和 `tab-index 0`，且回调接收该行。没有 `:on-row-press` 时，
 行没有回调或 tab stop。`:row-key` 仍然是 retained row 必须具备的非 nil
-稳定标量 identity。
+稳定标量 identity。DataGrid 按 row key 保留唯一 action closure，因此 selection
+或 Data Range 更新不会为未变化的行重建 handler。
 
 `etaf-pagination` 是受控 Data Component。它接收 Data controller 以及稳定的
 `:previous-ref`、`:next-ref`，显示易读的 `‹`/`›` 控件和 `Page N / M` 摘要；

etaf-ui.el

@@ -139,12 +139,29 @@ TAB-INDEX, and ARIA-LABEL provide Host identity and presentation."
   (or (and row-selected-p (funcall row-selected-p row))
       (and selected-key (equal key selected-key))))
 
+(defun etaf-ui--grid-row-action (cache key row callback)
+  "Return CACHE's stable row action for KEY, refreshing ROW and CALLBACK."
+  (let ((entry (gethash key cache)))
+    (unless entry
+      (setq entry (vector row callback nil))
+      (aset entry 2
+            (lambda ()
+              (let ((current (aref entry 1)))
+                (when current
+                  (funcall current (aref entry 0))))))
+      (puthash key entry cache))
+    (aset entry 0 row)
+    (aset entry 1 callback)
+    (aref entry 2)))
+
 (defun etaf-ui--grid-row
-    (row columns row-key row-ref on-row-press selected-key row-selected-p)
+    (row columns row-key row-ref on-row-press selected-key row-selected-p
+         row-actions)
   "Return a View row for ROW and COLUMNS with the DataGrid contract.
 
 ROW-KEY returns identity; ROW-REF returns the interactive reference;
-ON-ROW-PRESS, SELECTED-KEY, and ROW-SELECTED-P control state."
+ON-ROW-PRESS, SELECTED-KEY, and ROW-SELECTED-P control state.  ROW-ACTIONS
+owns stable keyed callbacks across Range reevaluation."
   (let* ((key (funcall row-key row))
          (interactive-p (not (null on-row-press)))
          (selected-p (etaf-ui--grid-selected-p
@@ -171,9 +188,30 @@ ON-ROW-PRESS, SELECTED-KEY, and ROW-SELECTED-P control state."
         (etaf-ui--interactive-surface-properties
          (format "Row %s" key) nil))
       :on-press (when interactive-p
-                  (lambda () (funcall on-row-press row)))
+                  (etaf-ui--grid-row-action
+                   row-actions key row on-row-press))
       (expr :value (etaf-ui--grid-cells row columns))))))
 
+(defun etaf-ui--grid-rows
+    (items columns row-key row-ref on-row-press selected-key row-selected-p
+           row-actions)
+  "Return keyed item Views and prune ROW-ACTIONS outside current ITEMS.
+COLUMNS and ROW-KEY describe cells and identity.  ROW-REF, ON-ROW-PRESS,
+SELECTED-KEY, and ROW-SELECTED-P provide interaction state."
+  (let ((seen (make-hash-table :test #'equal)))
+    (prog1
+        (mapcar
+         (lambda (item)
+           (puthash (funcall row-key item) t seen)
+           (etaf-ui--grid-row
+            item columns row-key row-ref on-row-press selected-key
+            row-selected-p row-actions))
+         items)
+      (maphash (lambda (key _entry)
+                 (unless (gethash key seen)
+                   (remhash key row-actions)))
+               row-actions))))
+
 (defun etaf-ui--button-setup ()
   "Create the retained renderer for one Button instance."
   (let* ((pressed (etaf-ref nil))
@@ -377,47 +415,58 @@ a stable Host reference."
    (".etaf-data-grid-header-cell" :face bold)
    (".etaf-data-grid-row" :padding (0 1)
     :border ((1) solid "#687386"))
-   ;; Keep selection visible without painting the row's stretch remainder as
-   ;; a misleading white bar; the row border and emphasized text are the
-   ;; interaction signal, while cell backgrounds remain transparent.
    (".selected" :color "#2F6B43"
-    :border ((1) solid "#73A982") :face bold)
+    :border ((1) solid "#73A982"))
    (".etaf-data-grid-error" :color "#FF6B6B"))
-  :view
+  :setup
-  (column
+  (let ((row-actions (make-hash-table :test #'equal)))
-   :class "etaf-data-grid"
+    (lambda ()
-   (expr :value (etaf-ui--grid-header columns))
+      (let ((controller (etaf-current-prop :controller))
-   (column
+            (columns (etaf-current-prop :columns))
-    :class "etaf-data-grid-body"
+            (row-key (etaf-current-prop :row-key))
-    (expr
+            (row-ref (etaf-current-prop :row-ref))
-     :value
+            (on-row-press (etaf-current-prop :on-row-press))
-     (progn
+            (selected-key (etaf-current-prop :selected-key))
-       (unless (functionp row-key)
+            (row-selected-p (etaf-current-prop :row-selected-p))
-         (error "ETAF DataGrid requires a function-valued :row-key"))
+            (loading-label (etaf-current-prop :loading-label))
-       (when (and on-row-press (not (functionp on-row-press)))
+            (error-label (etaf-current-prop :error-label))
-         (error "ETAF DataGrid :on-row-press must be a function"))
+            (empty-label (etaf-current-prop :empty-label)))
-       (when (and on-row-press (not (functionp row-ref)))
+        (etaf-view
-         (error "ETAF DataGrid requires :row-ref for interactive rows"))
+         (column
-       (when (and row-selected-p (not (functionp row-selected-p)))
+          :class "etaf-data-grid"
-         (error "ETAF DataGrid :row-selected-p must be a function"))
+          (expr :value (etaf-ui--grid-header columns))
-       (let ((status (etaf-value (etaf-data-status controller)))
+          (column
-             (items (etaf-value (etaf-data-items controller))))
+           :class "etaf-data-grid-body"
-         (cond
+           (expr
-          ((eq status 'loading)
+            :value
-           (etaf-view (text (expr :value (or loading-label "Loading...")))))
+            (progn
-          ((eq status 'error)
+              (unless (functionp row-key)
-           (etaf-view
+                (error "ETAF DataGrid requires a function-valued :row-key"))
-            (text :class "etaf-data-grid-error"
+              (when (and on-row-press (not (functionp on-row-press)))
-                  (expr :value (or error-label "Unable to load data.")))))
+                (error "ETAF DataGrid :on-row-press must be a function"))
-          ((null items)
+              (when (and on-row-press (not (functionp row-ref)))
-           (etaf-view (text (expr :value (or empty-label "No data.")))))
+                (error "ETAF DataGrid requires :row-ref for interactive rows"))
-          (t
+              (when (and row-selected-p (not (functionp row-selected-p)))
-           (mapcar (lambda (item)
+                (error "ETAF DataGrid :row-selected-p must be a function"))
-                     (etaf-ui--grid-row
+              (let ((status (etaf-value (etaf-data-status controller)))
-                      item columns row-key row-ref on-row-press
+                    (items (etaf-value (etaf-data-items controller))))
-                      selected-key row-selected-p))
+                (cond
-                   items)))))))
+                 ((eq status 'loading)
-   (slot :name 'footer)))
+                  (etaf-view
+                   (text (expr :value (or loading-label "Loading...")))))
+                 ((eq status 'error)
+                  (etaf-view
+                   (text :class "etaf-data-grid-error"
+                         (expr :value
+                               (or error-label "Unable to load data.")))))
+                 ((null items)
+                  (etaf-view
+                   (text (expr :value (or empty-label "No data.")))))
+                 (t
+                  (etaf-ui--grid-rows
+                   items columns row-key row-ref on-row-press selected-key
+                   row-selected-p row-actions))))))
+          (slot :name 'footer))))))))
 
 ;;;###autoload
 (etaf-define-component etaf-pagination
@@ -432,7 +481,7 @@ the pager participates in keyboard/mouse interaction.  The visible glyphs
 readable in both GUI and text review."
   :styles
   (styles
-   ("&" :width stretch :padding (0 1))
+   ("&" :width stretch)
    (".etaf-pagination-label" :face bold)
    (".etaf-pagination-summary" :color "#526174"))
   :setup
@@ -469,9 +518,11 @@ readable in both GUI and text review."
           (button :label "‹" :ref (etaf-current-prop :previous-ref)
                   :aria-label "Previous page"
                   :disabled previous-disabled
+                  :padding '(0 0)
+                  :border '((0) solid "transparent")
                   :variant 'secondary
                   :on-press (unless previous-disabled previous))
-          (column :width 'stretch
+          (column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
            (text :class "etaf-pagination-label" :text-align 'center
                  (expr :value (format "Page %d / %d" page pages)))
            (text :class "etaf-pagination-summary" :text-align 'center
@@ -480,6 +531,8 @@ readable in both GUI and text review."
           (button :label "›" :ref (etaf-current-prop :next-ref)
                   :aria-label "Next page"
                   :disabled next-disabled
+                  :padding '(0 0)
+                  :border '((0) solid "transparent")
                   :variant 'secondary
                   :on-press (unless next-disabled next))))))))
 

tests/etaf-ui-tests.el

@@ -358,14 +358,20 @@
             (should (equal (plist-get second :tab-index) 0))
             (should (string-match-p "selected" (plist-get second :class)))
             (should-not (string-match-p "selected" (plist-get first :class))))
-          (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
+          (let* ((runtime (etaf-runtime-for-buffer buffer-name))
-                               'row-1 'press)
+                 (handler (cdr (assq 'press
-          (should (equal (plist-get pressed :id) 1))
+                                     (etaf-runtime-handler-for runtime
-          (etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
+                                                               'row-1)))))
-          (should (string-match-p "Alan" (etaf-ui-test--text buffer-name)))
+            (etaf-dispatch-event runtime 'row-1 'press)
-          (should (equal (plist-get (etaf-ui-test--props buffer-name 'row-3)
+            (should (equal (plist-get pressed :id) 1))
-                                    :tab-index)
+            (etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
-                         0)))
+            (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)
@@ -390,6 +396,17 @@
           (should (string-match-p "Page 1 / 3" (etaf-ui-test--text buffer-name)))
           (should (string-match-p "‹" (etaf-ui-test--text buffer-name)))
           (should (string-match-p "›" (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)))
           (should (eq (nth 0 (etaf-ui-test--surface-properties
                               buffer-name 'page-next))
                       'hand))