From dcb0ad9d83470f4ef9e995ff8a9c20b4ca20e7db Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sat, 22 Aug 2026 08:21:26 +0800 Subject: [PATCH] Replace console demo with SQLite Research Shelf --- DESIGN.md | 176 ++++--- DESIGN.zh-CN.md | 132 +++-- Makefile | 17 +- README.md | 15 +- README.zh-CN.md | 12 +- design/operations-console.html | 211 -------- design/research-shelf.html | 138 +++++ etaf-playground-catalog.el | 30 ++ etaf-playground.el | 159 +++--- examples/operations-console.el | 756 ---------------------------- examples/operations-console.etaf | 29 -- examples/research-shelf.el | 542 ++++++++++++++++++++ examples/research-shelf.etaf | 16 + scripts/benchmark-research-shelf.el | 87 ++++ tests/etaf-playground-tests.el | 531 +++++++------------ 15 files changed, 1293 insertions(+), 1558 deletions(-) delete mode 100644 design/operations-console.html create mode 100644 design/research-shelf.html create mode 100644 etaf-playground-catalog.el delete mode 100644 examples/operations-console.el delete mode 100644 examples/operations-console.etaf create mode 100644 examples/research-shelf.el create mode 100644 examples/research-shelf.etaf create mode 100644 scripts/benchmark-research-shelf.el diff --git a/DESIGN.md b/DESIGN.md index 68f5f54..b197f5c 100644 --- a/DESIGN.md +++ b/DESIGN.md @@ -2,104 +2,156 @@ ## Source of truth -- Status: Active draft for the sole reviewed pair -- Last refreshed: 2026-08-20 -- Primary product surface: `examples/operations-console.etaf` + `examples/operations-console.el` -- Visual reference: `design/operations-console.html` -- Evidence reviewed: current pair loader/manifest, `etaf-ui.el`, Ebox viewport contract, and the current GUI/performance evidence. +- Status: Active +- Last refreshed: 2026-08-22 +- Primary product surface: `examples/research-shelf.etaf` + `examples/research-shelf.el` +- Visual reference: `design/research-shelf.html` +- Evidence reviewed: ETAF public View/Component/Data/Resource APIs, `etaf-ui` + Button/Checkbox/Panel/DataGrid/Pagination, and `etaf-sqlite`'s typed source + contract. ## Brand -- Personality: calm operations cockpit; precise, warm, and quietly technical. -- Trust signals: explicit status chips, visible last-updated time, deterministic counts, clear success/error feedback. -- Avoid: generic toy dashboard, rainbow gradients, dense ungrouped controls, decorative widgets with no semantic state. +- Personality: editorial, focused, warm, quietly intelligent. +- Trust signals: durable SQLite data, visible save state, selected-item detail, + explicit progress/status, and recoverable storage errors. +- Avoid: generic admin dashboards, KPI walls, fake charts, rainbow gradients, + and a showcase that exists only to exercise APIs. ## Product goals -- Make one attractive app prove ETAF's Component, composition, reactive, Context/Theme, Behavior, event/Action, Data, Resource, error-boundary, focus, and lifecycle contracts. -- Do not add another Playground scenario or hide framework limitations behind fake animation. -- Keep the HTML prototype and ETAF rendering aligned in hierarchy, state labels, interaction outcomes, and compact/fullscreen geometry. +- Build a useful personal reading/research shelf backed by a real SQLite file. +- Make triage, selection, progress updates, filtering, pagination, and + recovery feel like one coherent product rather than isolated demos. +- Exercise existing ETAF components through composition before adding any new + component type. +- Keep the static `.etaf` file responsible for shell/section composition while + the `.el` companion owns storage, state, callbacks, and lifecycle. ## Personas and jobs -- Primary personas: ETAF framework reviewer and application author learning the public API. -- User jobs: understand the layout model, trigger each capability, inspect visible state changes, and verify recovery/cleanup behavior. -- Key contexts: 900–940 px compact GUI, fullscreen GUI, keyboard-only review, and batch semantic tests. +- Primary persona: an Emacs user collecting papers, books, essays, and notes. +- Jobs: find what to read next, filter by state/priority, inspect one item, + update progress, mark an item finished, and recover after a storage error. +- Contexts: compact desktop window, fullscreen review, keyboard-first use, and + a local SQLite database that survives unmount/remount. ## Information architecture -- Shell: brand/header -> navigation tabs -> page surface -> persistent status footer. -- Overview: hero/status strip, KPI cards, activity/control workspace, capability cards, and event timeline. -- Data: query/selection summary, interactive DataGrid, and selection detail panel. -- Resource: resource status, reload/fail-next controls, boundary result, and cleanup counter. -- Content hierarchy: page title and status first; primary action second; diagnostics/details third. +- Shell: compact brand bar -> filter rail -> reading list -> detail inspector. +- Filter rail: All, In progress, Unread, Finished, and Starred; each is a real + action and the list summary exposes the matching count. +- Reading list: title/author/status/progress rows, single selection, paging, + empty/loading/error states. +- Detail inspector: title, author, type, status, progress, priority, note, + last updated, and actions (`+10%`, `Finish`, `Star`, `Archive`). +- Footer: database path/status, visible result count, and current page. ## Design principles -1. One visual hierarchy: every control belongs to a named surface and every surface has a visible status. -2. State before decoration: theme, loading, error, selected, disabled, and success states are readable as text as well as color. -3. Stable geometry: controls remain single-line at compact width; page changes replace only the page surface. -4. Public API truth: the prototype may use ordinary HTML/JS, but the ETAF port uses only public ETAF/ETAF-UI APIs. +1. One useful workflow: every visible control helps decide or update what to + read next. +2. Editorial hierarchy over dashboard chrome: one strong title, restrained + metadata, and generous whitespace around the selected record. +3. State is durable and observable: SQLite is the source of truth; UI status + tells the user when a mutation is loading, saved, or failed. +4. Composition first: reuse public UI Components and keep storage/state in the + companion, not in `.etaf` or a parallel widget layer. +5. Fail closed: a SQLite failure keeps the last usable list and exposes a + retry action instead of replacing the whole surface with a stack trace. ## Visual language -- Color: ink navy `#142235`, paper `#F6F1E8`, slate `#526174`, teal `#2E8B83`, coral `#E26D5A`, amber `#D99A3D`, success `#3E9B72`. -- Typography: readable sans body, compact monospace labels/metrics, bold page titles. -- Spacing/layout rhythm: one-line outer rhythm, two-column workspace, fixed gaps, full-width shell, deliberate card padding. -- Shape/elevation: thin dark borders and restrained card elevation; no floating overlay is required by the ETAF port. -- Motion: no animation is required; state changes are immediate and reduced-motion safe. -- Imagery/iconography: text marks and Unicode status glyphs only; no external asset dependency. +- Color: ink `#172033`, paper `#F7F3EA`, cobalt `#3657D6`, mint `#3E9B8F`, + coral `#D86B5D`, amber `#C58A3A`, muted slate `#6D7482`. +- Typography: readable proportional labels with compact monospace metadata; + title and selected record use bold weight, not oversized headings. +- Spacing/layout rhythm: 1-cell outer rhythm, 2-cell panel padding, 1-cell + grid gaps, and stable intrinsic control widths. +- Shape/elevation: thin borders, small radius-like grouped rows where Ebox + permits, no floating overlays or decorative shadows. +- Motion: immediate state changes; no timer-driven animation; reduced-motion + safe by construction. +- Imagery/iconography: Unicode marks with semantic meaning: `⌕`, `★`, `✓`, + `◷`, `↗`, `⚠`, and `·`. ## Components -- Existing components to reuse: public `button`, `checkbox`, `label`, `panel`, and `data-grid` from `etaf-ui`. -- New/changed components: `operations-console-shell`, `hero-status`, `metric-strip`, `activity-card`, `capability-card`, `timeline`, `data-page`, and `resource-page` in the companion. -- Variants/states: active/inactive nav, light/dark theme, selected/unselected row, Behavior on/off, resource ready/loading/error, boundary handled, compact/fullscreen. -- Ownership: `.etaf` owns static composition and section names; `.el` owns tokens, props, refs, resources, handlers, and state. +- Existing components to reuse: public `button`, `checkbox`, `label`, `panel`, + `data-grid`, and `pagination` from `etaf-ui`. +- Companion composition: `research-shelf-shell`, `filter-rail`, + `reading-list`, and `detail-inspector`; these are ordinary ETAF Components, + not a second UI kit. +- Variants/states: light/dark Theme, selected/unselected row, starred, empty, + loading, error, saved, disabled-at-boundary, and archived. +- Token ownership: palette and spacing tokens live in the companion; `.etaf` + contains only validated structural facts and labels. + +## Playground framework boundary + +- `etaf-playground.el` is a reusable framework, not an application module. +- The framework owns pair registration semantics, safe inert `.etaf` parsing, + companion loading, mount/reset/close, and test/GUI entry points. Replaceable + deployment metadata lives in `etaf-playground-catalog.el`, outside the + loader implementation. +- A pair companion owns its Components, storage adapters, state, resources, + events, and root factory. The framework must not reference a business + component, database package, table schema, palette, or application-specific + ref. +- Reuse is expressed through the generic manifest/loader contract and the + existing public ETAF/etaf-ui components. New business behavior belongs in a + same-basename pair, never in the framework. +- Any future Playground example must add a catalog entry and its own `.etaf`/ + `.el` files without changing framework semantics. ## Accessibility -- Target: keyboard-complete, high-contrast text, semantic roles through public UI components. -- Keyboard/focus: Tab and Shift-Tab traverse nav/actions/data rows; RET dispatches the focused ref; focus clears when a target is removed. -- Every state has text feedback; color is never the only signal. No hover-only behavior. -- Ebox Theme carries inherited Ebox defaults; application palette lookups remain - in the companion, while the Renderer filters unknown token names before they - reach Ebox geometry. +- Target: keyboard-complete and high-contrast desktop UI. +- Keyboard/focus: Tab order follows filters -> rows -> detail actions -> pager; + RET dispatches the focused public ref; selected row is announced in text. +- Color is never the only state signal; status uses text and Unicode marks. +- Disabled actions remain visible with disabled semantics and explanatory help. ## Responsive behavior -- Supported surfaces: compact 900–940 px GUI body and fullscreen desktop GUI. -- Metric cards remain in one row when possible; workspace falls back from two columns to stacked sections; controls keep intrinsic single-line widths. -- Use `flex` for rows that distribute remaining width; reserve `row` for fixed - intrinsic control groups. The navigation control group is max-content so - each hover/active range remains an independent control. -- Mouse-1 and keyboard activation use the same public refs. +- Wide/fullscreen: three-column grid (rail / list / detail). +- Compact: rail becomes a top filter row, detail follows the list, and all + controls remain intrinsic single-line widths. +- Use `grid` for the product skeleton, `flex` for toolbars and action groups, + and `row` only for compact intrinsic controls. ## Interaction states -- Loading: resource card reports `Loading…` without moving the shell. -- Empty: DataGrid reports an explicit empty state and keeps selection controls available. -- Error: resource reload can fail once; the boundary card reports the handled error and recovery remains available. -- Success: action/status and timestamp update visibly. -- Disabled: unavailable actions expose disabled semantics rather than silently ignoring input. +- Loading: list keeps its frame and shows `◷ Loading library…`. +- Empty: selected filter explains why there are no matches and offers `All`. +- Error: storage card shows `⚠ Could not save` with `Retry`; last committed + data remains visible. +- Success: mutation shows `✓ Saved locally` and updates `updated` metadata. +- Disabled: `Finish` is disabled for finished records; `+10%` is disabled at + 100%; archive is disabled while loading. ## Content voice -- Tone: concise, operational, and explanatory; labels name the framework capability being demonstrated. -- Terminology: use `Component`, `Context`, `Theme`, `Behavior`, `Action`, `Data`, `Resource`, and `Boundary` consistently. -- Microcopy: prefer a visible verb + result (`Reload resource`, `Handled: …`, `Selected Beacon`) over generic `Done`. +- Tone: concise, observant, and useful; never framework-centric in primary UI. +- Terminology: Reading, In progress, Finished, Starred, Saved locally, + Storage issue. +- Microcopy: action + result (`Mark finished`, `Saved locally`) instead of + generic `Done`. ## Implementation constraints -- Framework/styling: ETAF public View DSL in `.etaf`/`.el`; Ebox renders the result; no HTML/CSS runtime dependency. -- Design tokens: keep palette/spacing tokens in one companion source and reuse them; no scattered ad-hoc colors. -- Performance: ordinary warm p50 <=100 ms, counter/resource p50 <=150 ms, every measured max <=250 ms; one publication per logical action. -- Compatibility: preserve one same-basename `operations-console` pair, safe static reader, public API boundary, mount twice/unmount cleanup, and manifest refs. -- Navigation: the stable page ref is read by the retained router Component; its - page Host is the single semantic Range anchor, so page switches replace one - Range payload instead of rebuilding the shell root. -- Review: HTML is the visual reference; ETAF needs compact/fullscreen screenshots and dynamic keyboard/mouse checkpoints. +- Framework/styling: public ETAF View DSL and `etaf-ui`; SQLite through the + sibling `etaf-sqlite` package; no HTML/CSS runtime dependency. +- Data schema: one typed `reading_items` SQLite table with id/title/author/ + kind/status/progress/priority/starred/note/updated columns. +- Performance: one Data mutation -> one Runtime generation/publication; normal + warm actions remain under the existing 100ms p50 target. +- Compatibility: one same-basename `research-shelf` pair only; old console + examples are removed from the active manifest and compile surface. +- Verification: SQLite temp-file integration tests, pair mount/remount tests, + repeated selection/mutation tests, and clean fullscreen GUI screenshots. ## Open questions -- [ ] User review may adjust palette or page naming after the first HTML/ETAF comparison; behavior and public-ref coverage remain fixed. +- [ ] User may rename the product after reviewing the first HTML/ETAF render; + architecture and interaction contracts remain unchanged. diff --git a/DESIGN.zh-CN.md b/DESIGN.zh-CN.md index d4576d8..dac8911 100644 --- a/DESIGN.zh-CN.md +++ b/DESIGN.zh-CN.md @@ -2,94 +2,80 @@ ## 来源与状态 -- 状态：唯一 reviewed pair 的 active draft -- 更新日期：2026-08-20 -- 主产品面：`examples/operations-console.etaf` + `examples/operations-console.el` -- 视觉参考：`design/operations-console.html` -- 已审查证据：pair loader/manifest、`etaf-ui.el`、Ebox viewport 合同及当前 GUI/性能证据。 +- 状态：active +- 更新日期：2026-08-22 +- 主产品面：`examples/research-shelf.etaf` + `examples/research-shelf.el` +- HTML 视觉基线：`design/research-shelf.html` +- 已审查：ETAF View/Component/Data API、`etaf-ui` 的公开组件，以及 + `etaf-sqlite` 的 typed source 合同。 -## 品牌 +## 产品定位 -- 气质：安静的操作控制台；准确、温暖、克制地体现技术感。 -- 信任信号：状态 chip、更新时间、明确计数、清晰的成功/错误反馈。 -- 避免：普通玩具 dashboard、彩虹渐变、无语义状态的装饰控件和杂乱控制区。 +Research Shelf 是一个真正有用的本地研究/阅读架：SQLite 保存书籍、论文、 +文章和笔记，用户可以筛选、分页、选择一条记录、更新进度、完成、收藏和归档。 +它不是把 API 名称堆成控制台，而是用一个连贯 workflow 验证 ETAF 的组合能力。 -## 产品目标 +## 结构与分层 -- 用一个好看的 app 同时展示 Component、组合、响应式、Context/Theme、Behavior、事件/Action、Data、Resource、错误边界、焦点和生命周期。 -- 不扩展第二个 Playground 场景，不伪装成完整生产分析产品，不用假动画掩盖框架问题。 -- HTML 原型和 ETAF 实现保持同一层级、状态文字、交互结果和 compact/fullscreen 几何。 +- Shell：标题/副标题/主题切换 → 三列 workspace → 持久化状态栏。 +- 三列 workspace：筛选栏 / SQLite reading list / selected-item detail inspector。 +- `.etaf`：只保存经过白名单校验的静态结构和文案（section、filter、label）。 +- 同名 `.el`：消费 `.etaf`，组合公开 UI Components，创建 SQLite schema、Data + Controller、refs、事件处理和生命周期清理。 +- 现有可复用组件：`button`、`checkbox`、`label`、`panel`、`data-grid`、 + `pagination`；应用只负责把它们组合成产品，不复制一套 UI kit。 -## 信息架构 +## Playground 框架边界（必须长期遵守） -- Shell：品牌/header → 导航 tabs → page surface → 持久 status footer。 -- Overview：hero/status、KPI 卡片、活动/控制 workspace、能力卡片和事件时间线。 -- Data：选择摘要、可交互 DataGrid、selection detail。 -- Resource：资源状态、reload/fail-next、boundary 结果和 cleanup 计数。 -- 层级：先显示页面标题和状态，再显示主操作，最后显示诊断/细节。 +`etaf-playground.el` 是通用 pair playground 框架，不是业务应用模块。 +`etaf-playground-catalog.el` 是独立、可替换的部署目录；业务 pair 的名字、refs +和验证元数据放在 catalog，不写进 loader 实现。 -## 设计原则 +框架只负责： -1. 一个视觉层级：每个控件属于有名字的 surface，每个 surface 都有可见状态。 -2. 状态优先于装饰：theme、loading、error、selected、disabled、success 都有文字表达。 -3. 几何稳定：compact 下控件保持单行，页面只替换 page surface。 -4. API 真实：HTML 可以用普通 HTML/JS，但 ETAF 只用公开 ETAF/ETAF-UI API。 +- pair 注册语义和 catalog 读取； +- `.etaf` 的惰性、inert、白名单读取； +- 按同名 pair 加载 companion； +- mount、reset、close，以及测试/GUI 入口。 + +框架绝不负责：业务 Component、数据库包或表结构、palette、业务 state、 +handlers、resources 或应用 refs。它不能 `require etaf-sqlite`，也不能把业务 +组件实现塞进 loader/helper。未来新增例子时，只增加一个同名 `.etaf`/`.el` pair +和 catalog entry，不改变框架语义。 + +组合和复用是默认设计：优先复用 ETAF/`etaf-ui` 的公开契约，优先拆出清晰的 +Component 边界，避免新增 helper 层或抽象泄漏。 ## 视觉语言 -- 色彩：墨蓝 `#142235`、纸张 `#F6F1E8`、灰蓝 `#526174`、青绿 `#2E8B83`、珊瑚 `#E26D5A`、琥珀 `#D99A3D`、成功绿 `#3E9B72`。 -- 字体：易读 sans body，紧凑 monospace 指标/标签，粗体页面标题。 -- 节奏：一行外部节奏、双列 workspace、固定 gap、shell 全宽，卡片有明确内边距。 -- 形状：细深色边框、克制 elevation；ETAF 不依赖浮层。 -- 动效：不以动画为正确性前提，状态变化即时且支持 reduced motion。 -- 图形：只用文字标记和 Unicode 状态符号，不依赖外部资源。 +- 气质：editorial、专注、温暖、安静而聪明；避免通用 admin dashboard、KPI + 墙、假图表、彩虹渐变和装饰性噪声。 +- 色彩：ink `#172033`、paper `#F7F3EA`、cobalt `#3657D6`、mint `#3E9B8F`、 + coral `#D86B5D`、amber `#C58A3A`、muted `#6D7482`。 +- 节奏：1 格外部节奏、2 格 panel padding、1 格 grid gap，控件保持 intrinsic + 宽度；`grid` 负责页面骨架，`flex` 负责 toolbar/action group。 +- 状态：文字和 Unicode 同时表达状态：`⌕`、`★`、`✓`、`◷`、`↗`、`⚠`、`·`。 +- 动效：状态立即可见，不依赖 timer animation，默认支持 reduced motion。 -## 组件 +## 交互合同 -- 复用公开 `button`、`checkbox`、`label`、`panel`、`data-grid`。 -- companion 组件：`operations-console-shell`、`hero-status`、`metric-strip`、`activity-card`、`capability-card`、`timeline`、`data-page`、`resource-page`。 -- 状态：active/inactive nav、light/dark theme、selected/unselected row、Behavior on/off、resource ready/loading/error、boundary handled、compact/fullscreen。 -- 所有权：`.etaf` 只放静态 composition 和 section 名称；`.el` 持有 token、props、refs、资源、handlers 和 state。 +- 筛选：All、In progress、Unread、Finished、Starred。 +- 列表：DataGrid 行单选，重复点击可以重新选择；分页按钮在边界处 disabled。 +- 详情：`+ 10%`、`✓ Finish`、`☆/★ Star`、`Archive`；完成或 100% 时正确禁用。 +- 存储：成功显示 `✓ Saved locally`，失败保留当前可用内容并提供 Reload。 +- 主题：Light/Dark 由 checkbox 控制；文字、对比度和布局都应保持可读。 +- 键盘：Tab 顺序为筛选 → 行 → 详情动作 → 分页，RET 使用同一组公开 refs。 -## 无障碍 +## 响应式与验证 -- 目标：键盘完整、高对比文字，使用公开组件提供语义 role。 -- Tab/Shift-Tab 遍历 nav/action/data rows；RET 派发 focused ref；移除目标时清焦点。 -- 每个状态都有文字反馈，颜色不是唯一信号；不依赖 hover-only 行为。 -- Ebox Theme 承载继承的 Ebox 默认属性；应用 palette 仍由 companion 查询， - Renderer 会在进入 Ebox 几何层前过滤未知 token 名。 - -## 响应式 - -- 支持 compact 900–940px body 和 fullscreen desktop GUI。 -- metric 尽量一行展示，workspace 从双列退化为上下堆叠，控件保持 intrinsic 单行宽度。 -- 需要分配剩余宽度的行使用 `flex`，固定 intrinsic 控件组才使用 `row`；导航 - 控件组使用 max-content，确保每个 hover/active 区域都是独立控件。 -- mouse-1 和键盘激活使用同一组公开 refs。 - -## 交互状态 - -- Loading：Resource 显示 `Loading…`，shell 几何不移动。 -- Empty：DataGrid 明确显示 empty，选择控件仍可用。 -- Error：reload 可故意失败一次，Boundary 显示 handled error 且仍可恢复。 -- Success：action/status 和 timestamp 可见更新。 -- Disabled：不可用操作暴露 disabled 语义，不静默吞输入。 - -## 内容语气 - -- 简洁、操作化、解释性；标签明确指出正在展示的框架能力。 -- 统一使用 `Component`、`Context`、`Theme`、`Behavior`、`Action`、`Data`、`Resource`、`Boundary`。 -- 优先“动词 + 结果”（如 `Reload resource`、`Handled: …`、`Selected Beacon`）。 - -## 实现约束 - -- 使用 `.etaf`/`.el` 的公开 ETAF View DSL，由 Ebox 渲染，不引入 HTML/CSS runtime dependency。 -- palette/spacing token 在 companion 单处定义并复用，禁止散落临时色值。 -- 性能：普通 warm p50 <=100ms，counter/resource p50 <=150ms，每个 warm max <=250ms；每个逻辑动作一次 publication。 -- 保留唯一同名 `operations-console` pair、静态安全读取、公开 API boundary、双 mount/unmount cleanup 和 manifest 语义。 -- 导航：稳定的 page ref 由 retained router Component 读取；页面 Host 是唯一 semantic Range 锚点，页面切换只替换一个 Range payload，不重建 shell root。 -- HTML 是视觉参考；ETAF 需要 compact/fullscreen 截图和动态键鼠 checkpoint 证明布局、宽度、焦点和状态。 +- Wide/fullscreen 使用 rail / list / detail 三列 grid。 +- Compact 时筛选栏收为顶部工具行，detail 位于 list 后面；不使用固定宽度撑坏 + viewport，所有操作控件仍保持独立 hover/focus 语义。 +- 用 SQLite 临时文件测试 mount/remount、筛选、分页、重复选行、mutation、错误 + 状态和 cleanup；GUI 用干净 fullscreen 单窗口截图验证真实布局。 +- 目标：一次 Data mutation 对应一次 Runtime generation/publication；warm 交互 + 维持现有 100ms p50 预算。 ## 待 review -- [ ] 用户可在第一版 HTML/ETAF 对照后调整 palette 或页面命名；行为和公开 ref 覆盖保持不变。 +- [ ] 用户可调整产品命名或 palette；pair 边界、组合/复用原则和公开交互合同不变。 diff --git a/Makefile b/Makefile index 42cc905..89ea2c8 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ EMACS ?= emacs -LOAD_PATH = -L . -L ../etaf -L ../etaf-ui -L ../ebox -L ../ecss -L ../tp -EXAMPLE_EL := examples/operations-console.el +LOAD_PATH = -L . -L ../etaf -L ../etaf-ui -L ../ebox -L ../ecss -L ../tp -L ../etaf-sqlite +EXAMPLE_EL := examples/research-shelf.el -.PHONY: all compile examples-read test check checkdoc load clean +.PHONY: all compile examples-read test perf check checkdoc load clean all: check @@ -15,29 +15,36 @@ compile: $(MAKE) -C ../ebox compile EMACS="$(EMACS)" ECSS_DIR=../ecss TP_DIR=../tp $(MAKE) -C ../etaf compile EMACS="$(EMACS)" $(MAKE) -C ../etaf-ui compile EMACS="$(EMACS)" + $(MAKE) -C ../etaf-sqlite compile EMACS="$(EMACS)" rm -f *.elc tests/*.elc examples/*.elc $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ --eval '(load-file "etaf-playground.el")' \ --eval '(dolist (file (quote ($(foreach file,$(EXAMPLE_EL),"$(file)")))) (byte-compile-file file))' \ + --eval '(byte-compile-file "etaf-playground-catalog.el")' \ --eval '(byte-compile-file "etaf-playground.el")' \ --eval '(byte-compile-file "tests/etaf-playground-tests.el")' examples-read: compile $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ --eval '(require (quote etaf-playground))' \ - --eval '(etaf-playground-read-pair "operations-console")' \ + --eval '(load-file "examples/research-shelf.el")' \ + --eval '(let ((database (make-temp-file "etaf-playground-read-" nil ".sqlite")) (buffer " *etaf-playground-read*")) (unwind-protect (let ((etaf-research-shelf-database-file database)) (etaf-playground-mount-example buffer "research-shelf")) (etaf-playground-close buffer) (when (file-exists-p database) (delete-file database))))' \ --eval '(princ "ETAF example modules load OK\\n")' test: examples-read $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ -l tests/etaf-playground-tests.el -f ert-run-tests-batch-and-exit +perf: compile + $(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \ + -l scripts/benchmark-research-shelf.el + load: compile $(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-playground))' \ --eval '(princ "etaf-playground load OK\\n")' checkdoc: - $(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (list "etaf-playground.el" "tests/etaf-playground-tests.el" "examples/operations-console.el")) (checkdoc-file file)))' + $(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (list "etaf-playground.el" "etaf-playground-catalog.el" "tests/etaf-playground-tests.el" "examples/research-shelf.el" "scripts/benchmark-research-shelf.el")) (checkdoc-file file)))' check: checkdoc test diff --git a/README.md b/README.md index 7f27943..849651b 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,16 @@ # ETAF Playground The Playground exposes one canonical product example: the -`examples/operations-console.etaf` and `examples/operations-console.el` pair. +`examples/research-shelf.etaf` and `examples/research-shelf.el` pair. -The `.etaf` file is inert, validated static composition data. The companion -owns Components, state, Context, Theme, Behaviors, Data, Resources, Actions, -and lifecycle. `etaf-playground-open`, `etaf-playground-reset`, and -`etaf-playground-close` are the only mounting boundary. +The `.etaf` file is inert, validated structural composition data. The same- +basename companion owns Components, state, theme, storage, events, and +lifecycle. `etaf-playground.el` is a reusable pair framework: it owns only +registration, safe loading, mounting, reset, close, and verification entry +points. `etaf-playground-catalog.el` is the replaceable deployment catalog; +business Components, database schemas, palettes, refs, and handlers +must stay in the companion. Compose and reuse public ETAF/`etaf-ui` contracts +before adding abstractions. Run `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`. +Run `make perf` for the 1413×62 warm row-selection/theme latency gate. diff --git a/README.zh-CN.md b/README.zh-CN.md index a65b7fe..d071679 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -1,10 +1,14 @@ # ETAF Playground Playground 只公开一个标准产品示例： -`examples/operations-console.etaf` 与 `examples/operations-console.el` 配对。 +`examples/research-shelf.etaf` 与 `examples/research-shelf.el` 配对。 -`.etaf` 是只读、经过白名单验证的静态组合数据；同名 companion 负责 -Component、状态、Context、Theme、Behavior、Data、Resource、Action 与生命周期。 -`etaf-playground-open/reset/close` 是唯一挂载边界。 +`.etaf` 是惰性、inert、经过白名单验证的静态结构数据；同名 companion 负责 +Component、状态、主题、SQLite、事件与生命周期。`etaf-playground.el` 是通用 +pair playground 框架，只负责注册、白名单读取、加载、mount/reset/close 和验证 +入口；`etaf-playground-catalog.el` 是可替换的部署目录。业务 Component、数据库 +schema、palette、refs 与 handlers 不能泄漏进框架。 +默认原则是组合和复用公开 ETAF/`etaf-ui` 契约，而不是再造一套组件或 helper 抽象。 验证命令：`make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。 +性能门禁：`make perf`（1413×62 viewport 的 warm 选行/主题延迟）。 diff --git a/design/operations-console.html b/design/operations-console.html deleted file mode 100644 index 2d17b23..0000000 --- a/design/operations-console.html +++ /dev/null @@ -1,211 +0,0 @@ - - - - - - ETAF Operations Console — visual prototype - - - -
-
-
OC
ETAF / reference workspaceOperations Console
-
All systems nominal
-
- -
-
-

Tuesday / 09:42 / live review

Make complex state feel calm.

A single surface for components, context, behavior, data, and recovery — designed to make every ETAF update visible and explainable.

-
Throughput
2.4k
↑ 18% this week
Active flows
18
+3 since 08:00
Response
42ms
p95 within target
Reliability
99.8%
steady
-

Activity stream

Reactive events, rendered as a readable story.

4 events
↗
Theme provider promotedContext defaults were refreshed without losing focus.
09:41
◆
Counter alpha crossed 2kOne Component-owned update, one visible publication.
09:36
✓
Resource boundary recoveredHandled failure left the shell and routes intact.
09:28

Capability map

What this surface is proving.

ETAF
✓
Component ownershipProps, slots, setup state, and retained identity.
✓
Context + ThemeProvider defaults, dark mode, and explicit feedback.
✓
Behavior + ActionsKeyboard-ready interactions with stable refs.
✓
Data + ResourceSelection, loading, failure, boundary, and cleanup.
-

Event trail

Every meaningful action leaves a compact, inspectable trace.

Surface mounted

Operations Console is ready for review.

Data controller loaded

3 records are available in the Data desk.

-
-
Data desk / a small table with real selection state
No row selected
IDNAMESTATUSOWNER
Select a row to inspect it.Selection updates the status without rebuilding the shell.
-

Resource lab

Loading, failure, recovery, and cleanup are first-class states.

ready
Loaded value 7Owned by the current application mount.

Error boundary

Failure is handled in place.

safe
No boundary run yet

Run the boundary to see a handled error while the rest of the application stays mounted.

Lifecycle ledger

Resource cleanup is visible, not inferred.

0

cleanup calls after mount / reload / unmount

-
-
Ready for review · state is owned by the current generationoperations-console / v0.1
-
-
- - - diff --git a/design/research-shelf.html b/design/research-shelf.html new file mode 100644 index 0000000..bd306b6 --- /dev/null +++ b/design/research-shelf.html @@ -0,0 +1,138 @@ + + + + + + Research Shelf + + + +
+
+
+
A quiet place for unfinished ideas
+

Research Shelf

+

Keep the next paper, book, and note close enough to become part of the work.

+
+
SQLite · saved locally
+
+ +
+ + +
+

Reading queue

12 records · page 1
+
TitleStatusProgressKind
+ + + + +
Showing 1–4 of 12
+
+ + +
+ +
+ + diff --git a/etaf-playground-catalog.el b/etaf-playground-catalog.el new file mode 100644 index 0000000..991e94c --- /dev/null +++ b/etaf-playground-catalog.el @@ -0,0 +1,30 @@ +;;; etaf-playground-catalog.el --- Reviewed Playground pair catalog -*- lexical-binding: t; -*- + +;;; Commentary: +;; Deployment configuration lives outside the generic loader. Adding or +;; replacing an application changes this catalog and its pair, not framework +;; loading, validation, mounting, or lifecycle semantics. + +;;; Code: + +(defconst etaf-playground-catalog + '((:pair "research-shelf" + :root-component etaf-research-shelf-root + :companion-feature etaf-research-shelf + :static-tags (research-shelf-shell header filters filter main library + detail footer) + :category "SQLite-backed research library" + :capabilities (view component reactivity context theme events data sqlite + pagination mutation lifecycle etaf-ui) + :refs (research-shelf-filter-all research-shelf-filter-reading + research-shelf-filter-unread research-shelf-filter-finished + research-shelf-filter-starred research-shelf-theme-toggle + research-shelf-reload research-shelf-add research-shelf-progress + research-shelf-finish research-shelf-star research-shelf-archive + research-shelf-page-previous research-shelf-page-next) + :gui-checkpoints (compact fullscreen all reading unread detail theme) + :performance (:warm-runs 8 :publication-per-event 1))) + "Reviewed same-basename pair specifications available to the Playground.") + +(provide 'etaf-playground-catalog) +;;; etaf-playground-catalog.el ends here diff --git a/etaf-playground.el b/etaf-playground.el index f7e6dc0..5b25c00 100644 --- a/etaf-playground.el +++ b/etaf-playground.el @@ -1,97 +1,125 @@ -;;; etaf-playground.el --- ETAF operations-console application pair -*- lexical-binding: t; -*- +;;; etaf-playground.el --- Generic ETAF pair playground framework -*- lexical-binding: t; -*- + ;;; Commentary: -;; One reviewed pair: inert `.etaf' data plus an executable companion. +;; The Playground owns only pair registration, inert `.etaf' validation, +;; companion loading, mounting, and cleanup. Applications belong in their +;; same-basename companion modules and never leak into this framework. + ;;; Code: (require 'cl-lib) (require 'etaf) -(require 'etaf-ui) +(require 'etaf-playground-catalog) -(defconst etaf-playground-buffer-name "*ETAF Playground*") +;; `read' consults this dynamically scoped safety switch. Declare it here +;; so the lexical-binding compiler does not mistake the protected binding for +;; an unused lexical local. +(defvar read-eval) + +(defconst etaf-playground-buffer-name "*ETAF Playground*" + "Default buffer used by the generic Playground launcher.") (defconst etaf-playground-example-directory (expand-file-name "examples" - (file-name-directory (or load-file-name buffer-file-name)))) -(defconst etaf-playground-scenario-manifest - '((:pair "operations-console" :root-component etaf-operations-console-root - :category "Complete application" - :capabilities (view component reactivity context theme behavior events - actions data resource lifecycle etaf-ui) - :refs (operations-console-alpha-increment operations-console-alpha-reset - operations-console-beta-increment operations-console-beta-reset - operations-console-nav-overview operations-console-nav-data - operations-console-nav-resource operations-console-theme-toggle - operations-console-local-callback operations-console-named-action - operations-console-behavior-toggle operations-console-clear-selection - operations-console-row-1 operations-console-row-2 operations-console-row-3 - operations-console-fail-next - operations-console-resource-reload operations-console-error-boundary) - :gui-checkpoints (compact fullscreen overview data resource theme focus) - :performance (:warm-runs 10 :publication-per-event 1))) - "The sole active Playground pair and its public review metadata.") -(defconst etaf-playground-example-names '("operations-console")) + (file-name-directory (or load-file-name buffer-file-name))) + "Directory containing same-basename `.etaf' and `.el' pairs.") +(defvar etaf-playground-default-pair + (plist-get (car etaf-playground-catalog) :pair) + "Pair opened by `etaf-playground-open'.") +(defvar etaf-playground-scenario-manifest + (copy-tree etaf-playground-catalog) + "Registered Playground pair specifications. + +Each entry declares the pair name, companion feature, root factory, inert +static tags, public refs, and review metadata. The framework does not inspect +or special-case the application's business model.") +(defvar etaf-playground-example-names + (mapcar (lambda (entry) (plist-get entry :pair)) + etaf-playground-scenario-manifest) + "Names of registered Playground pairs.") (defvar-local etaf-playground-current-example nil) -(defconst etaf-playground--static-tags - '(operations-console-shell header brand summary theme-control navigation tab - main overview hero metric-strip metric workspace activity-panel - capability-panel timeline data resource status - column row text spacer panel label viewport-height stretch)) + +(defun etaf-playground-register-pair (entry) + "Register or replace a generic Playground pair ENTRY. + +ENTRY must contain a string `:pair', symbol `:root-component', symbol +`:companion-feature', and a proper-list `:static-tags'." + (let ((name (plist-get entry :pair))) + (unless (and (stringp name) (symbolp (plist-get entry :root-component)) + (symbolp (plist-get entry :companion-feature)) + (proper-list-p (plist-get entry :static-tags))) + (error "Invalid Playground pair manifest entry: %S" entry)) + (setq etaf-playground-scenario-manifest + (cons entry + (cl-remove name etaf-playground-scenario-manifest + :key (lambda (item) (plist-get item :pair)) + :test #'equal))) + (setq etaf-playground-example-names + (mapcar (lambda (item) (plist-get item :pair)) + etaf-playground-scenario-manifest)) + entry)) (defun etaf-playground-scenario (name) - "Return the sole manifest entry named NAME." - (or (and (equal name "operations-console") - (car etaf-playground-scenario-manifest)) + "Return the registered pair specification named NAME." + (or (cl-find name etaf-playground-scenario-manifest + :key (lambda (entry) (plist-get entry :pair)) + :test #'equal) (user-error "Unknown ETAF Playground pair: %s" name))) (defun etaf-playground--pair-file (name suffix) "Return NAME pair path ending in SUFFIX." (expand-file-name (concat name suffix) etaf-playground-example-directory)) -(defun etaf-playground--validate-static-node (node) - "Validate inert static View NODE and return it." +(defun etaf-playground--validate-static-node (node tags) + "Validate inert static View NODE against allowlisted TAGS." (cond ((or (null node) (stringp node) (numberp node) (keywordp node) (memq node '(t stretch viewport-height))) node) + ;; Symbols in a static pair are inert enum/data values. They are not + ;; evaluated because only proper-list nodes become View forms; reject + ;; private runtime names while keeping the manifest format composable. + ((symbolp node) + (unless (or (string-prefix-p "etaf--" (symbol-name node)) + (string-prefix-p "ebox--" (symbol-name node))) + node)) ((consp node) (unless (and (proper-list-p node) (symbolp (car node)) - (memq (car node) etaf-playground--static-tags) + (memq (car node) tags) (not (string-prefix-p "etaf--" (symbol-name (car node)))) (not (string-prefix-p "ebox--" (symbol-name (car node))))) (error "Unsafe ETAF static View form: %S" node)) - (mapc #'etaf-playground--validate-static-node (cdr node)) + (mapc (lambda (child) (etaf-playground--validate-static-node child tags)) + (cdr node)) node) (t (error "Unsafe ETAF static View value: %S" node)))) (defun etaf-playground-read-static (name) "Read and validate NAME's single inert `.etaf' form." - (with-temp-buffer - (insert-file-contents (etaf-playground--pair-file name ".etaf")) - (let ((read-eval nil) - (form (read (current-buffer)))) - (ignore read-eval) - (condition-case nil - (progn (read (current-buffer)) - (error "ETAF static file contains multiple forms")) - (end-of-file nil)) - (etaf-playground--validate-static-node form)))) + (let ((scenario (etaf-playground-scenario name))) + (with-temp-buffer + (insert-file-contents (etaf-playground--pair-file name ".etaf")) + (let ((read-eval nil)) + (ignore read-eval) + (let ((form (read (current-buffer)))) + (condition-case nil + (progn (read (current-buffer)) + (error "ETAF static file contains multiple forms")) + (end-of-file nil)) + (etaf-playground--validate-static-node + form (plist-get scenario :static-tags))))))) (defun etaf-playground-read-pair (name) "Read NAME data, load its companion, and return its root View." (let* ((scenario (etaf-playground-scenario name)) (form (etaf-playground-read-static name)) + (feature (plist-get scenario :companion-feature)) (root (plist-get scenario :root-component))) - (unless (featurep 'etaf-operations-console) - ;; Use Emacs's normal source/bytecode resolution. `load-file' forced - ;; the 39KB companion through the Lisp interpreter on every fresh - ;; process, making the first retained render look like a layout - ;; regression. A compiled companion is the production path; source is - ;; still the deterministic fallback when no `.elc' exists. + (unless (featurep feature) (load (file-name-sans-extension - (etaf-playground--pair-file name ".el")) - nil nil nil)) + (etaf-playground--pair-file name ".el")) nil nil nil)) (unless (functionp root) (error "Missing root factory: %S" root)) (funcall root form))) (defun etaf-playground-mount-example (buffer-name name) - "Mount pair NAME in BUFFER-NAME." + "Mount registered pair NAME in BUFFER-NAME." (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-unmount runtime)) (let ((buffer (etaf-mount buffer-name (etaf-playground-read-pair name)))) @@ -105,32 +133,37 @@ ;;;###autoload (defun etaf-playground-open (&optional buffer-name) - "Open the operations-console pair in BUFFER-NAME." + "Open the registered default pair in BUFFER-NAME." (interactive) (etaf-playground--display-buffer (etaf-playground-mount-example - (or buffer-name etaf-playground-buffer-name) "operations-console"))) + (or buffer-name etaf-playground-buffer-name) + etaf-playground-default-pair))) ;;;###autoload (defun etaf-playground-open-example (name &optional buffer-name) - "Open pair NAME in BUFFER-NAME." + "Open registered pair NAME in BUFFER-NAME." + (interactive (list (completing-read "Pair: " etaf-playground-example-names))) (etaf-playground--display-buffer (etaf-playground-mount-example (or buffer-name etaf-playground-buffer-name) name))) ;;;###autoload (defun etaf-playground-reset (&optional buffer-name) - "Remount the active pair in BUFFER-NAME." - (interactive) - (let ((name (or buffer-name etaf-playground-buffer-name))) - (unless (get-buffer name) (user-error "No Playground pair is mounted")) + "Remount the current/default registered pair in BUFFER-NAME." + (let* ((name (or buffer-name etaf-playground-buffer-name)) + (buffer (get-buffer name)) + (pair (or (and buffer + (buffer-local-value 'etaf-playground-current-example + buffer)) + etaf-playground-default-pair))) + (unless buffer (user-error "No ETAF Playground pair is mounted")) (etaf-playground--display-buffer - (etaf-playground-mount-example name "operations-console")))) + (etaf-playground-mount-example name pair)))) ;;;###autoload (defun etaf-playground-close (&optional buffer-name) "Unmount and kill the Playground BUFFER-NAME." - (interactive) (let* ((name (or buffer-name etaf-playground-buffer-name)) (buffer (get-buffer name))) (when-let ((runtime (and buffer (etaf-runtime-for-buffer buffer)))) diff --git a/examples/operations-console.el b/examples/operations-console.el deleted file mode 100644 index 48a5d67..0000000 --- a/examples/operations-console.el +++ /dev/null @@ -1,756 +0,0 @@ -;;; operations-console.el --- one complete ETAF application example -*- lexical-binding: t; -*- - -;;; Commentary: - -;; This single-file sample shows the public development path: `:view' -;; props/slots/styles, `:setup' state, a normal composable, `expr' for -;; dynamic Views, Context/Theme, callbacks/Actions/Behaviors, Data, Resource -;; cleanup, and public open/close commands. - -;;; Code: - -(require 'cl-lib) -(require 'etaf) -(require 'etaf-ui) - -(defconst etaf-operations-console-buffer "*ETAF Operations Console*" - "Default buffer used by `etaf-operations-console-open'.") - -(defvar etaf-operations-console-cleanup-count 0 - "Observable count of composable cleanup calls for review and tests.") - -;;; Pure `:view' Component: props, named/default slots, and `:styles'. - -(etaf-define-component etaf-operations-console-card (&key title) - "Render a styled card with explicit named and default slot outlets." - :styles - (styles - ("&" :width stretch :border ((1) solid "#687386") :padding (1 2)) - (".operations-console-card-title" :face bold)) - :view - (column :class "operations-console-card" - (text :class "operations-console-card-title" - (expr :value title)) - (slot :name 'header) - (slot (label :text "This card has no default content.")))) - -;;; A normal Elisp composable called synchronously from Component `:setup'. - -(defun etaf-operations-console-use-counter (name initial-value) - "Create isolated counter state and effects for NAME and INITIAL-VALUE." - (let* ((count (etaf-ref initial-value :name name)) - (double (etaf-computed (lambda () (* 2 (etaf-value count))) - :name (intern (format "%s-double" name)))) - (updates (etaf-ref 0 :name (intern (format "%s-updates" name)))) - (audit-text (format "effect saw %d" (* 2 (or initial-value 0)))) - (audit (etaf-ref audit-text - :name (intern (format "%s-audit" name))))) - (etaf-watch count - (lambda (_new _old) (cl-incf (etaf-value updates))) - :immediate nil :name (intern (format "%s-watch" name))) - (etaf-watch-effect - (lambda () - (let ((value (etaf-value double))) - (let ((next (format "effect saw %d" value))) - (unless (equal next audit-text) - (setq audit-text next) - (setf (etaf-value audit) next))))) - :name (intern (format "%s-effect" name))) - (etaf-on-scope-dispose - (lambda () (cl-incf etaf-operations-console-cleanup-count))) - (list :name name :count count :double double :updates updates - :audit audit))) - -(defun etaf-operations-console-counter-ref (name operation) - "Return a stable interactive ref for counter NAME and OPERATION." - (intern (format "operations-console-%s-%s" name operation))) - -;;; Stateful Component: its render closure retains the composable instance. - -(etaf-define-component etaf-operations-console-counter (&key name initial-value) - "Render one isolated counter Component instance." - :setup - (let* ((instance-name name) - (initial initial-value) - (state (etaf-operations-console-use-counter - (intern (format "operations-console-%s" instance-name)) initial)) - (count (plist-get state :count)) - (double (plist-get state :double)) - (updates (plist-get state :updates)) - (audit (plist-get state :audit)) - (increment (lambda () (cl-incf (etaf-value count)))) - (reset (lambda () (setf (etaf-value count) initial)))) - (lambda () - (etaf-view - (operations-console-card - :title (format "Counter %s" instance-name) - (slot :name 'header - (label :text "State belongs to this Component instance.")) - (label :text (format "Value: %d · Double: %d" - (etaf-value count) (etaf-value double))) - (label :text (format "Watch updates: %d · Audit: %s" - (etaf-value updates) (etaf-value audit))) - (flex :gap '(0 (8)) - (button :label "Increment" - :ref (etaf-operations-console-counter-ref instance-name "increment") - :on-press increment) - (button :label "Reset" - :ref (etaf-operations-console-counter-ref instance-name "reset") - :on-press reset)) - (expr - :value - (when (> (etaf-value count) 0) - (etaf-view - (text "Dynamic child is visible after Increment."))))))))) - -;;; Context and Theme: the child consumes a value provided by the shell. - -;;; Named Action: state is passed explicitly, so no hidden global app state. - -(etaf-action-define etaf-operations-console-named-note (runtime target) - "Publish a message through a named Action." - (ignore runtime) - (setf (etaf-value target) "Named Action: pressed")) - -;;; Behavior reuse: ordinary Elisp returns semantic interaction bundles. - -(defun etaf-operations-console-use-toggle-behaviors (toggle message) - "Return reusable focus and toggle Behaviors for TOGGLE and MESSAGE." - (list - (etaf-focusable) - (etaf-toggleable - :value toggle - :on-change - (lambda (value) - (setf (etaf-value toggle) value - (etaf-value message) - (if value "Behavior toggle: on" "Behavior toggle: off")))))) - -(etaf-define-component etaf-operations-console-action-panel () - "Show a local callback, a named Action, and reusable Behaviors." - :setup - (let* ((message (etaf-ref "Callback action pending" :name 'operations-console-message)) - (toggle (etaf-ref nil :name 'operations-console-toggle)) - ;; Behavior installers use function identity. Construct this - ;; reusable bundle once in setup so state renders retain it. - (behaviors (etaf-operations-console-use-toggle-behaviors toggle message)) - (local-callback - (lambda () (setf (etaf-value message) "Local callback: pressed"))) - (named-callback - (lambda () (etaf-dispatch 'etaf-operations-console-named-note message)))) - (lambda () - (etaf-view - (operations-console-card - :title "Events, Actions, and Behaviors" - (column :width 'stretch - (label :text (etaf-value message))) - (flex :gap '(0 (8)) - (button :label "Local callback" - :ref 'operations-console-local-callback - :on-press local-callback) - (button :label "Named Action" - :ref 'operations-console-named-action - :on-press named-callback) - (button - :label (if (etaf-value toggle) "Behavior: on" "Behavior: off") - :ref 'operations-console-behavior-toggle - :use behaviors))))))) - -;;; Application model: detached resources are ready before the first render. - -(defun etaf-operations-console-create-model () - "Create and load the external model before mounting the application." - (let* ((source (etaf-data-memory-source - '((:id 1 :name "Ada" :status "open") - (:id 2 :name "Grace" :status "review") - (:id 3 :name "Lin" :status "done")) - :id-key :id :name 'operations-console-records)) - (controller (etaf-data-controller - source :page-size 3 :name 'operations-console-controller)) - (fail-next (etaf-ref nil :name 'operations-console-fail-next)) - (cleanups (etaf-ref 0 :name 'operations-console-resource-cleanups)) - (health (etaf-ref "All systems nominal" - :name 'operations-console-health-status)) - (activity (etaf-ref "Theme provider promoted" - :name 'operations-console-activity)) - (trail (etaf-ref "Surface mounted · Data controller loaded" - :name 'operations-console-event-trail)) - (throughput (etaf-ref 2400 :name 'operations-console-throughput)) - (generation 0)) - (etaf-data-load controller) - (let ((resource - (etaf-resource - (lambda () - (cl-incf generation) - (if (etaf-value fail-next) - (progn - (setf (etaf-value fail-next) nil) - (error "Example load failed")) - (etaf-resource-result - (format "Loaded value %d" generation) - :cleanup (lambda () (cl-incf (etaf-value cleanups)))))) - :immediate t :name 'operations-console-resource))) - (list :controller controller :resource resource - :fail-next fail-next :cleanups cleanups - :health health :activity activity :trail trail - :throughput throughput - :health-check - (lambda () - (setf (etaf-value health) "Health check complete" - (etaf-value activity) "Health check completed" - (etaf-value trail) "Health check · all owned surfaces responded")) - :show-trail - (lambda () - (setf (etaf-value activity) "Event trail focused" - (etaf-value trail) "Event trail opened for inspection")))))) - -(defun etaf-operations-console-dispose-model (model) - "Stop MODEL's Data Controller and dispose its Resource." - (etaf-data-stop (plist-get model :controller)) - (etaf-resource-dispose (plist-get model :resource))) - -(defun etaf-operations-console-data-status (selection items) - "Return visible status derived from SELECTION and ITEMS." - (let ((selected (cl-find (car selection) items :key - (lambda (row) (plist-get row :id)) - :test #'equal))) - (if selected - (format "Selected %s" (plist-get selected :name)) - "Rows loaded from the public controller."))) - -;;; Data Controller + official `data-grid'. - -(etaf-define-component etaf-operations-console-data-panel (&key model) - "Render MODEL's loaded Data Controller and interactive DataGrid." - :setup - (let* ((controller (plist-get model :controller)) - (view-state - (etaf-computed - (lambda () - (let ((selection (etaf-value (etaf-data-selection controller))) - (items (etaf-value (etaf-data-items controller)))) - (list :selected (car selection) - :status (etaf-operations-console-data-status selection items)))) - :name 'operations-console-data-view-state)) - (row-key (lambda (row) (plist-get row :id))) - (row-ref (lambda (row) - (intern (format "operations-console-row-%s" - (plist-get row :id))))) - (row-press (lambda (row) - (etaf-data-select-one controller (plist-get row :id)))) - (clear-selection - (lambda () (etaf-data-clear-selection controller)))) - (lambda () - (let ((state (etaf-value view-state))) - (etaf-view - (operations-console-card - :title "Data Controller and DataGrid" - (label :text (plist-get state :status)) - (data-grid - :controller controller - :columns '((:key :id :label "ID" :width 5) - (:key :name :label "NAME" :width 20) - (:key :status :label "STATUS" :width 10)) - :row-key row-key - :row-ref row-ref - :selected-key (plist-get state :selected) - :on-row-press row-press) - (button :label "Clear selection" - :ref 'operations-console-clear-selection - :on-press clear-selection))))))) - -;;; Resource + explicit error boundary: load, reload, cleanup, and recovery. - -(etaf-define-component etaf-operations-console-resource-panel (&key model) - "Render MODEL's Resource with reload, failure, and cleanup feedback." - :setup - (let* ((instance-model model) - (fail-next (plist-get instance-model :fail-next)) - (cleanups (plist-get instance-model :cleanups)) - (boundary (etaf-ref "No boundary run yet." - :name 'operations-console-boundary)) - (resource (plist-get instance-model :resource)) - (fail-change (lambda (value) (setf (etaf-value fail-next) value))) - (reload (lambda () (etaf-resource-load resource))) - (run-boundary - (lambda () - (setf (etaf-value boundary) - (etaf-error-boundary-run - (lambda () (error "Handled sample")) - (lambda (condition) - (format "Handled: %s" - (error-message-string condition)))))))) - (lambda () - (etaf-view - (operations-console-card - :title "Resource and Error Boundary" - (label :text (format "Status: %s" - (etaf-resource-status resource))) - (label :text (or (etaf-resource-value resource) - (when-let ((condition (etaf-resource-error resource))) - (format "Error: %s" - (error-message-string condition))))) - (label :text (format "Cleanup calls: %d" - (etaf-value cleanups))) - (checkbox :label "Fail next load" - :ref 'operations-console-fail-next - :checked (etaf-value fail-next) - :on-change fail-change) - (flex :gap '(0 (8)) - (button :label "Reload resource" - :ref 'operations-console-resource-reload - :on-press reload) - (button :label "Run handled boundary" - :ref 'operations-console-error-boundary - :on-press run-boundary)) - (label :text (etaf-value boundary))))))) - -;;; Page composition and navigation views. - -(defun etaf-operations-console-static-child (form tag) - "Return the first static child named TAG from FORM. -The static `.etaf' form is the composition authority; the companion only -fills these safe named slots with reactive Views." - (cl-find-if (lambda (entry) - (and (consp entry) (eq (car entry) tag))) - (cdr form))) - -(defun etaf-operations-console-static-value (form key default) - "Return keyword KEY from static FORM, or DEFAULT. -Keyword values are inert data; executable behavior never comes from `.etaf'." - (let ((tail (member key (cdr form)))) - (if tail (cadr tail) default))) - -(defun etaf-operations-console-static-child-value (form tag key default) - "Return KEY from child TAG in static FORM, or DEFAULT. -The helper keeps `.etaf' consumption at one validated data boundary instead -of scattering plist reads through the application renderer." - (etaf-operations-console-static-value - (or (etaf-operations-console-static-child form tag) nil) - key default)) - -(defun etaf-operations-console-static-child-by-value (form tag key value) - "Return the child TAG whose KEY equals VALUE in static FORM." - (cl-find-if (lambda (entry) - (and (consp entry) - (eq (car entry) tag) - (equal (plist-get (cdr entry) key) value))) - (cdr form))) - -(defun etaf-operations-console-hero-view (model hero-form) - "Return the visual hero for MODEL using static HERO-FORM copy." - (let ((eyebrow (etaf-operations-console-static-value - hero-form :eyebrow "TUESDAY / 09:42 / LIVE REVIEW")) - (title (etaf-operations-console-static-value - hero-form :title "Make complex state feel calm."))) - (etaf-view - (column :class "operations-console-hero" :width 'stretch - :padding '(2 3) :border "#17374A" - :bgcolor "#17374A" :color "#F6F1E8" - (column :width 'stretch - (label :text eyebrow :face 'bold) - (label :text title :face 'bold) - (label :text "A single surface for components, context, behavior, data, and recovery — designed to make every ETAF update visible and explainable.") - (flex :width 'stretch :gap '(1 (8)) - (button :label "Run health check" - :ref 'operations-console-health-check - :on-press (plist-get model :health-check)) - (button :label "View event trail" - :ref 'operations-console-show-trail - :on-press (plist-get model :show-trail)))))))) - -(etaf-define-component etaf-operations-console-metric - (&key label value delta color) - "Render one KPI metric with a retained Component owner." - :setup - (lambda () - (etaf-view - (column :class "operations-console-metric" :width 'stretch - :padding '(1 2) :border (etaf-current-prop :color) - :bgcolor (etaf-theme-value - :surface "#FFFDF8") - :color (etaf-theme-value :color "#142235") - (label :text (etaf-current-prop :label)) - (label :text (etaf-current-prop :value) :face 'bold) - (label :text (etaf-current-prop :delta) - :color (etaf-theme-value - :success "#3E9B72")))))) - -(defun etaf-operations-console-metric-strip-view (model) - "Return the four-card KPI strip for MODEL." - (etaf-view - (grid :width 'stretch :grid-template-columns '(1fr 1fr 1fr 1fr) - :gap '(1 (8)) - (operations-console-metric - :label "Throughput" - :value (format "%dk" (/ (etaf-value (plist-get model :throughput)) 1000)) - :delta "↑ 18% this week" - :color (etaf-theme-value :teal "#2E8B83")) - (operations-console-metric - :label "Active flows" :value "18" :delta "+3 since 08:00" - :color (etaf-theme-value :coral "#E26D5A")) - (operations-console-metric - :label "Response" :value "42ms" :delta "p95 within target" - :color (etaf-theme-value :amber "#D99A3D")) - (operations-console-metric - :label "Reliability" :value "99.8%" :delta "steady" - :color (etaf-theme-value :success "#3E9B72"))))) - -(defun etaf-operations-console-activity-view (model) - "Return the reactive Activity stream card for MODEL." - (etaf-view - (column :class "operations-console-card" :width 'stretch - :padding '(1 2) :border (etaf-theme-value - :line "#C8C1B6") - :bgcolor (etaf-theme-value :surface "#FFFDF8") - (flex :width 'stretch :align-items 'center - (column :width 'stretch :flex-grow 1 :flex-shrink 1 :min-width 0 - (label :text "Activity stream" :face 'bold) - (label :text "Reactive events, rendered as a readable story.")) - (label :text "4 EVENTS" :color - (etaf-theme-value :teal "#2E8B83"))) - (label :text (format "↗ %s" (etaf-value (plist-get model :activity)))) - (label :text "◆ Counter alpha crossed 2k · one Component-owned update") - (label :text "✓ Resource boundary recovered · shell stayed mounted")))) - -(defun etaf-operations-console-capability-view () - "Return the static capability map card." - (etaf-view - (column :class "operations-console-card" :width 'stretch - :padding '(1 2) :border (etaf-theme-value - :line "#C8C1B6") - :bgcolor (etaf-theme-value :surface "#FFFDF8") - (flex :width 'stretch :align-items 'center - (column :width 'stretch :flex-grow 1 :flex-shrink 1 :min-width 0 - (label :text "Capability map" :face 'bold) - (label :text "What this surface is proving.")) - (label :text "ETAF" :color - (etaf-theme-value :teal "#2E8B83"))) - (label :text "✓ Component ownership · props, slots, setup, retained identity") - (label :text "✓ Context + Theme · provider defaults and dark mode") - (label :text "✓ Behavior + Actions · keyboard-ready stable refs") - (label :text "✓ Data + Resource · selection, failure, boundary, cleanup")))) - -(defun etaf-operations-console-timeline-view (model) - "Return the event trail card for MODEL." - (etaf-view - (column :class "operations-console-card" :width 'stretch - :padding '(1 2) :border (etaf-theme-value - :line "#C8C1B6") - :bgcolor (etaf-theme-value :surface "#FFFDF8") - (flex :width 'stretch :align-items 'center - (column :width 'stretch :flex-grow 1 :flex-shrink 1 :min-width 0 - (label :text "Event trail" :face 'bold) - (label :text "Every meaningful action leaves a compact, inspectable trace.")) - (button :label "Clear trail" :ref 'operations-console-clear-trail - :on-press (lambda () - (setf (etaf-value (plist-get model :trail)) - "Trail cleared · new actions append here")))) - (label :text (format "● %s" (etaf-value (plist-get model :trail))))))) - -;; These wrappers make the HTML sections real ETAF Components. The plain -;; `*-view' helpers stay small and readable, while the Component boundary -;; gives every dynamic `expr' a reviewed semantic owner. -(etaf-define-component etaf-operations-console-hero (&key model hero-form) - "Render the operations hero as a retained Component." - :setup - (lambda () (etaf-operations-console-hero-view - (etaf-current-prop :model) - (etaf-current-prop :hero-form)))) - -(etaf-define-component etaf-operations-console-metric-strip (&key model) - "Render the operations KPI strip as a retained Component." - :setup - (lambda () (etaf-operations-console-metric-strip-view - (etaf-current-prop :model)))) - -(etaf-define-component etaf-operations-console-activity (&key model) - "Render the reactive activity card as a retained Component." - :setup - (lambda () (etaf-operations-console-activity-view - (etaf-current-prop :model)))) - -(etaf-define-component etaf-operations-console-capabilities () - "Render the static capability map as a reusable Component." - :setup - (lambda () (etaf-operations-console-capability-view))) - -(etaf-define-component etaf-operations-console-timeline (&key model) - "Render the event trail as a retained Component." - :setup - (lambda () (etaf-operations-console-timeline-view - (etaf-current-prop :model)))) - -(defun etaf-operations-console-overview-page (model main-form) - "Return the Overview page View for MODEL using MAIN-FORM sections." - (let* ((overview-form (etaf-operations-console-static-child - main-form 'overview)) - (hero-form (etaf-operations-console-static-child - overview-form 'hero))) - (etaf-view - (column :class "operations-console-page" :width 'stretch - (operations-console-hero :model model :hero-form hero-form) - (operations-console-metric-strip :model model) - (grid :width 'stretch :grid-template-columns '(5fr 3fr) - :gap '(1 (12)) - (operations-console-activity :model model) - (operations-console-capabilities)) - (operations-console-timeline :model model) - (grid :width 'stretch :grid-template-columns '(1fr 1fr) - :gap '(1 (12)) - (operations-console-counter :name "alpha" :initial-value 0) - (operations-console-counter :name "beta" :initial-value 10) - (operations-console-action-panel)))))) - -(defun etaf-operations-console-data-page (model) - "Return the Data page View for MODEL." - (etaf-view - (column :class "operations-console-page" :width 'stretch - (operations-console-data-panel :model model)))) - -(defun etaf-operations-console-resource-page (model) - "Return the Resource page View for MODEL." - (etaf-view - (column :class "operations-console-page" :width 'stretch - (operations-console-resource-panel :model model)))) - -(etaf-define-component etaf-operations-console-overview-surface - (&key model main-form) - "Own the material Overview page surface." - :setup - (lambda () - (etaf-operations-console-overview-page - (etaf-current-prop :model) - (etaf-current-prop :main-form)))) - -(etaf-define-component etaf-operations-console-data-surface (&key model) - "Own the material Data page surface." - :setup - (lambda () - (etaf-operations-console-data-page (etaf-current-prop :model)))) - -(etaf-define-component etaf-operations-console-resource-surface (&key model) - "Own the material Resource page surface." - :setup - (lambda () - (etaf-operations-console-resource-page (etaf-current-prop :model)))) - -(defun etaf-operations-console-page-view (page model main-form) - "Return the selected page Component call for PAGE, MODEL, and MAIN-FORM. -The function is called from an `expr' Range, so the page signal belongs to -the retained route owner while the structural forms remain ordinary compiled -View calls." - (pcase page - ('data - (etaf-view (operations-console-data-surface :model model))) - ('resource - (etaf-view (operations-console-resource-surface :model model))) - (_ - (etaf-view - (operations-console-overview-surface - :model model :main-form main-form))))) - -(etaf-define-component etaf-operations-console-page-router - (&key page-ref model main-form) - "Render the current material page from PAGE-REF and MODEL. -The page signal is read by this retained router Component, not by the root -shell, so navigation does not invalidate the whole application generation." - :setup - (lambda () - ;; Keep one material Host as the route owner's layout anchor. Page - ;; surfaces are Components, so the route never injects a raw View through - ;; an unowned expr and the containing-block width remains explicit. - (let ((model (etaf-current-prop :model)) - (main-form (etaf-current-prop :main-form)) - (page-ref (etaf-current-prop :page-ref))) - (etaf-view - (fragment - (column :class "operations-console-page-router" :width 'stretch - :ref 'operations-console-page-slot - (expr - :value - (etaf-operations-console-page-view - (etaf-value page-ref) model main-form)))))))) - -;;; Root shell: Context provider, two composable instances, and viewport. - -(etaf-define-component etaf-operations-console-shell - (&key model static-form page-ref) - "Compose the complete public ETAF application." - :styles - (styles - (".operations-console-shell" :width stretch :padding (1 2)) - (".operations-console-shell-header" :width stretch :padding (1 2)) - (".operations-console-nav" :padding (0 2) - :border ((1) solid "#687386")) - (".operations-console-main" :width stretch :padding (1 2)) - (".operations-console-page" :width stretch) - (".operations-console-status" :width stretch :padding (0 2) - :border ((1) solid "#687386"))) - :setup - (let* ((instance-model model) - (page-cell page-ref) - (title (etaf-operations-console-static-value - static-form :title "Operations Console")) - (kicker (etaf-operations-console-static-value - static-form :kicker "ETAF / reference workspace")) - (header-form (etaf-operations-console-static-child static-form 'header)) - (navigation-form - (etaf-operations-console-static-child static-form 'navigation)) - (main-form (etaf-operations-console-static-child static-form 'main)) - (status-form (etaf-operations-console-static-child static-form 'status)) - (brand-form (etaf-operations-console-static-child header-form 'brand)) - (summary-form (etaf-operations-console-static-child header-form 'summary)) - (theme-control-form - (etaf-operations-console-static-child header-form 'theme-control)) - (overview-tab - (etaf-operations-console-static-child-by-value - navigation-form 'tab :key "overview")) - (data-tab - (etaf-operations-console-static-child-by-value - navigation-form 'tab :key "data")) - (resource-tab - (etaf-operations-console-static-child-by-value - navigation-form 'tab :key "resource")) - (brand-mark (etaf-operations-console-static-value - brand-form :mark "OC")) - (brand-name (etaf-operations-console-static-value - brand-form :name title)) - (summary-status (etaf-operations-console-static-value - summary-form :status "All systems nominal")) - (theme-label (etaf-operations-console-static-value - theme-control-form :label "Theme")) - (overview-label (etaf-operations-console-static-value - overview-tab :label "Overview")) - (data-label (etaf-operations-console-static-value - data-tab :label "Data")) - (resource-label (etaf-operations-console-static-value - resource-tab :label "Resource")) - (dark (etaf-ref nil :name 'operations-console-dark-theme)) - (theme (etaf-computed - (lambda () - (if (etaf-value dark) - '(:color "#EDF2F4" :bgcolor "#111923" - :surface "#182433" :line "#344455" - :teal "#61C6BA" :coral "#FF957F" - :amber "#EFC06C" :success "#73D29D") - '(:color "#142235" :bgcolor "#F6F1E8" - :surface "#FFFDF8" :line "#C8C1B6" - :teal "#2E8B83" :coral "#E26D5A" - :amber "#D99A3D" :success "#3E9B72")))))) - (unless (and header-form navigation-form main-form status-form - brand-form summary-form theme-control-form - overview-tab data-tab resource-tab) - (error "Invalid Operations Console shell composition: %S" static-form)) - (etaf-provide 'operations-console-theme theme) - (etaf-theme-provide theme) - (etaf-on-unmounted - (lambda () (etaf-operations-console-dispose-model instance-model))) - (lambda () - (etaf-view - (column :class "operations-console-shell" :width 'stretch - :height '(viewport-height) - (column :class "operations-console-shell-header" :width 'stretch - (flex :width 'stretch :align-items 'center - (column :width 'stretch :flex-grow 1 :flex-shrink 1 :min-width 0 - (label :face 'bold :text (format "%s %s" brand-mark brand-name)) - (label :text kicker)) - (label :text (format "● %s" summary-status) - :color (etaf-theme-value - :success "#3E9B72"))) - (label :text "A calm reference surface for complex state, ownership, and recovery.")) - (flex :class "operations-console-nav" :width 'max-content - :ref 'operations-console-nav - :align-items 'center :gap '(0 (8)) - (button :label overview-label :ref 'operations-console-nav-overview - :on-press (lambda () (setf (etaf-value page-cell) 'overview))) - (button :label data-label :ref 'operations-console-nav-data - :on-press (lambda () (setf (etaf-value page-cell) 'data))) - (button :label resource-label :ref 'operations-console-nav-resource - :on-press (lambda () (setf (etaf-value page-cell) 'resource))) - (checkbox :label theme-label :ref 'operations-console-theme-toggle - :checked (etaf-value dark) - :color (etaf-theme-value :color "#252A2E") - :bgcolor (etaf-theme-value :bgcolor "#F8F5EE") - :on-change (lambda (value) - (setf (etaf-value dark) value))) - ;; Reserve the small status slot explicitly so a theme flip changes - ;; paint/content inside the control bar without reflowing its parent. - (label :width 12 - :text (if (etaf-value dark) "Theme: Dark" "Theme: Light"))) - (column :class "operations-console-main" :width 'stretch - :flex-grow 1 :flex-shrink 1 :ref 'operations-console-main - (operations-console-page-router :page-ref page-cell - :model instance-model - :main-form main-form)) - (column :class "operations-console-status" :width 'stretch - :flex-shrink 0 :ref 'operations-console-status - (label :text (or (etaf-operations-console-static-value - status-form :label nil) - "Ready for review")))))))) - -;;; Public View/open/close entry points. - -(defun etaf-operations-console-view (model static-form page-ref) - "Return the root View for MODEL, STATIC-FORM, and stable PAGE-REF." - (etaf-view (operations-console-shell :model model :static-form static-form - :page-ref page-ref))) - -(defun etaf-operations-console-root (static-form) - "Consume validated STATIC-FORM and return one owned application root View." - (unless (equal static-form - '(operations-console-shell - :title "Operations Console" - :kicker "ETAF / reference workspace" - (header - (brand :mark "OC" :name "Operations Console") - (summary :status "All systems nominal") - (theme-control :label "Theme")) - (navigation - (tab :key "overview" :label "Overview" :index "01") - (tab :key "data" :label "Data desk" :index "02") - (tab :key "resource" :label "Resource lab" :index "03")) - (main - (overview - (hero :eyebrow "Tuesday / 09:42 / live review" - :title "Make complex state feel calm.") - (metric-strip - (metric :key "throughput" :label "Throughput") - (metric :key "flows" :label "Active flows") - (metric :key "response" :label "Response") - (metric :key "reliability" :label "Reliability")) - (workspace - (activity-panel :title "Activity stream") - (capability-panel :title "Capability map")) - (timeline :title "Event trail")) - (data :title "Data desk") - (resource :title "Resource lab")) - (status :label "Ready for review"))) - (error "Unsupported Operations Console static root: %S" static-form)) - (let ((model (etaf-operations-console-create-model)) - (page (etaf-ref 'overview :name 'operations-console-page))) - (lambda () - (etaf-operations-console-view - model static-form page)))) - -;;;###autoload -(defun etaf-operations-console-open (&optional buffer-name) - "Open the canonical Playground pair in BUFFER-NAME." - (interactive) - (require 'etaf-playground) - (etaf-playground-open (or buffer-name etaf-operations-console-buffer))) - -;;;###autoload -(defun etaf-operations-console-close (&optional buffer-name) - "Unmount and kill the application buffer named BUFFER-NAME." - (interactive) - (let* ((name (or buffer-name etaf-operations-console-buffer)) - (runtime (etaf-runtime-for-buffer name)) - (buffer (get-buffer name))) - (when runtime (etaf-unmount runtime)) - (when (buffer-live-p buffer) (kill-buffer buffer)) - buffer)) - -(provide 'etaf-operations-console) - -;;; operations-console.el ends here diff --git a/examples/operations-console.etaf b/examples/operations-console.etaf deleted file mode 100644 index 4e116a0..0000000 --- a/examples/operations-console.etaf +++ /dev/null @@ -1,29 +0,0 @@ -;; Static composition only. The companion owns all state, components, and -;; event handlers; this file is the safe layout contract it consumes. -(operations-console-shell - :title "Operations Console" - :kicker "ETAF / reference workspace" - (header - (brand :mark "OC" :name "Operations Console") - (summary :status "All systems nominal") - (theme-control :label "Theme")) - (navigation - (tab :key "overview" :label "Overview" :index "01") - (tab :key "data" :label "Data desk" :index "02") - (tab :key "resource" :label "Resource lab" :index "03")) - (main - (overview - (hero :eyebrow "Tuesday / 09:42 / live review" - :title "Make complex state feel calm.") - (metric-strip - (metric :key "throughput" :label "Throughput") - (metric :key "flows" :label "Active flows") - (metric :key "response" :label "Response") - (metric :key "reliability" :label "Reliability")) - (workspace - (activity-panel :title "Activity stream") - (capability-panel :title "Capability map")) - (timeline :title "Event trail")) - (data :title "Data desk") - (resource :title "Resource lab")) - (status :label "Ready for review")) diff --git a/examples/research-shelf.el b/examples/research-shelf.el new file mode 100644 index 0000000..81892b2 --- /dev/null +++ b/examples/research-shelf.el @@ -0,0 +1,542 @@ +;;; research-shelf.el --- SQLite-backed research library -*- lexical-binding: t; -*- + +;;; Commentary: +;; A useful ETAF application: a small reading/research shelf whose records +;; survive unmounts because the Data Controller is backed by etaf-sqlite. + +;;; Code: +(require 'cl-lib) +(require 'subr-x) +(require 'etaf) +(require 'etaf-ui) +(require 'etaf-sqlite) +(require 'etaf-playground) + +(defcustom etaf-research-shelf-database-file + (expand-file-name "research-shelf.sqlite" user-emacs-directory) + "SQLite file used by the Research Shelf application." + :type 'file + :group 'etaf) + +(defconst etaf-research-shelf-seed-records + '((:id 1 :title "The Shape of Tools" :author "M. Abramson" + :kind "Essay" :status "reading" :progress 64 :priority "High" + :starred 1 :note "The best tools make attention feel larger, not more fragmented." :updated "Today") + (:id 2 :title "Ways of Seeing" :author "John Berger" + :kind "Book" :status "unread" :progress 0 :priority "Medium" + :starred 0 :note "Look again at the relationship between image and power." :updated "Yesterday") + (:id 3 :title "The Cathedral and the Bazaar" :author "Eric S. Raymond" + :kind "Paper" :status "finished" :progress 100 :priority "Low" + :starred 1 :note "A useful contrast between closed and open production." :updated "Mon") + (:id 4 :title "Designing for Calm" :author "A. Ito" + :kind "Notes" :status "reading" :progress 32 :priority "High" + :starred 0 :note "Reduce decisions before asking for attention." :updated "Sun") + (:id 5 :title "The Craftsman" :author "Richard Sennett" + :kind "Book" :status "unread" :progress 0 :priority "Medium" + :starred 1 :note "A long-form companion for making and revising." :updated "Sat") + (:id 6 :title "How Buildings Learn" :author "Stewart Brand" + :kind "Book" :status "reading" :progress 78 :priority "Medium" + :starred 0 :note "Change is a property of useful systems." :updated "Fri") + (:id 7 :title "The Interface Is the Message" :author "N. Hara" + :kind "Essay" :status "finished" :progress 100 :priority "Low" + :starred 0 :note "A short note on visible constraints." :updated "Thu") + (:id 8 :title "Notes on Attention" :author "Simone Weil" + :kind "Notes" :status "unread" :progress 0 :priority "High" + :starred 1 :note "Attention is not force; it is patient availability." :updated "Wed")) + "Seed records installed into a new Research Shelf database once.") + +(defun etaf-research-shelf--static-child (form tag) + "Return the first child named TAG from static FORM." + (cl-find-if (lambda (entry) (and (consp entry) (eq (car entry) tag))) + (cdr form))) + +(defun etaf-research-shelf--static-value (form key default) + "Return KEY from static FORM, or DEFAULT." + (or (plist-get (cdr form) key) default)) + +(defun etaf-research-shelf--database () + "Return the configured typed Research Shelf database description." + (etaf-sqlite-database + etaf-research-shelf-database-file + (etaf-sqlite-table + 'reading_items + (list (etaf-sqlite-column :id "id" :type 'integer :primary t) + (etaf-sqlite-column :title "title" :type 'text) + (etaf-sqlite-column :author "author" :type 'text) + (etaf-sqlite-column :kind "kind" :type 'text) + (etaf-sqlite-column :status "status" :type 'text) + (etaf-sqlite-column :progress "progress" :type 'integer) + (etaf-sqlite-column :priority "priority" :type 'text) + (etaf-sqlite-column :starred "starred" :type 'integer) + (etaf-sqlite-column :note "note" :type 'text) + (etaf-sqlite-column :updated "updated" :type 'text)) + :id))) + +(defun etaf-research-shelf--ensure-database () + "Initialize the SQLite database and install seed data when empty." + (let* ((database (etaf-research-shelf--database)) + (source (etaf-sqlite-source database)) + (load (plist-get source :load)) + (mutate (plist-get source :mutate))) + (etaf-sqlite-initialize database) + (when (= 0 (plist-get (funcall load nil 1 1) :total)) + (dolist (record etaf-research-shelf-seed-records) + (funcall mutate 'insert record))) + database)) + +(defun etaf-research-shelf--create-model () + "Create the application model and its SQLite-backed Data Controller." + (let* ((database (etaf-research-shelf--ensure-database)) + (controller + (etaf-data-controller + (etaf-sqlite-source database) + :page-size 4 :auto-load nil :name 'etaf-research-shelf)) + (filter (etaf-ref 'all :name 'research-shelf-filter)) + (dark (etaf-ref nil :name 'research-shelf-dark-theme)) + (toast (etaf-ref "Ready to read." :name 'research-shelf-toast)) + (next-id (etaf-ref 100 :name 'research-shelf-next-id))) + (list :database database :database-file etaf-research-shelf-database-file + :controller controller :filter filter :dark dark :toast toast + :next-id next-id))) + +(defun etaf-research-shelf--controller (model) + "Return MODEL's Data Controller." + (plist-get model :controller)) + +(defun etaf-research-shelf--query (filter) + "Translate FILTER into an allowlisted SQLite equality query." + (pcase filter + ('reading '(:status "reading")) + ('unread '(:status "unread")) + ('finished '(:status "finished")) + ('starred '(:starred 1)) + (_ nil))) + +(defun etaf-research-shelf--load (model &optional message) + "Load MODEL and expose a visible success/error MESSAGE." + (let ((controller (etaf-research-shelf--controller model))) + (condition-case err + (progn + (etaf-data-load controller) + (setf (etaf-value (plist-get model :toast)) + (or message "✓ Saved locally"))) + (error + (setf (etaf-value (plist-get model :toast)) + (format "⚠ Storage issue: %s" (error-message-string err))))))) + +(defun etaf-research-shelf--set-filter (model filter) + "Set MODEL FILTER and reload the SQLite-backed list." + (let ((controller (etaf-research-shelf--controller model))) + (setf (etaf-value (plist-get model :filter)) filter) + (etaf-data-set-query controller (etaf-research-shelf--query filter)) + (etaf-data-set-page controller 1) + (etaf-research-shelf--load model + (format "Showing %s" + (capitalize (symbol-name filter)))))) + +(defun etaf-research-shelf--items (model) + "Return loaded items for MODEL." + (etaf-value (etaf-data-items (etaf-research-shelf--controller model)))) + +(defun etaf-research-shelf--selected (model) + "Return the selected item in MODEL, or nil." + (let* ((controller (etaf-research-shelf--controller model)) + (id (car (etaf-value (etaf-data-selection controller))))) + (cl-find id (etaf-research-shelf--items model) + :key (lambda (row) (plist-get row :id)) :test #'equal))) + +(defun etaf-research-shelf--mutate (model operation payload message) + "Apply SQLite OPERATION PAYLOAD for MODEL. +Show MESSAGE on success, or preserve the resulting error state." + (let ((controller (etaf-research-shelf--controller model))) + (condition-case err + (progn + (etaf-data-mutate controller operation payload) + (setf (etaf-value (plist-get model :toast)) message)) + (error + (setf (etaf-value (plist-get model :toast)) + (format "⚠ Could not save: %s" (error-message-string err))))))) + +(defun etaf-research-shelf--update-selected (model fields message) + "Update selected MODEL record with FIELDS and show MESSAGE." + (when-let ((row (etaf-research-shelf--selected model))) + (etaf-research-shelf--mutate + model 'update + (append (list :id (plist-get row :id)) fields) + message))) + +(defun etaf-research-shelf--theme (model) + "Return MODEL's current palette." + (if (etaf-value (plist-get model :dark)) + '(:ink "#F4F7FF" :paper "#111827" :panel "#182235" :line "#34435A" + :muted "#AAB5C8" :accent "#8EA7FF" :mint "#76D6C3" :coral "#FF9A8E" + :amber "#F0C36A" :soft "#202C42") + '(:ink "#172033" :paper "#F7F3EA" :panel "#FFFDF8" :line "#D9D4C9" + :muted "#6D7482" :accent "#3657D6" :mint "#3E9B8F" :coral "#D86B5D" + :amber "#C58A3A" :soft "#F1EEE7"))) + +(defun etaf-research-shelf--color (model key) + "Return palette KEY for MODEL." + (plist-get (etaf-research-shelf--theme model) key)) + +(defun etaf-research-shelf--status-label (status) + "Return a readable status label for STATUS." + (pcase status + ("reading" "◷ In progress") + ("finished" "✓ Finished") + ("archived" "↗ Archived") + (_ "○ Unread"))) + +(defun etaf-research-shelf--filter-label (model form key fallback) + "Return MODEL's active-aware label for KEY from static FILTER FORM." + (let* ((entry (cl-find-if + (lambda (item) (and (consp item) (eq (car item) 'filter) + (eq (plist-get (cdr item) :key) key))) + (cdr form))) + (label (or (and entry (plist-get (cdr entry) :label)) fallback))) + (if (eq key (etaf-value (plist-get model :filter))) + (concat "● " label) + label))) + +(defun etaf-research-shelf--filter-view (model form) + "Return the filter rail from MODEL and static FILTER FORM." + (etaf-view + (column :class "research-shelf-filter-rail" :width 'stretch + :padding '(1 1) + :border (etaf-research-shelf--color model :line) + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel) + (label :text "Library" :face 'bold + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel)) + (label :text "VIEWS" :color (etaf-research-shelf--color model :muted) + :bgcolor (etaf-research-shelf--color model :panel)) + (button :label (etaf-research-shelf--filter-label model form 'all "All") + :ref 'research-shelf-filter-all + :variant (if (eq (etaf-value (plist-get model :filter)) 'all) + 'secondary 'ghost) + :on-press (lambda () + (etaf-research-shelf--set-filter model 'all))) + (button :label (etaf-research-shelf--filter-label + model form 'reading "In progress") + :ref 'research-shelf-filter-reading + :variant (if (eq (etaf-value (plist-get model :filter)) 'reading) + 'secondary 'ghost) + :on-press (lambda () + (etaf-research-shelf--set-filter model 'reading))) + (button :label (etaf-research-shelf--filter-label + model form 'unread "Unread") + :ref 'research-shelf-filter-unread + :variant (if (eq (etaf-value (plist-get model :filter)) 'unread) + 'secondary 'ghost) + :on-press (lambda () + (etaf-research-shelf--set-filter model 'unread))) + (button :label (etaf-research-shelf--filter-label + model form 'finished "Finished") + :ref 'research-shelf-filter-finished + :variant (if (eq (etaf-value (plist-get model :filter)) 'finished) + 'secondary 'ghost) + :on-press (lambda () + (etaf-research-shelf--set-filter model 'finished))) + (button :label (etaf-research-shelf--filter-label + model form 'starred "★ Starred") + :ref 'research-shelf-filter-starred + :variant (if (eq (etaf-value (plist-get model :filter)) 'starred) + 'secondary 'ghost) + :on-press (lambda () + (etaf-research-shelf--set-filter model 'starred))) + (spacer :height 1) + (label :text "STORAGE" :color (etaf-research-shelf--color model :muted) + :bgcolor (etaf-research-shelf--color model :panel)) + (label :text (file-name-nondirectory + (plist-get model :database-file)) + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel)) + (button :label "↻ Reload library" :ref 'research-shelf-reload + :variant 'ghost + :on-press (lambda () (etaf-research-shelf--load model "✓ Library reloaded")))))) + +(defun etaf-research-shelf--row-press (model row) + "Select ROW as the single current record in MODEL." + (etaf-data-select-one (etaf-research-shelf--controller model) + (plist-get row :id))) + +(defun etaf-research-shelf--reading-list-view (model form) + "Return the main reading list for MODEL and static MAIN FORM." + (let ((controller (etaf-research-shelf--controller model))) + (etaf-view + (column :class "research-shelf-list" :width 'stretch + :padding '(1 2) + :border (etaf-research-shelf--color model :line) + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel) + (flex :width 'stretch :align-items 'center :gap '(1 (8)) + (column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 + (label :text (etaf-research-shelf--static-value form :title + "Reading queue") + :face 'bold + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel)) + (label :text (format "%d items · SQLite-backed" + (or (etaf-value (etaf-data-total controller)) 0)) + :color (etaf-research-shelf--color model :muted) + :bgcolor (etaf-research-shelf--color model :panel))) + (button :label "＋ Add reading" :ref 'research-shelf-add + :variant 'secondary + :on-press + (lambda () + (let ((id (etaf-value (plist-get model :next-id)))) + (etaf-research-shelf--mutate + model 'insert + (list :id id :title (format "New reading %d" id) + :author "You" :kind "Notes" :status "unread" + :progress 0 :priority "Medium" :starred 0 + :note "A new note waiting for your attention." + :updated "Just now") + "✓ Added to your shelf") + (setf (etaf-value (plist-get model :next-id)) (1+ id)))))) + (data-grid + :controller controller + :columns '((:key :title :label "Title" :width 30) + (:key :author :label "Author" :width 16) + (:key :status :label "Status" :width 14) + (:key :progress :label "Progress" :width 10) + (:key :kind :label "Kind" :width 10)) + :row-key (lambda (row) (plist-get row :id)) + :row-ref (lambda (row) + (intern (format "research-shelf-row-%s" + (plist-get row :id)))) + :row-selected-p + (lambda (row) + (etaf-data-selected-p controller (plist-get row :id))) + :on-row-press (lambda (row) (etaf-research-shelf--row-press model row)) + :loading-label "◷ Loading library…" + :error-label "⚠ Could not read the shelf. Use Reload.") + (etaf-pagination :controller controller + :previous-ref 'research-shelf-page-previous + :next-ref 'research-shelf-page-next + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel)))))) + +(defun etaf-research-shelf--detail-view (model form) + "Return the selected record inspector for MODEL and static FORM." + (etaf-view + (column :class "research-shelf-detail" :width 'stretch + :padding '(2 2) + :border (etaf-research-shelf--color model :line) + :color (etaf-research-shelf--color model :ink) + :bgcolor (etaf-research-shelf--color model :panel) + (label :text (etaf-research-shelf--static-value form :title + "Selected item") + :color (etaf-research-shelf--color model :accent) + :bgcolor (etaf-research-shelf--color model :panel)) + (text :face 'bold + (expr :value + (if-let ((row (etaf-research-shelf--selected model))) + (plist-get row :title) + "Choose a record"))) + (text :color (etaf-research-shelf--color model :muted) + (expr :value + (if-let ((row (etaf-research-shelf--selected model))) + (format "%s · %s" (plist-get row :author) + (plist-get row :kind)) + "Select one row to inspect it."))) + (spacer :height 1) + (text :face 'bold + (expr :value + (if-let ((row (etaf-research-shelf--selected model))) + (etaf-research-shelf--status-label (plist-get row :status)) + "○ No selection"))) + (text + (expr :value + (if-let ((row (etaf-research-shelf--selected model))) + (format "Progress %d%% · Priority %s" + (or (plist-get row :progress) 0) + (plist-get row :priority)) + "Progress — · Priority —"))) + (text :color (etaf-research-shelf--color model :accent) + (expr :value + (let* ((row (etaf-research-shelf--selected model)) + (progress (or (and row (plist-get row :progress)) 0)) + (filled (max 0 (min 10 (/ progress 10))))) + (format "%s %s" (make-string filled ?█) + (make-string (- 10 filled) ?░))))) + (spacer :height 1) + (text :color (etaf-research-shelf--color model :muted) + (expr :value + (if-let ((row (etaf-research-shelf--selected model))) + (concat "“" (or (plist-get row :note) "No note yet.") "”") + "Your notes and actions will appear here."))) + (spacer :height 1) + (etaf-research-shelf-detail-actions :model model)))) + +(etaf-define-component etaf-research-shelf-detail-actions (&key model) + "Render stable selected-record actions for MODEL." + :setup + (let ((model (etaf-current-prop :model))) + (lambda () + (let* ((row (etaf-research-shelf--selected model)) + (progress (or (and row (plist-get row :progress)) 0)) + (finished (and row (equal (plist-get row :status) "finished"))) + (archived (and row (equal (plist-get row :status) "archived")))) + (etaf-view + (flex :width 'stretch :flex-wrap 'wrap :gap '(1 (6)) + (button :label "+ 10%" :ref 'research-shelf-progress + :variant 'secondary :disabled (or (null row) (>= progress 100)) + :on-press + (lambda () + (when-let* ((current (etaf-research-shelf--selected model)) + (value (or (plist-get current :progress) 0))) + (etaf-research-shelf--update-selected + model (list :progress (min 100 (+ value 10)) + :status (if (>= (+ value 10) 100) + "finished" "reading") + :updated "Just now") + "✓ Progress saved")))) + (button :label "✓ Finish" :ref 'research-shelf-finish + :variant 'secondary :disabled (or (null row) finished) + :on-press + (lambda () + (etaf-research-shelf--update-selected + model '(:progress 100 :status "finished" :updated "Just now") + "✓ Marked finished"))) + (button :label "★ Star" :ref 'research-shelf-star :variant 'ghost + :disabled (null row) + :on-press + (lambda () + (when-let ((current (etaf-research-shelf--selected model))) + (let ((current-starred + (= 1 (or (plist-get current :starred) 0)))) + (etaf-research-shelf--update-selected + model (list :starred (if current-starred 0 1) + :updated "Just now") + (if current-starred + "Removed star" "★ Starred locally")))))) + (button :label "Archive" :ref 'research-shelf-archive + :variant 'ghost :disabled (or (null row) archived) + :on-press + (lambda () + (etaf-research-shelf--update-selected + model '(:status "archived" :updated "Just now") + "↗ Archived"))))))))) + +(etaf-define-component etaf-research-shelf-filter-rail + (&key model static-form) + "Render the reusable Research Shelf filter rail. + +The rail is a Component boundary so its button Components remain ordinary +structural children instead of leaking through a direct material `expr'." + :setup + (let ((model (etaf-current-prop :model)) + (static-form (etaf-current-prop :static-form))) + (lambda () (etaf-research-shelf--filter-view model static-form)))) + +(etaf-define-component etaf-research-shelf-reading-list + (&key model static-form) + "Render the reusable Research Shelf reading list." + :setup + (let ((model (etaf-current-prop :model)) + (static-form (etaf-current-prop :static-form))) + (lambda () (etaf-research-shelf--reading-list-view model static-form)))) + +(etaf-define-component etaf-research-shelf-detail-inspector + (&key model static-form) + "Render the reusable Research Shelf detail inspector." + :setup + (let ((model (etaf-current-prop :model)) + (static-form (etaf-current-prop :static-form))) + (lambda () (etaf-research-shelf--detail-view model static-form)))) + +(etaf-define-component etaf-research-shelf-shell (&key model static-form) + "Compose the SQLite-backed Research Shelf application." + :styles + (styles + (".research-shelf-shell" :width stretch) + (".research-shelf-header" :width stretch :padding (1 0)) + (".research-shelf-filter-rail" :width stretch) + (".research-shelf-list" :width stretch) + (".research-shelf-detail" :width stretch) + (".research-shelf-footer" :width stretch :padding (0 1))) + :setup + (let ((model (etaf-current-prop :model)) + (static-form (etaf-current-prop :static-form))) + (etaf-on-unmounted + (lambda () (etaf-data-stop (etaf-research-shelf--controller model)))) + (lambda () + (let* ((header (etaf-research-shelf--static-child static-form 'header)) + (filters (etaf-research-shelf--static-child static-form 'filters)) + (main (etaf-research-shelf--static-child static-form 'main)) + (library (etaf-research-shelf--static-child main 'library)) + (detail (etaf-research-shelf--static-child main 'detail)) + (dark (etaf-value (plist-get model :dark))) + (palette (etaf-research-shelf--theme model))) + (etaf-view + (column :class "research-shelf-shell" :width '(viewport) + :height '(viewport-height) + :color (plist-get palette :ink) + :bgcolor (plist-get palette :paper) + (flex :class "research-shelf-header" :width 'stretch + :align-items 'center :gap '(1 (10)) + (column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 + (label :text (etaf-research-shelf--static-value + header :eyebrow "Research Shelf") + :color (plist-get palette :accent) + :bgcolor (plist-get palette :paper)) + (label :text (etaf-research-shelf--static-value + static-form :title "Research Shelf") :face 'bold + :color (plist-get palette :ink) + :bgcolor (plist-get palette :paper)) + (label :text (etaf-research-shelf--static-value + static-form :subtitle "A quiet place for unfinished ideas") + :color (plist-get palette :muted) + :bgcolor (plist-get palette :paper))) + (checkbox :label "Dark" :ref 'research-shelf-theme-toggle + :checked dark + :on-change (lambda (value) + (setf (etaf-value (plist-get model :dark)) value) + (setf (etaf-value (plist-get model :toast)) + (if value "Dark theme" "Light theme"))))) + (grid :class "research-shelf-workspace" :width 'stretch + :grid-template-columns '(2fr 5fr 3fr) :gap '(1 (10)) + :color (plist-get palette :ink) + :bgcolor (plist-get palette :paper) + (etaf-research-shelf-filter-rail :model model :static-form filters) + (etaf-research-shelf-reading-list :model model :static-form library) + (etaf-research-shelf-detail-inspector :model model :static-form detail)) + (flex :class "research-shelf-footer" :width 'stretch :gap '(1 (8)) + (column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0 + (label :text (or (etaf-value (plist-get model :toast)) "Ready") + :color (plist-get palette :ink) + :bgcolor (plist-get palette :paper))) + (label :text (file-name-nondirectory + (plist-get model :database-file)) + :color (plist-get palette :muted) + :bgcolor (plist-get palette :paper))))))))) + +(defun etaf-research-shelf-view (model static-form) + "Return the root View for MODEL and validated STATIC-FORM." + (etaf-view (research-shelf-shell :model model :static-form static-form))) + +(defun etaf-research-shelf-root (static-form) + "Consume validated STATIC-FORM and return one owned application root View." + (unless (eq (car static-form) 'research-shelf-shell) + (error "Unsupported Research Shelf static root: %S" static-form)) + (let ((model (etaf-research-shelf--create-model))) + ;; Load before the first retained generation. A DataGrid that is created + ;; empty and populated from an on-mounted callback has no committed + ;; material artifact to use as its first incremental anchor. + (etaf-research-shelf--load model "✓ SQLite shelf ready") + (lambda () (etaf-research-shelf-view model static-form)))) + +;;;###autoload +(defun etaf-research-shelf-open (&optional buffer-name) + "Mount and optionally display the Research Shelf application in BUFFER-NAME." + (interactive) + (let ((buffer (etaf-mount (or buffer-name "*ETAF Research Shelf*") + (etaf-research-shelf-root + (etaf-playground-read-static "research-shelf"))))) + (when (called-interactively-p 'interactive) (pop-to-buffer buffer)) + buffer)) + +(provide 'etaf-research-shelf) +;;; research-shelf.el ends here diff --git a/examples/research-shelf.etaf b/examples/research-shelf.etaf new file mode 100644 index 0000000..9ac2214 --- /dev/null +++ b/examples/research-shelf.etaf @@ -0,0 +1,16 @@ +;; Static composition only. Storage, state, Components, and events live in +;; the same-basename `.el' companion. +(research-shelf-shell + :title "Research Shelf" + :subtitle "A quiet place for unfinished ideas" + (header :eyebrow "A quiet place for unfinished ideas") + (filters + (filter :key all :label "All") + (filter :key reading :label "In progress") + (filter :key unread :label "Unread") + (filter :key finished :label "Finished") + (filter :key starred :label "★ Starred")) + (main + (library :title "Reading queue") + (detail :title "Selected item")) + (footer :label "SQLite · saved locally")) diff --git a/scripts/benchmark-research-shelf.el b/scripts/benchmark-research-shelf.el new file mode 100644 index 0000000..d41178a --- /dev/null +++ b/scripts/benchmark-research-shelf.el @@ -0,0 +1,87 @@ +;;; benchmark-research-shelf.el --- Research Shelf latency gate -*- lexical-binding: t; -*- + +;;; Commentary: +;; Reproducible fullscreen-equivalent warm interaction benchmark. The process +;; exits nonzero when the declared p50/max budgets are exceeded. + +;;; Code: +(require 'cl-lib) +(require 'etaf-playground) + +(defconst etaf-research-shelf-benchmark-row-p50-budget-ms 100.0) +(defconst etaf-research-shelf-benchmark-row-max-budget-ms 250.0) +(defconst etaf-research-shelf-benchmark-theme-p50-budget-ms 250.0) +(defconst etaf-research-shelf-benchmark-theme-max-budget-ms 500.0) + +(defun etaf-research-shelf-benchmark--percentile (samples percentile) + "Return PERCENTILE from numeric SAMPLES using nearest rank." + (let* ((ordered (sort (copy-sequence samples) #'<)) + (index (min (1- (length ordered)) + (floor (* percentile (length ordered)))))) + (nth index ordered))) + +(defun etaf-research-shelf-benchmark--measure (runtime refs runs) + "Measure warm press events through RUNTIME while cycling REFS. +The number of measured events is `RUNS'." + (cl-loop for index below runs + for ref = (nth (% index (length refs)) refs) + collect + (let ((started (float-time))) + (etaf-dispatch-event runtime ref 'press) + (* 1000.0 (- (float-time) started))))) + +(defun etaf-research-shelf-benchmark--summary (label samples) + "Print and return LABEL summary for SAMPLES." + (let ((p50 (etaf-research-shelf-benchmark--percentile samples 0.5)) + (maximum (apply #'max samples))) + (princ (format "%s p50=%.3fms max=%.3fms samples=%S\n" + label p50 maximum samples)) + (list :p50 p50 :max maximum))) + +(defun etaf-research-shelf-benchmark-run () + "Run the Research Shelf evaluator and return non-nil on success." + (load-file (expand-file-name "examples/research-shelf.el" + default-directory)) + (let ((database (make-temp-file "etaf-research-shelf-perf-" nil ".sqlite")) + (buffer " *etaf-research-shelf-perf*")) + (unwind-protect + (let ((etaf-research-shelf-database-file database)) + (ignore etaf-research-shelf-database-file) + (etaf-playground-open buffer) + (ebox-surface-update-buffer-viewport (get-buffer buffer) 1413 62) + (let ((runtime (etaf-runtime-for-buffer buffer))) + ;; Prewarm both structural states before collecting evidence. + (etaf-dispatch-event runtime 'research-shelf-row-1 'press) + (etaf-dispatch-event runtime 'research-shelf-row-2 'press) + (etaf-dispatch-event runtime 'research-shelf-theme-toggle 'press) + (etaf-dispatch-event runtime 'research-shelf-theme-toggle 'press) + (let* ((row (etaf-research-shelf-benchmark--summary + "row-selection" + (etaf-research-shelf-benchmark--measure + runtime '(research-shelf-row-1 research-shelf-row-2) 8))) + (theme (etaf-research-shelf-benchmark--summary + "theme-toggle" + (etaf-research-shelf-benchmark--measure + runtime '(research-shelf-theme-toggle) 8))) + (pass + (and (<= (plist-get row :p50) + etaf-research-shelf-benchmark-row-p50-budget-ms) + (<= (plist-get row :max) + etaf-research-shelf-benchmark-row-max-budget-ms) + (<= (plist-get theme :p50) + etaf-research-shelf-benchmark-theme-p50-budget-ms) + (<= (plist-get theme :max) + etaf-research-shelf-benchmark-theme-max-budget-ms)))) + (princ (format "research-shelf-perf %s\n" + (if pass "PASS" "FAIL"))) + (unless pass + (error "Research Shelf interaction latency budget exceeded")) + t))) + (when (get-buffer buffer) + (etaf-playground-close buffer)) + (when (file-exists-p database) + (delete-file database))))) + +(etaf-research-shelf-benchmark-run) + +;;; benchmark-research-shelf.el ends here diff --git a/tests/etaf-playground-tests.el b/tests/etaf-playground-tests.el index fa4ca2a..2979122 100644 --- a/tests/etaf-playground-tests.el +++ b/tests/etaf-playground-tests.el @@ -1,33 +1,79 @@ -;;; etaf-playground-tests.el --- operations-console pair contract -*- lexical-binding: t; -*- +;;; etaf-playground-tests.el --- Research Shelf pair contract -*- lexical-binding: t; -*- + +;;; Commentary: +;; These tests exercise the generic pair boundary and one real application. +;; The framework tests never reach into the application's model; application +;; tests drive only public refs/events and observe the rendered surface. + ;;; Code: +(require 'cl-lib) (require 'ert) (require 'etaf-playground) -(defvar etaf-operations-console-cleanup-count) + +(defun etaf-playground-test--ensure-app-loaded () + "Load the same-basename Research Shelf companion for test setup." + (unless (featurep 'etaf-research-shelf) + (load-file (expand-file-name "examples/research-shelf.el" + default-directory)))) (defun etaf-playground-test--text (buffer) - "Return BUFFER plain text." - (with-current-buffer buffer (substring-no-properties (buffer-string)))) + "Return BUFFER's plain rendered text." + (with-current-buffer buffer + (substring-no-properties (buffer-string)))) (defun etaf-playground-test--close (buffer) "Close BUFFER when it exists." - (when (get-buffer buffer) (etaf-playground-close buffer))) + (when (get-buffer buffer) + (etaf-playground-close buffer))) -(ert-deftest etaf-playground-manifest-has-one-reviewed-pair () - "Expose only the operations-console pair and keep old examples inactive." - (should (equal '("operations-console") etaf-playground-example-names)) +(defmacro etaf-playground-test--with-app (variables &rest body) + "Run BODY with VARIABLES. +VARIABLES is a `(BUFFER DATABASE)' list; the macro creates a temporary SQLite +database and mounts a test buffer before running BODY." + (declare (indent 1)) + (let ((buffer (car variables)) + (database (cadr variables))) + (unless (and (symbolp buffer) (symbolp database)) + (error "Expected (BUFFER DATABASE) variables, got %S" variables)) + `(let* ((,database (make-temp-file "etaf-research-shelf-" nil ".sqlite")) + (,buffer " *etaf-research-shelf-test*")) + (ignore ,database) + (etaf-playground-test--ensure-app-loaded) + (unwind-protect + (let ((etaf-research-shelf-database-file ,database)) + (ignore etaf-research-shelf-database-file) + ,@body) + (etaf-playground-test--close ,buffer) + (when (file-exists-p ,database) + (delete-file ,database)))))) + +(ert-deftest etaf-playground-manifest-describes-one-pair () + "Expose one reviewed pair through a generic manifest." + (should (equal '("research-shelf") etaf-playground-example-names)) (should (= 1 (length etaf-playground-scenario-manifest))) (let ((entry (car etaf-playground-scenario-manifest)) + (framework (with-temp-buffer + (insert-file-contents "etaf-playground.el") + (buffer-string))) + (catalog (with-temp-buffer + (insert-file-contents "etaf-playground-catalog.el") + (buffer-string))) (makefile (with-temp-buffer - (insert-file-contents "Makefile") (buffer-string)))) - (dolist (key '(:pair :root-component :capabilities :refs - :gui-checkpoints :performance)) + (insert-file-contents "Makefile") + (buffer-string)))) + (dolist (key '(:pair :root-component :companion-feature :static-tags + :capabilities :refs :gui-checkpoints :performance)) (should (plist-member entry key))) (should (string-match-p - "EXAMPLE_EL := examples/operations-console.el" makefile)) - (should-not (string-match-p "wildcard examples" makefile)))) + "EXAMPLE_EL := examples/research-shelf.el" makefile)) + (should-not (string-match-p "wildcard examples" makefile)) + (should-not (string-match-p "require.*etaf-sqlite" framework)) + (should-not (string-match-p "research-shelf" framework)) + (should-not (string-match-p "operations-console" framework)) + (should (string-match-p "research-shelf" catalog)))) -(ert-deftest etaf-playground-compile-builds-bytecode-dependencies () - "Integration builds must not silently fall back to interpreted dependencies." +(ert-deftest etaf-playground-compile-builds-the-dependency-graph () + "Integration builds must compile the framework's dependency graph first." (let ((makefile (with-temp-buffer (insert-file-contents "Makefile") (buffer-string)))) @@ -35,351 +81,136 @@ "$(MAKE) -C ../tp compile" "$(MAKE) -C ../ebox compile" "$(MAKE) -C ../etaf compile" - "$(MAKE) -C ../etaf-ui compile")) + "$(MAKE) -C ../etaf-ui compile" + "$(MAKE) -C ../etaf-sqlite compile")) (should (string-match-p (regexp-quote dependency) makefile))))) (ert-deftest etaf-playground-static-reader-is-inert-and-strict () - "Read static data without companion execution and reject unsafe AST nodes." - (when (featurep 'etaf-operations-console) - (unload-feature 'etaf-operations-console t)) - (let ((form (etaf-playground-read-static "operations-console"))) - (should (equal (car form) 'operations-console-shell)) - (should (equal (plist-get (cdr form) :title) "Operations Console")) + "Read pair structure as inert data and reject executable AST nodes." + (let* ((form (etaf-playground-read-static "research-shelf")) + (tags (plist-get (etaf-playground-scenario "research-shelf") + :static-tags))) + (should (equal (car form) 'research-shelf-shell)) + (should (equal (plist-get (cdr form) :title) "Research Shelf")) (should (equal (mapcar #'car (cl-remove-if-not #'consp (cdr form))) - '(header navigation main status)))) - (should-not (featurep 'etaf-operations-console)) - (dolist (form '((lambda () 1) (eval '(message "x")) - (etaf--private) (ebox--private) (shell-command "x"))) - (should-error (etaf-playground--validate-static-node form) :type 'error))) + '(header filters main footer))) + (let* ((filters (cl-find-if + (lambda (entry) (and (consp entry) + (eq (car entry) 'filters))) + (cdr form))) + (all-filter (cl-find-if + (lambda (entry) (and (consp entry) + (eq (car entry) 'filter) + (eq (plist-get (cdr entry) :key) + 'all))) + (cdr filters)))) + (should all-filter)) + (dolist (unsafe '((lambda () 1) (eval '(message "x")) + (etaf--private) (ebox--private) (shell-command "x"))) + (should-error (etaf-playground--validate-static-node unsafe tags) + :type 'error)))) -(ert-deftest etaf-playground-pair-load-and-mount-is-repeatable () - "Load the same pair twice and mount/unmount it twice without stale state." - (let ((buffer " *etaf-operations-console-pair-test*")) - (unwind-protect - (dotimes (_iteration 2) - (let ((form (etaf-playground-read-static "operations-console"))) - (should (equal (car form) 'operations-console-shell)) - (should (equal (mapcar #'car - (cl-remove-if-not #'consp (cdr form))) - '(header navigation main status)))) - (etaf-playground-mount-example buffer "operations-console") - (should (etaf-runtime-p (etaf-runtime-for-buffer buffer))) - (should (string-match-p "Operations Console" - (etaf-playground-test--text buffer))) - (etaf-unmount (etaf-runtime-for-buffer buffer)) - (when (get-buffer buffer) (kill-buffer buffer)) - (should-not (etaf-runtime-for-buffer buffer))) - (etaf-playground-test--close buffer)) - (should-not (etaf-runtime-for-buffer buffer)))) +(ert-deftest etaf-playground-pair-mounts-sqlite-backed-surface () + "Mounting the pair initializes SQLite and renders the real app shell." + (etaf-playground-test--with-app (buffer database) + (etaf-playground-open buffer) + (should (etaf-runtime-p (etaf-runtime-for-buffer buffer))) + (should (file-exists-p database)) + (let ((text (etaf-playground-test--text buffer)) + (runtime (etaf-runtime-for-buffer buffer))) + (should (string-match-p "Research Shelf" text)) + (should (string-match-p "8 items · SQLite-backed" text)) + (should (string-match-p "The Shape of Tools" text)) + (dolist (ref '(research-shelf-filter-all research-shelf-filter-reading + research-shelf-filter-unread research-shelf-filter-finished + research-shelf-filter-starred research-shelf-reload + research-shelf-add research-shelf-page-next + research-shelf-theme-toggle)) + (should (etaf-runtime-handler-for runtime ref)))))) -(ert-deftest etaf-playground-operations-console-drives-public-refs () - "Drive representative app capabilities through public event/focus ports." - (let ((buffer " *etaf-operations-console-actions-test*")) - (unwind-protect - (progn - (dolist (entry - '((operations-console-alpha-increment) - (operations-console-alpha-reset) - (operations-console-beta-increment) - (operations-console-beta-reset) - (operations-console-local-callback) - (operations-console-named-action) - (operations-console-behavior-toggle) - (operations-console-theme-toggle) - (operations-console-nav-data) - (operations-console-clear-selection operations-console-nav-data) - (operations-console-row-1 operations-console-nav-data) - (operations-console-row-2 operations-console-nav-data) - (operations-console-row-3 operations-console-nav-data) - (operations-console-nav-resource) - (operations-console-fail-next operations-console-nav-resource) - (operations-console-resource-reload operations-console-nav-resource) - (operations-console-error-boundary operations-console-nav-resource) - (operations-console-nav-overview))) - (etaf-playground-open buffer) - (let* ((runtime (etaf-runtime-for-buffer buffer)) - (ref (car entry)) - (page-ref (cadr entry))) - (when page-ref - (etaf-dispatch-event runtime page-ref 'press)) - (etaf-focus runtime ref) - (should (eq ref (etaf-focused-host-ref runtime))) - (etaf-dispatch-event runtime ref 'press) - (when (eq ref 'operations-console-theme-toggle) - (should (string-match-p - "☑[[:space:]]+Theme" - (etaf-playground-test--text buffer)))) - (etaf-playground-close buffer)))) - (etaf-playground-test--close buffer)))) +(ert-deftest etaf-playground-row-selection-is-repeatable () + "Repeated DataGrid row presses replace one selected identity." + (etaf-playground-test--with-app (buffer database) + (etaf-playground-open buffer) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (dolist (entry '((research-shelf-row-1 research-shelf-row-2 + "The best tools make attention feel larger") + (research-shelf-row-2 research-shelf-row-1 + "Look again at the relationship between image and power") + (research-shelf-row-1 research-shelf-row-2 + "The best tools make attention feel larger") + (research-shelf-row-2 research-shelf-row-1 + "Look again at the relationship between image and power"))) + (let ((selected (nth 0 entry)) + (other (nth 1 entry)) + (detail (nth 2 entry))) + (should (etaf-runtime-handler-for runtime selected)) + (etaf-focus runtime selected) + (etaf-dispatch-event runtime selected 'press) + (let ((text (etaf-playground-test--text buffer))) + (should (string-match-p (regexp-quote detail) text))) + (should (string-match-p + "selected" + (plist-get (etaf-runtime-host-props-for runtime selected) + :class))) + (should-not (string-match-p + "selected" + (plist-get (etaf-runtime-host-props-for runtime other) + :class)))))))) -(ert-deftest etaf-playground-data-grid-row-selection-is-repeatable () - "Repeated row presses replace the single selected row without a bar." - (let ((buffer " *etaf-operations-console-row-selection-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let ((runtime (etaf-runtime-for-buffer buffer))) - (etaf-dispatch-event runtime 'operations-console-nav-data 'press) - (dolist (entry '((operations-console-row-1 . "Selected Ada") - (operations-console-row-2 . "Selected Grace") - (operations-console-row-3 . "Selected Lin") - (operations-console-row-1 . "Selected Ada") - (operations-console-row-2 . "Selected Grace"))) - (etaf-focus runtime (car entry)) - (etaf-dispatch-event runtime (car entry) 'press) - (let ((text (etaf-playground-test--text buffer))) - (should (string-match-p (regexp-quote (cdr entry)) text)) - (should-not (string-match-p "#DCEBDD" text)))))) - (etaf-playground-test--close buffer)))) +(ert-deftest etaf-playground-filters-and-pagination-reload-data () + "Filter and pager refs drive the SQLite-backed Data Controller." + (etaf-playground-test--with-app (buffer database) + (etaf-playground-open buffer) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-dispatch-event runtime 'research-shelf-filter-reading 'press) + (let ((text (etaf-playground-test--text buffer))) + (should (string-match-p "Showing Reading" text)) + (should (string-match-p "Designing for Calm" text)) + (should-not (string-match-p "Ways of Seeing" text))) + (etaf-dispatch-event runtime 'research-shelf-filter-all 'press) + (etaf-dispatch-event runtime 'research-shelf-page-next 'press) + (should (string-match-p "Page 2 / 2" + (etaf-playground-test--text buffer))) + (etaf-dispatch-event runtime 'research-shelf-page-previous 'press) + (should (string-match-p "Page 1 / 2" + (etaf-playground-test--text buffer)))))) -(ert-deftest etaf-playground-behavior-toggle-uses-one-retained-publication () - "Behavior content and paint changes stay in two fixed owners per turn." - (let ((buffer " *etaf-operations-console-behavior-retained-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let* ((runtime (etaf-runtime-for-buffer buffer)) - (surface (with-current-buffer - buffer ebox-surface--buffer-surface)) - (old-commit (symbol-function 'ebox-commit)) - (root-id (plist-get - (plist-get (ebox--buffer-render-state buffer) - :root-node) - :node-id))) - (dotimes (index 4) - (let ((commits 0) - (before (etaf-runtime-generation runtime))) - (cl-letf (((symbol-function 'ebox-commit) - (lambda (&rest args) - (cl-incf commits) - (apply old-commit args)))) - (etaf-dispatch-event runtime - 'operations-console-behavior-toggle - 'press)) - (let ((report (ebox-buffer-update-report buffer))) - (should (= commits 1)) - (should (= 1 (- (etaf-runtime-generation runtime) - before))) - (should (eq (plist-get report :projection-kind) - 'owner-scoped)) - (should-not (plist-get report :tp-full-root)) - (should-not (plist-get report :tp-scope-fallback)) - (should (= 2 (plist-get report :tp-scope-count))) - (should (= 2 (plist-get report :tp-scope-range-count))) - (should (= 2 (plist-get report :tp-text-operations))) - (should-not (member root-id (plist-get report :owner-ids))) - (should (< (plist-get report :reconciled-objects) - (plist-get (tp-surface-inspect surface) - :object-count)))) - (should (string-match-p - (if (cl-evenp index) - "Behavior toggle: on" - "Behavior toggle: off") - (etaf-playground-test--text buffer))))))) - (etaf-playground-test--close buffer)))) +(ert-deftest etaf-playground-mutations-persist-and-refresh () + "Add and mutate actions persist through the SQLite source and refresh UI." + (etaf-playground-test--with-app (buffer database) + (etaf-playground-open buffer) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-dispatch-event runtime 'research-shelf-row-1 'press) + (etaf-dispatch-event runtime 'research-shelf-progress 'press) + (should (string-match-p "Progress saved" + (etaf-playground-test--text buffer))) + (etaf-dispatch-event runtime 'research-shelf-star 'press) + (should (string-match-p "Removed star" + (etaf-playground-test--text buffer))) + (etaf-dispatch-event runtime 'research-shelf-add 'press) + (should (string-match-p "Added to your shelf" + (etaf-playground-test--text buffer))) + (should (file-exists-p database))))) -(ert-deftest etaf-playground-a-theme-toggle-uses-mixed-owner-publication () - "Theme paint plus fixed-slot label changes publish through one mixed owner." - (let ((buffer " *etaf-operations-console-theme-mixed-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let* ((runtime (etaf-runtime-for-buffer buffer)) - (before (etaf-runtime-generation runtime)) - (commits 0) - (old-commit (symbol-function 'ebox-commit))) - (cl-letf (((symbol-function 'ebox-commit) - (lambda (&rest args) - (cl-incf commits) - (apply old-commit args)))) - (etaf-dispatch-event runtime - 'operations-console-theme-toggle - 'press)) - (let ((report (ebox-buffer-update-report buffer))) - (should (= commits 1)) - (should (= 1 (- (etaf-runtime-generation runtime) before))) - (should (eq (plist-get report :projection-kind) - 'mixed-owner-reflow)) - (should-not (plist-get report :tp-full-root)) - (should-not (plist-get report :tp-scope-fallback)) - (should-not - (member (ebox--buffer-root-node-id buffer) - (plist-get report :owner-ids))) - (should (string-match-p "☑[[:space:]]+Theme" - (etaf-playground-test--text buffer))) - (should (string-match-p "Theme: Dark" - (etaf-playground-test--text buffer)))))) - (etaf-playground-test--close buffer)))) - -(ert-deftest etaf-playground-a-theme-toggle-after-navigation-retires-nested-range-effects () - "Theme changes after page navigation must not reuse removed Range anchors." - (let ((buffer " *etaf-operations-console-theme-after-navigation-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let* ((runtime (etaf-runtime-for-buffer buffer)) - (before (etaf-runtime-generation runtime))) - (etaf-dispatch-event runtime 'operations-console-nav-data 'press) - (dotimes (_ 4) - (etaf-dispatch-event runtime - 'operations-console-theme-toggle 'press)) - (should (= 5 (- (etaf-runtime-generation runtime) before))) - (should (string-match-p "Data desk" - (etaf-playground-test--text buffer))) - (should (string-match-p "Theme: Light" - (etaf-playground-test--text buffer))) - (should (plist-get (ebox-buffer-update-report buffer) - :strategy)) - (let* ((generation (etaf-runtime-current-generation runtime)) - (nodes (etaf-generation-semantic-nodes generation)) - (stale 0)) - (dotimes (effect-id (etaf-runtime-next-effect-id runtime)) - (when-let ((effect (etaf--generation-effect - generation effect-id))) - (unless (etaf--pvec-get - nodes - (etaf--generation-effect-semantic-id effect)) - (cl-incf stale)))) - (should (zerop stale))))) - (etaf-playground-test--close buffer)))) - -(ert-deftest etaf-playground-repeated-counter-press-retains-handler () - "Recreated keyed counter Hosts keep their public handler across turns." - (let ((buffer " *etaf-operations-console-repeat-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let ((runtime (etaf-runtime-for-buffer buffer)) - (old-commit (symbol-function 'ebox-commit))) - (dotimes (expected 3) - (let ((commits 0) - (before (etaf-runtime-generation runtime))) - (cl-letf (((symbol-function 'ebox-commit) - (lambda (&rest args) - (cl-incf commits) - (apply old-commit args)))) - (etaf-dispatch-event runtime - 'operations-console-alpha-increment 'press)) - (should (= commits 1)) - (should (= 1 (- (etaf-runtime-generation runtime) before)))) - (should (etaf-runtime-handler-for - runtime 'operations-console-alpha-increment)) - (should (string-match-p - (format "Value: %d" (1+ expected)) - (etaf-playground-test--text buffer)))))) - (etaf-playground-test--close buffer)))) - -(ert-deftest etaf-playground-reset-and-close-use-pair-boundary () - "Reset the sole pair and leave no mounted Runtime after close." - (let ((buffer " *etaf-operations-console-reset-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (etaf-playground-reset buffer) - (should (etaf-runtime-for-buffer buffer)) - (etaf-playground-close buffer) - (should-not (get-buffer buffer))) - (etaf-playground-test--close buffer)))) - -(ert-deftest etaf-playground-navigation-swaps-one-page-subtree () - "Show exactly the selected Overview, Data, or Resource page." - (let ((buffer " *etaf-operations-console-navigation-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let* ((runtime (etaf-runtime-for-buffer buffer)) - (root-id - (plist-get - (plist-get (ebox--buffer-render-state buffer) - :root-node) - :node-id))) - (should (string-match-p "Counter alpha" - (etaf-playground-test--text buffer))) - (etaf-dispatch-event runtime 'operations-console-nav-data 'press) - (should (string-match-p "Data Controller" - (etaf-playground-test--text buffer))) - (let ((report (ebox-buffer-update-report buffer))) - (should-not (plist-get report :tp-full-root)) - (should-not (plist-get report :tp-scope-fallback)) - (should (plist-get report :range-metrics)) - (should-not (member root-id (plist-get report :owner-ids))) - (should (= 1 (plist-get report :tp-scope-range-count)))) - (should-not (string-match-p "Counter alpha" - (etaf-playground-test--text buffer))) - (etaf-dispatch-event runtime 'operations-console-nav-resource 'press) - (should (string-match-p "Resource and Error Boundary" - (etaf-playground-test--text buffer))) - (should-not (string-match-p "Data Controller" - (etaf-playground-test--text buffer))) - (etaf-dispatch-event runtime 'operations-console-nav-overview 'press) - (should (string-match-p "Counter alpha" - (etaf-playground-test--text buffer))))) - (etaf-playground-test--close buffer)))) - -(ert-deftest etaf-playground-controls-use-intrinsic-single-line-widths () - "Keep navigation and action controls on their owning row without clipping." - (let ((buffer " *etaf-operations-console-control-width-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (let ((runtime (etaf-runtime-for-buffer buffer))) - (let ((nav (etaf-host-ref-bounds runtime 'operations-console-nav)) - (main (etaf-host-ref-bounds runtime 'operations-console-main)) - (status (etaf-host-ref-bounds runtime - 'operations-console-status))) - ;; These are vertical shell siblings. If the navigation flex - ;; group is accidentally left open, MAIN and STATUS become row - ;; children and the whole application is laid out horizontally. - (with-current-buffer buffer - (should (< (line-number-at-pos (car nav)) - (line-number-at-pos (car main)))) - (should (< (line-number-at-pos (car main)) - (line-number-at-pos (car status)))))) - (dolist (refs '((operations-console-nav-overview - operations-console-nav-data - operations-console-nav-resource - operations-console-theme-toggle) - (operations-console-local-callback - operations-console-named-action - operations-console-behavior-toggle))) - (let (lines) - (dolist (ref refs) - (let ((bounds (etaf-host-ref-bounds runtime ref))) - (should bounds) - (with-current-buffer buffer - (push (line-number-at-pos (car bounds)) lines) - (should (<= (cdr bounds) (point-max)))))) - (should (= 1 (length (delete-dups lines)))) - ;; The navigation owner declares a pixel gap so adjacent - ;; mouse-face ranges remain distinct controls. - (should (equal - (plist-get - (gethash 'operations-console-nav - (etaf-runtime-host-props runtime)) - :gap) - '(0 (8)))))))) - (etaf-playground-test--close buffer)))) - -(ert-deftest etaf-playground-fixed-viewport-layout-does-not-double-width () - "Keep every rendered line inside the containing viewport after reflow." - (let ((buffer " *etaf-operations-console-width-test*")) - (unwind-protect - (progn - (etaf-playground-open buffer) - (ebox-surface-update-buffer-viewport (get-buffer buffer) 1413 60) - (with-current-buffer buffer - (let (widths) - (goto-char (point-min)) - (while (< (point) (point-max)) - (push (ebox--string-pixel-width - (buffer-substring (point) (line-end-position))) - widths) - (forward-line 1)) - (setq widths (nreverse widths)) - (should (= 60 (length widths))) - (should (<= (apply #'max widths) 1413))))) - (etaf-playground-test--close buffer)))) +(ert-deftest etaf-playground-theme-and-lifecycle-are-repeatable () + "Theme changes and reset/close do not leave a stale mounted runtime." + (etaf-playground-test--with-app (buffer database) + (etaf-playground-open buffer) + (let ((runtime (etaf-runtime-for-buffer buffer))) + (etaf-dispatch-event runtime 'research-shelf-row-1 'press) + (dotimes (_ 4) + (etaf-dispatch-event runtime 'research-shelf-theme-toggle 'press)) + (should (string-match-p "The Shape of Tools" + (etaf-playground-test--text buffer))) + (should (or (string-match-p "☑ Dark" + (etaf-playground-test--text buffer)) + (string-match-p "☐ Dark" + (etaf-playground-test--text buffer))))) + (etaf-playground-reset buffer) + (should (etaf-runtime-p (etaf-runtime-for-buffer buffer)))) + (should-not (get-buffer " *etaf-research-shelf-test*"))) (provide 'etaf-playground-tests) ;;; etaf-playground-tests.el ends here