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
-
-
-
-
-
-
-
-
- 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.
- Throughput2.4k
↑ 18% this weekActive flows18
+3 since 08:00Response42ms
p95 within targetReliability99.8%
steady
- ↗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 ✓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.
-
Surface mountedOperations Console is ready for review.
Data controller loaded3 records are available in the Data desk.
-
- IDNAMESTATUSOWNER
Select a row to inspect it.Selection updates the status without rebuilding the shell.
- Loaded value 7Owned by the current application mount.
No boundary run yetRun the boundary to see a handled error while the rest of the application stays mounted.
cleanup calls after mount / reload / unmount
-
-
-
-
-
-
-
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
+
+
+
+
+
+
+
+
+
+
+ Reading queue
12 records · page 1
+ TitleStatusProgressKind
+
+
+
+
+
+
+
+
+
+
+
+
+
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