784 lines
34 KiB
EmacsLisp
784 lines
34 KiB
EmacsLisp
;;; etaf-ui.el --- Official ETAF Component catalog -*- lexical-binding: t; -*-
|
||
|
||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||
;; Author: ETAF contributors
|
||
;; Version: 0.1.0
|
||
;; Package-Requires: ((emacs "29.1") (etaf "0.1.0"))
|
||
;; URL: https://github.com/ginqi7/etaf-ui
|
||
|
||
;;; Commentary:
|
||
|
||
;; The official ETAF catalog is one ordinary Component library. It does not
|
||
;; expose a parallel Control/Widget taxonomy: a DataGrid is a compound
|
||
;; Component built from the same View, props, slots, events, and Data APIs.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'etaf)
|
||
|
||
(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-theme-defaults "etaf-context" (&optional default))
|
||
(declare-function text "etaf-view" (&rest arguments))
|
||
(declare-function row "etaf-view" (&rest arguments))
|
||
(declare-function column "etaf-view" (&rest arguments))
|
||
(declare-function flex "etaf-view" (&rest arguments))
|
||
(declare-function expr "etaf-view" (&rest arguments))
|
||
(declare-function slot "etaf-view" (&rest arguments))
|
||
|
||
(defconst etaf-ui--default-theme-palette
|
||
'(:ui-fg "#252A2E"
|
||
:ui-bg "#FFFDF8"
|
||
:ui-border "#687386"
|
||
:ui-muted-fg "#526174"
|
||
:ui-danger-fg "#FF6B6B"
|
||
:ui-success-fg "#2F6B43"
|
||
:ui-disabled-fg "#687386"
|
||
:ui-disabled-bg "#E5E7EB"
|
||
:ui-disabled-border "#9CA3AF"
|
||
:ui-button-primary-fg "#FFFFFF"
|
||
:ui-button-primary-bg "#2F6B43"
|
||
:ui-button-primary-border "#2F6B43"
|
||
:ui-button-secondary-fg "#142235"
|
||
:ui-button-secondary-bg "#D9EEEA"
|
||
:ui-button-secondary-border "#2E8B83"
|
||
:ui-button-ghost-fg "#142235"
|
||
:ui-button-ghost-bg "#FFFDF8"
|
||
:ui-button-ghost-border "#C8C1B6"
|
||
:ui-checkbox-enabled-fg "#252A2E"
|
||
:ui-checkbox-enabled-bg "#DCEBDD"
|
||
:ui-checkbox-enabled-border "#6D8A73"
|
||
:ui-checkbox-disabled-fg "#6B7280"
|
||
:ui-checkbox-disabled-bg "#EEEAE2"
|
||
:ui-checkbox-disabled-border "#9CA3AF"
|
||
:ui-grid-border "#687386"
|
||
:ui-grid-selected-fg "#2F6B43"
|
||
:ui-grid-selected-bg "#DCEBDD"
|
||
:ui-grid-error-fg "#FF6B6B"
|
||
:ui-pagination-muted-fg "#526174"
|
||
:ui-panel-fg "#252A2E"
|
||
:ui-panel-bg "#FFFDF8"
|
||
:ui-panel-border "#687386")
|
||
"Default semantic UI palette, centralized outside Component definitions.
|
||
|
||
Applications normally override these tokens through ETAF Theme. Keeping the
|
||
fallback palette here gives the catalog a useful standalone appearance while
|
||
ensuring every Component reads one shared semantic vocabulary.")
|
||
|
||
(defconst etaf-ui--legacy-theme-aliases
|
||
'((:ui-fg :color)
|
||
(:ui-bg :bgcolor)
|
||
(:ui-border :border)
|
||
(:ui-button-primary-fg :ui-button-color)
|
||
(:ui-button-primary-bg :ui-button-bgcolor)
|
||
(:ui-button-primary-border :ui-button-border)
|
||
(:ui-button-secondary-fg :ui-button-secondary-color)
|
||
(:ui-button-secondary-bg :ui-button-secondary-bgcolor)
|
||
(:ui-button-secondary-border :ui-button-secondary-border)
|
||
(:ui-button-ghost-fg :ui-button-ghost-color)
|
||
(:ui-button-ghost-bg :ui-button-ghost-bgcolor)
|
||
(:ui-button-ghost-border :ui-button-ghost-border)
|
||
(:ui-disabled-fg :ui-button-disabled-color)
|
||
(:ui-disabled-bg :ui-button-disabled-bgcolor)
|
||
(:ui-disabled-border :ui-button-disabled-border))
|
||
"Compatibility aliases for the first ETAF UI Theme token spelling.")
|
||
|
||
;;;###autoload
|
||
(defun etaf-ui-theme-values (&rest requested)
|
||
"Return merged semantic UI Theme values for REQUESTED tokens.
|
||
|
||
Inherited application tokens win, legacy aliases remain readable, and the
|
||
central catalog palette fills only omitted values. This is the boundary
|
||
between generic ETAF Theme Context and etaf-ui's product-independent visual
|
||
semantics; individual Components do not own separate color systems. When
|
||
REQUESTED is nil, return the complete catalog token map."
|
||
(let* ((inherited (etaf-theme-defaults))
|
||
(defaults etaf-ui--default-theme-palette)
|
||
;; Callers that request a subset only need that semantic subset.
|
||
;; Keeping the full inherited plist is useful for the no-argument
|
||
;; catalog query, but copying it for every Button/Panel/DataGrid
|
||
;; render needlessly scales Theme work with application token count.
|
||
(result (unless requested (copy-sequence inherited)))
|
||
(keys (or requested
|
||
(cl-loop for (key _spec) on defaults by #'cddr
|
||
collect key))))
|
||
(dolist (key keys)
|
||
(let ((found
|
||
(cond
|
||
((plist-member inherited key)
|
||
(cons t (plist-get inherited key)))
|
||
(t
|
||
(cl-loop for alias in etaf-ui--legacy-theme-aliases
|
||
when (and (eq (car alias) key)
|
||
(plist-member inherited (cadr alias)))
|
||
return
|
||
(cons t (plist-get inherited (cadr alias))))))))
|
||
(setq result
|
||
(plist-put result key
|
||
(if found (cdr found) (plist-get defaults key)))))
|
||
)
|
||
result))
|
||
|
||
(defun etaf-ui--theme-border (value)
|
||
"Return Ebox border VALUE, preserving complete caller-owned specs.
|
||
|
||
Semantic Theme border tokens conventionally contain a color string. The
|
||
catalog turns a hex color into its one-cell border shape; an existing border
|
||
plist or a legacy caller-owned string remains untouched for compatibility."
|
||
(if (and (stringp value)
|
||
(string-match-p "\\`#[[:xdigit:]]+\\'" value))
|
||
(list (list 1) 'solid value)
|
||
value))
|
||
|
||
(defun etaf-ui--class-value (base state custom)
|
||
"Return BASE and STATE classes with optional CUSTOM classes."
|
||
(let ((custom (cond
|
||
((null custom) nil)
|
||
((listp custom) custom)
|
||
(t (list custom)))))
|
||
(mapconcat (lambda (class) (format "%s" class))
|
||
(cl-remove-if (lambda (class)
|
||
(or (null class) (equal class "")))
|
||
(append (list base state) custom))
|
||
" ")))
|
||
|
||
(defun etaf-ui--interactive-surface-properties (label disabled)
|
||
"Return shared text properties for an interactive LABEL surface.
|
||
DISABLED selects a non-pointer help description instead of an activation
|
||
affordance.
|
||
The properties are deliberately backend-neutral: Ebox turns them into the
|
||
native Emacs pointer/hover/help affordances while other renderers may ignore
|
||
the optional text properties and keep the semantic role/event contract."
|
||
(if disabled
|
||
(list 'help-echo (format "%s (disabled)" (or label "Control")))
|
||
(list 'pointer 'hand
|
||
'mouse-face 'highlight
|
||
'help-echo (format "%s · RET or mouse-1" (or label "Activate")))))
|
||
|
||
(defun etaf-ui--button-variant-values (variant disabled)
|
||
"Return themed presentation defaults for Button VARIANT and DISABLED."
|
||
(let* ((fg (cond (disabled :ui-disabled-fg)
|
||
((eq variant 'secondary) :ui-button-secondary-fg)
|
||
((eq variant 'ghost) :ui-button-ghost-fg)
|
||
(t :ui-button-primary-fg)))
|
||
(bg (cond (disabled :ui-disabled-bg)
|
||
((eq variant 'secondary) :ui-button-secondary-bg)
|
||
((eq variant 'ghost) :ui-button-ghost-bg)
|
||
(t :ui-button-primary-bg)))
|
||
(border (cond (disabled :ui-disabled-border)
|
||
((eq variant 'secondary) :ui-button-secondary-border)
|
||
((eq variant 'ghost) :ui-button-ghost-border)
|
||
(t :ui-button-primary-border)))
|
||
(theme (etaf-ui-theme-values fg bg border)))
|
||
(list :color (plist-get theme fg)
|
||
:bgcolor (plist-get theme bg)
|
||
:border (etaf-ui--theme-border (plist-get theme border))
|
||
:face (if (or disabled (eq variant 'ghost)) 'normal 'bold))))
|
||
|
||
(defun etaf-ui--button-view
|
||
(label on-press disabled ref class color bgcolor border padding face
|
||
tab-index aria-label use)
|
||
"Return a Button Host showing LABEL.
|
||
|
||
ON-PRESS and USE provide callbacks and Behaviors. DISABLED controls whether
|
||
the Host is interactive. REF, CLASS, COLOR, BGCOLOR, BORDER, PADDING, FACE,
|
||
TAB-INDEX, and ARIA-LABEL provide Host identity and presentation."
|
||
(let ((class-value (etaf-ui--class-value
|
||
"etaf-button"
|
||
(if disabled "disabled" "enabled")
|
||
class))
|
||
(tab-value (unless disabled (or tab-index 0)))
|
||
(label-value (or aria-label label))
|
||
(surface (etaf-ui--interactive-surface-properties label disabled)))
|
||
(if on-press
|
||
(etaf-view
|
||
(text :class class-value :role 'button :ref ref :disabled disabled
|
||
:tab-index tab-value :aria-label label-value
|
||
:color color :bgcolor bgcolor :border border
|
||
:padding padding :face face
|
||
:surface-properties surface
|
||
:use (unless disabled use) :on-press on-press
|
||
(expr :value label)))
|
||
(etaf-view
|
||
(text :class class-value :role 'button :ref ref :disabled disabled
|
||
:tab-index tab-value :aria-label label-value
|
||
:color color :bgcolor bgcolor :border border
|
||
:padding padding :face face
|
||
:surface-properties surface
|
||
:use (unless disabled use) (expr :value label))))))
|
||
|
||
(defun etaf-ui--checkbox-variant-values (theme disabled)
|
||
"Return semantic Theme values from THEME for DISABLED Checkbox state."
|
||
(let ((prefix (if disabled "disabled" "enabled")))
|
||
(list :color (plist-get theme
|
||
(intern (format ":ui-checkbox-%s-fg" prefix)))
|
||
:bgcolor (plist-get theme
|
||
(intern (format ":ui-checkbox-%s-bg" prefix)))
|
||
:border
|
||
(etaf-ui--theme-border
|
||
(plist-get theme
|
||
(intern (format ":ui-checkbox-%s-border" prefix)))))))
|
||
|
||
(defun etaf-ui--column-value (column key)
|
||
"Return KEY from COLUMN, accepting a plist or alist descriptor."
|
||
(if (and (listp column) (keywordp (car column)))
|
||
(plist-get column key)
|
||
(alist-get key column)))
|
||
|
||
(defun etaf-ui--grid-cell-value (row key)
|
||
"Return KEY from data ROW, accepting a plist, alist, or hash table."
|
||
(cond
|
||
((hash-table-p row) (gethash key row))
|
||
((and (proper-list-p row)
|
||
(zerop (% (length row) 2))
|
||
(keywordp (car row)))
|
||
(plist-get row key))
|
||
((listp row) (alist-get key row))
|
||
(t nil)))
|
||
|
||
(defun etaf-ui--grid-fit-text (value column)
|
||
"Return VALUE fitted to COLUMN's declared character capacity."
|
||
(let* ((value (format "%s" (or value "")))
|
||
(width (etaf-ui--column-value column :width)))
|
||
(if (and (integerp width) (> width 0)
|
||
(> (string-width value) width))
|
||
(truncate-string-to-width value width 0 nil "…")
|
||
value)))
|
||
|
||
(defun etaf-ui--grid-display-value (row column)
|
||
"Return one single-line display value for ROW and COLUMN.
|
||
|
||
DataGrid columns are tabular tracks, not prose paragraphs. Keep each cell on
|
||
one visual line and use an ellipsis when a fixed character-width descriptor is
|
||
too small; the original ROW remains intact for selection and callbacks."
|
||
(etaf-ui--grid-fit-text
|
||
(etaf-ui--grid-cell-value row (etaf-ui--column-value column :key))
|
||
column))
|
||
|
||
(defun etaf-ui--grid-track-width (column gap-p)
|
||
"Return COLUMN width with one native-character gap when GAP-P is non-nil."
|
||
(let ((width (etaf-ui--column-value column :width)))
|
||
(if (and gap-p (integerp width) (> width 0))
|
||
(1+ width)
|
||
width)))
|
||
|
||
(defun etaf-ui--grid-header-cell (column gap-p)
|
||
"Return one header View for COLUMN, adding air when GAP-P is non-nil."
|
||
(etaf-view
|
||
(text :class "etaf-data-grid-header-cell"
|
||
:width (etaf-ui--grid-track-width column gap-p)
|
||
(expr :value
|
||
(etaf-ui--grid-fit-text
|
||
(or (etaf-ui--column-value column :label)
|
||
(etaf-ui--column-value column :key))
|
||
column)))))
|
||
|
||
(defun etaf-ui--grid-header (columns theme)
|
||
"Return a View header row for COLUMNS using semantic THEME colors."
|
||
(etaf-view
|
||
(row :class "etaf-data-grid-header"
|
||
:border (etaf-ui--theme-border
|
||
(plist-get theme :ui-grid-border))
|
||
(expr :value
|
||
(cl-loop for column in columns
|
||
for tail on columns
|
||
collect (etaf-ui--grid-header-cell
|
||
column (cdr tail)))))))
|
||
|
||
(defun etaf-ui--grid-cell (row column gap-p)
|
||
"Return one data cell View for ROW and COLUMN, using GAP-P for air."
|
||
(etaf-view
|
||
(text :width (etaf-ui--grid-track-width column gap-p)
|
||
(expr :value (etaf-ui--grid-display-value row column)))))
|
||
|
||
(defun etaf-ui--grid-cells (row columns)
|
||
"Return data cell Views for ROW and COLUMNS."
|
||
(cl-loop for column in columns
|
||
for tail on columns
|
||
collect (etaf-ui--grid-cell row column (cdr tail))))
|
||
|
||
(defun etaf-ui--grid-selected-p (row key selected-key row-selected-p)
|
||
"Return whether ROW with KEY matches SELECTED-KEY or ROW-SELECTED-P."
|
||
(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-actions theme)
|
||
"Return a View row for ROW and COLUMNS using THEME and the DataGrid contract.
|
||
|
||
ROW-KEY returns identity; ROW-REF returns the interactive reference;
|
||
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
|
||
row key selected-key row-selected-p))
|
||
host-ref)
|
||
(unless key
|
||
(error "ETAF DataGrid row-key must return a non-nil stable scalar"))
|
||
(when interactive-p
|
||
(unless (functionp row-ref)
|
||
(error "ETAF DataGrid requires :row-ref for interactive rows"))
|
||
(setq host-ref (funcall row-ref row))
|
||
(unless host-ref
|
||
(error "ETAF DataGrid :row-ref must return a non-nil stable ref")))
|
||
(etaf-view
|
||
(row :key key
|
||
:class (concat "etaf-data-grid-row"
|
||
(if selected-p " selected" ""))
|
||
:ref host-ref
|
||
:role (when interactive-p 'button)
|
||
:tab-index (when interactive-p 0)
|
||
:border-bottom-p t
|
||
:border-bottom-color (plist-get theme :ui-grid-border)
|
||
:on-press (when interactive-p
|
||
(etaf-ui--grid-row-action
|
||
row-actions key row on-row-press))
|
||
:bgcolor (when selected-p
|
||
(plist-get theme :ui-grid-selected-bg))
|
||
(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 &optional theme)
|
||
"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* ((theme (or theme
|
||
;; A Range owns the data rows, so read Theme once here to
|
||
;; keep palette changes reactive without doing it per row.
|
||
(etaf-ui-theme-values :ui-grid-border
|
||
:ui-grid-selected-fg
|
||
:ui-grid-selected-bg)))
|
||
(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 theme))
|
||
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* ((current-callback nil)
|
||
(current-press-p nil)
|
||
(press nil))
|
||
(setq press
|
||
(lambda ()
|
||
(when current-press-p
|
||
(when current-callback
|
||
(funcall current-callback)))))
|
||
(lambda ()
|
||
(let* ((label (etaf-current-prop :label))
|
||
(callback (etaf-current-prop :on-press))
|
||
(disabled (etaf-current-prop :disabled))
|
||
(use (etaf-current-prop :use))
|
||
(press-p (and (not disabled) (or callback use))))
|
||
(setq current-callback callback
|
||
current-press-p press-p)
|
||
(let* ((variant (and (not disabled) (etaf-current-prop :variant)))
|
||
(variant-values
|
||
(etaf-ui--button-variant-values variant disabled)))
|
||
(etaf-ui--button-view
|
||
label (and press-p press) disabled (etaf-current-prop :ref)
|
||
(etaf-current-prop :class)
|
||
(or (etaf-current-prop :color)
|
||
(plist-get variant-values :color))
|
||
(or (etaf-current-prop :bgcolor)
|
||
(plist-get variant-values :bgcolor))
|
||
(or (etaf-current-prop :border)
|
||
(plist-get variant-values :border))
|
||
(etaf-current-prop :padding)
|
||
(or (etaf-current-prop :face)
|
||
(plist-get variant-values :face))
|
||
(etaf-current-prop :tab-index)
|
||
(etaf-current-prop :aria-label)
|
||
use))))))
|
||
|
||
;;;###autoload
|
||
(etaf-define-component etaf-button
|
||
(&key label on-press disabled ref class color bgcolor border padding face
|
||
tab-index aria-label use variant)
|
||
"Render a standard pressable button with LABEL and ON-PRESS.
|
||
|
||
DISABLED removes the callback and the default focus tab index. Product
|
||
appearance is controlled by VARIANT and the shared interactive surface
|
||
contract; callers can still override presentation with the ordinary props."
|
||
:styles
|
||
(styles
|
||
("&" :width max-content)
|
||
;; State classes carry semantic state only. Resolved presentation props
|
||
;; above remain authoritative, so a themed disabled Button cannot inherit
|
||
;; the catalog's light default surface.
|
||
("&.disabled" :padding (0 1) :face normal)
|
||
("&.enabled" :padding (0 1) :face bold))
|
||
:setup
|
||
(etaf-ui--button-setup))
|
||
|
||
(etaf-define-component etaf-number-input
|
||
(&key value label on-change ref disabled min max aria-label)
|
||
"Render a controlled minibuffer-backed numeric input.
|
||
|
||
VALUE is displayed as a Button. Activating it reads a number through
|
||
Emacs's native minibuffer, validates optional MIN and MAX bounds, and calls
|
||
ON-CHANGE with the accepted integer. The Component owns prompting and
|
||
validation; the caller owns the value and subsequent state write."
|
||
:setup
|
||
(let ((callback (etaf-current-prop :on-change)))
|
||
(lambda ()
|
||
(let* ((value (etaf-current-prop :value))
|
||
(label (or (etaf-current-prop :label) "Value"))
|
||
(min-value (etaf-current-prop :min))
|
||
(max-value (etaf-current-prop :max))
|
||
(disabled (etaf-current-prop :disabled))
|
||
(ref (etaf-current-prop :ref))
|
||
(aria-label (etaf-current-prop :aria-label)))
|
||
(etaf-view
|
||
(button
|
||
:label (format "%s %s ✎" label (or value "—"))
|
||
:ref ref :disabled disabled
|
||
:aria-label (or aria-label label)
|
||
:variant 'ghost
|
||
:on-press
|
||
(unless disabled
|
||
(lambda ()
|
||
(let ((next (read-number
|
||
(format "%s: " label) (or value 0))))
|
||
(unless (and (integerp next)
|
||
(or (null min-value) (>= next min-value))
|
||
(or (null max-value) (<= next max-value)))
|
||
(user-error "%s must be an integer from %s to %s"
|
||
label (or min-value "—") (or max-value "—")))
|
||
(when callback (funcall callback next)))))))))))
|
||
|
||
(defun etaf-ui--checkbox-view
|
||
(checked label on-change ref disabled class color bgcolor border padding
|
||
face tab-index aria-label)
|
||
"Return LABEL checkbox View with captured CHECKED and ON-PRESS.
|
||
REF, DISABLED, CLASS, COLOR, BGCOLOR, BORDER, PADDING, FACE, TAB-INDEX, and
|
||
ARIA-LABEL provide its semantic and presentation properties."
|
||
(etaf-view
|
||
(row
|
||
:class (etaf-ui--class-value
|
||
"etaf-checkbox" (if disabled "disabled" "enabled") class)
|
||
:role 'checkbox :ref ref :disabled disabled
|
||
:aria-label (or aria-label label)
|
||
:tab-index (unless disabled (or tab-index 0))
|
||
:color color :bgcolor bgcolor :border border :padding padding :face face
|
||
:surface-properties (etaf-ui--interactive-surface-properties label disabled)
|
||
:on-press on-change
|
||
(text :class "etaf-checkbox-mark" (expr :value (if checked "☑" "☐")))
|
||
(text (expr :value (if label (concat " " label) ""))))))
|
||
|
||
;;;###autoload
|
||
(etaf-define-component etaf-checkbox
|
||
(&key checked label on-change ref disabled class color bgcolor border padding
|
||
face tab-index aria-label)
|
||
"Render a controlled checkbox with CHECKED, LABEL, and ON-CHANGE.
|
||
|
||
ON-CHANGE receives the next boolean value. State ownership stays with the
|
||
caller, so the Component works with local refs or Data-backed forms."
|
||
:styles
|
||
(styles
|
||
("&" :width max-content)
|
||
;; Color, background, and border are resolved through the shared semantic
|
||
;; Theme map in :setup; styles keep only geometry defaults.
|
||
("&.disabled" :padding (0 1))
|
||
("&.enabled" :padding (0 1))
|
||
(".etaf-checkbox-mark" :face bold :width 1))
|
||
:setup
|
||
(let* ((current-checked nil)
|
||
(current-callback nil)
|
||
(press
|
||
(lambda ()
|
||
(when current-callback
|
||
(funcall current-callback (not current-checked))))))
|
||
(lambda ()
|
||
(let* ((theme (etaf-ui-theme-values :ui-fg :ui-bg
|
||
:ui-checkbox-enabled-fg
|
||
:ui-checkbox-enabled-bg
|
||
:ui-checkbox-enabled-border
|
||
:ui-checkbox-disabled-fg
|
||
:ui-checkbox-disabled-bg
|
||
:ui-checkbox-disabled-border))
|
||
(variant-values
|
||
(etaf-ui--checkbox-variant-values
|
||
theme (etaf-current-prop :disabled))))
|
||
(setq current-checked (etaf-current-prop :checked)
|
||
current-callback
|
||
(when (and (not (etaf-current-prop :disabled))
|
||
(etaf-current-prop :on-change))
|
||
(etaf-current-prop :on-change)))
|
||
(etaf-ui--checkbox-view
|
||
current-checked (etaf-current-prop :label)
|
||
(and current-callback press)
|
||
(etaf-current-prop :ref) (etaf-current-prop :disabled)
|
||
(etaf-current-prop :class)
|
||
(or (etaf-current-prop :color)
|
||
(plist-get variant-values :color))
|
||
(or (etaf-current-prop :bgcolor)
|
||
(plist-get variant-values :bgcolor))
|
||
(or (etaf-current-prop :border)
|
||
(plist-get variant-values :border))
|
||
(etaf-current-prop :padding) (etaf-current-prop :face)
|
||
(etaf-current-prop :tab-index) (etaf-current-prop :aria-label))))))
|
||
|
||
;;;###autoload
|
||
(etaf-define-component etaf-label
|
||
(&key text face class color bgcolor border padding ref width)
|
||
"Render TEXT as a semantic label with presentation properties."
|
||
:view
|
||
(expr
|
||
:value
|
||
(etaf-view
|
||
(text :class class :face face :color color :bgcolor bgcolor :border border
|
||
:padding padding :ref ref :width width (expr :value text)))))
|
||
|
||
(defun etaf-ui--panel-view (title class color bgcolor border padding ref)
|
||
"Render a themed Panel View.
|
||
Arguments are TITLE, CLASS, COLOR, BGCOLOR, BORDER, PADDING, and REF."
|
||
(let ((theme (etaf-ui-theme-values :ui-panel-fg :ui-panel-bg
|
||
:ui-panel-border)))
|
||
(etaf-view
|
||
(column
|
||
:class (etaf-ui--class-value "etaf-panel" nil class)
|
||
:color (or color (plist-get theme :ui-panel-fg))
|
||
:bgcolor (or bgcolor (plist-get theme :ui-panel-bg))
|
||
:border (or border
|
||
(etaf-ui--theme-border
|
||
(plist-get theme :ui-panel-border)))
|
||
:padding padding :ref ref
|
||
(expr
|
||
:value
|
||
(when title
|
||
(etaf-view (text :class "etaf-panel-title"
|
||
(expr :value title)))))
|
||
(slot :name 'header)
|
||
(slot)))))
|
||
|
||
;;;###autoload
|
||
(etaf-define-component etaf-panel
|
||
(&key title class color bgcolor border padding ref)
|
||
"Render a titled panel with header and default slot projections."
|
||
:styles
|
||
(styles
|
||
("&" :padding (1 2))
|
||
(".etaf-panel-title" :face bold))
|
||
:view
|
||
(expr :value
|
||
(etaf-ui--panel-view title class color bgcolor border padding ref)))
|
||
|
||
;;;###autoload
|
||
(etaf-define-component etaf-data-grid
|
||
(&key controller columns row-key on-row-press
|
||
row-ref selected-key row-selected-p loading-label error-label
|
||
empty-label)
|
||
"Render rows from reactive DATA CONTROLLER and COLUMNS.
|
||
|
||
COLUMNS is a list of descriptors such as `(:key :name :label NAME)'. ROW-KEY
|
||
receives each row and must return a stable scalar identity. Data owns loading,
|
||
errors, pagination, mutation, and selection; this Component only projects
|
||
those values into ordinary Hosts. Interactive rows require ROW-REF to return
|
||
a stable Host reference."
|
||
:styles
|
||
(styles
|
||
(".etaf-data-grid-header" :face bold :padding (0 1))
|
||
(".etaf-data-grid-header-cell" :face bold)
|
||
(".etaf-data-grid-row" :padding (0 1))
|
||
;; Selection color and error color are dynamic semantic props below, so
|
||
;; this Component style scope contains geometry only.
|
||
)
|
||
:setup
|
||
(let ((row-actions (make-hash-table :test #'equal)))
|
||
(lambda ()
|
||
(let* ((controller (etaf-current-prop :controller))
|
||
(columns (etaf-current-prop :columns))
|
||
(row-key (etaf-current-prop :row-key))
|
||
(row-ref (etaf-current-prop :row-ref))
|
||
(on-row-press (etaf-current-prop :on-row-press))
|
||
(selected-key (etaf-current-prop :selected-key))
|
||
(row-selected-p (etaf-current-prop :row-selected-p))
|
||
(loading-label (etaf-current-prop :loading-label))
|
||
(error-label (etaf-current-prop :error-label))
|
||
(empty-label (etaf-current-prop :empty-label))
|
||
;; Resolve the shared semantic UI Theme once at the DataGrid
|
||
;; boundary. Rows reuse this immutable snapshot instead of
|
||
;; allocating or resolving border values independently during
|
||
;; every retained Range update.
|
||
(raw-theme (etaf-ui-theme-values :ui-fg
|
||
:ui-grid-border
|
||
:ui-grid-selected-bg))
|
||
(theme (plist-put (copy-sequence raw-theme)
|
||
:ui-grid-border
|
||
(etaf-ui--theme-border
|
||
(plist-get raw-theme :ui-grid-border))))
|
||
(theme-color (plist-get theme :ui-fg)))
|
||
(etaf-view
|
||
(column
|
||
:class "etaf-data-grid" :color theme-color
|
||
(expr :value (etaf-ui--grid-header
|
||
columns theme))
|
||
(column
|
||
:class "etaf-data-grid-body"
|
||
(expr
|
||
:value
|
||
(progn
|
||
(unless (functionp row-key)
|
||
(error "ETAF DataGrid requires a function-valued :row-key"))
|
||
(when (and on-row-press (not (functionp on-row-press)))
|
||
(error "ETAF DataGrid :on-row-press must be a function"))
|
||
(when (and on-row-press (not (functionp row-ref)))
|
||
(error "ETAF DataGrid requires :row-ref for interactive rows"))
|
||
(when (and row-selected-p (not (functionp row-selected-p)))
|
||
(error "ETAF DataGrid :row-selected-p must be a function"))
|
||
(let ((status (etaf-value (etaf-data-status controller)))
|
||
(items (etaf-value (etaf-data-items controller))))
|
||
(cond
|
||
((eq status 'loading)
|
||
(etaf-view
|
||
(text (expr :value (or loading-label "Loading...")))))
|
||
((eq status 'error)
|
||
(etaf-view
|
||
(text :class "etaf-data-grid-error"
|
||
:color (plist-get (etaf-ui-theme-values
|
||
:ui-grid-error-fg)
|
||
:ui-grid-error-fg)
|
||
(expr :value
|
||
(or error-label "Unable to load data.")))))
|
||
((null items)
|
||
(etaf-view
|
||
(text (expr :value (or empty-label "No data.")))))
|
||
(t
|
||
;; Read Theme inside this Range's evaluator so retained row
|
||
;; Hosts follow palette changes without requiring the parent
|
||
;; DataGrid Component to be rebuilt.
|
||
(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
|
||
(&key controller previous-ref next-ref class color bgcolor border padding
|
||
aria-label)
|
||
"Render a compact, accessible pager for DATA CONTROLLER.
|
||
|
||
The pager owns no data state: page, page-size, total, loading, and error stay
|
||
with CONTROLLER. PREVIOUS-REF and NEXT-REF should be stable public refs when
|
||
the pager participates in keyboard/mouse interaction. The visible glyphs
|
||
(`←' and `→') are paired with labels and help text so the compact control is
|
||
readable in both GUI and text review."
|
||
:styles
|
||
(styles
|
||
("&" :width stretch)
|
||
(".etaf-pagination-label" :face bold))
|
||
:setup
|
||
(let* ((current-controller nil)
|
||
(previous
|
||
(lambda ()
|
||
(when current-controller
|
||
(etaf-data-previous-page current-controller))))
|
||
(next
|
||
(lambda ()
|
||
(when current-controller
|
||
(etaf-data-next-page current-controller)))))
|
||
(lambda ()
|
||
(let* ((controller-value (etaf-current-prop :controller))
|
||
(page (max 1 (or (etaf-value (etaf-data-page controller-value)) 1)))
|
||
(page-size (max 1 (or (etaf-value (etaf-data-page-size controller-value)) 1)))
|
||
(total (max 0 (or (etaf-value (etaf-data-total controller-value)) 0)))
|
||
(pages (max 1 (ceiling (/ (float total) page-size))))
|
||
(status (etaf-value (etaf-data-status controller-value)))
|
||
(first-item (if (zerop total) 0 (1+ (* (1- page) page-size))))
|
||
(last-item (min total (* page page-size)))
|
||
(previous-disabled (or (eq status 'loading) (<= page 1)))
|
||
(next-disabled (or (eq status 'loading) (>= page pages)))
|
||
(theme (etaf-ui-theme-values :ui-fg :ui-bg
|
||
:ui-disabled-fg
|
||
:ui-pagination-muted-fg))
|
||
(parent-color (or (etaf-current-prop :color)
|
||
(plist-get theme :ui-fg)))
|
||
(parent-bgcolor (or (etaf-current-prop :bgcolor)
|
||
(plist-get theme :ui-bg)))
|
||
(arrow-border '((0) solid "transparent")))
|
||
(setq current-controller controller-value)
|
||
(etaf-view
|
||
(flex :class (etaf-ui--class-value "etaf-pagination" nil
|
||
(etaf-current-prop :class))
|
||
:width 'stretch
|
||
:flex-direction 'row
|
||
:align-items 'center
|
||
:role 'navigation
|
||
:aria-label (or (etaf-current-prop :aria-label) "Pagination")
|
||
:color parent-color
|
||
:bgcolor parent-bgcolor
|
||
:border (etaf-current-prop :border)
|
||
:box-sizing 'border-box
|
||
:padding (or (etaf-current-prop :padding) '(0 1))
|
||
:gap '(0 (1))
|
||
(column :width 'max-content
|
||
:flex-grow 0 :flex-shrink 0 :flex-basis 'auto
|
||
(button :label "←" :ref (etaf-current-prop :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)
|
||
:bgcolor parent-bgcolor
|
||
:face 'bold
|
||
:on-press (unless previous-disabled previous)))
|
||
(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
|
||
:color (plist-get theme :ui-pagination-muted-fg)
|
||
(expr :value (format "%d–%d of %d"
|
||
first-item last-item total))))
|
||
(column :width 'max-content
|
||
:flex-grow 0 :flex-shrink 0 :flex-basis 'auto
|
||
(button :label "→" :ref (etaf-current-prop :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)
|
||
:bgcolor parent-bgcolor
|
||
:face 'bold
|
||
:on-press (unless next-disabled next)))))))))
|
||
|
||
(provide 'etaf-ui)
|
||
|
||
;;; etaf-ui.el ends here
|