From ae76271e811d4c3c1fbc9dec1acb3b947c7880e9 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Mon, 24 Aug 2026 02:08:54 +0800 Subject: [PATCH] Simplify Research Shelf authoring workflow --- DESIGN.md | 79 +- DESIGN.zh-CN.md | 58 +- Makefile | 17 +- README.md | 56 +- README.zh-CN.md | 49 +- etaf-playground-catalog.el | 31 - etaf-playground.el | 1079 +++++++++++++++++++++++---- examples/research-shelf.ecss | 10 + examples/research-shelf.el | 799 ++++++++++---------- scripts/benchmark-research-shelf.el | 12 +- tests/etaf-playground-tests.el | 199 ++++- 11 files changed, 1728 insertions(+), 661 deletions(-) delete mode 100644 etaf-playground-catalog.el create mode 100644 examples/research-shelf.ecss diff --git a/DESIGN.md b/DESIGN.md index ddb97b6..4ad964d 100644 --- a/DESIGN.md +++ b/DESIGN.md @@ -3,8 +3,9 @@ ## Source of truth - Status: Active -- Last refreshed: 2026-08-22 -- Primary product surface: `examples/research-shelf.etaf` + `examples/research-shelf.el` +- Last refreshed: 2026-08-23 +- Primary product surface: generic `etaf-playground.el` workspace plus the + `examples/research-shelf.etaf` / `.el` / `.ecss` consumer triplet - 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 @@ -92,20 +93,46 @@ ## 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. +- `etaf-playground.el` is a reusable source/preview workspace, not an + application module. It discovers same-basename `.etaf`/`.el` files and an + optional `.ecss` file, creates the left source session, and mounts the right + preview. +- The framework owns inert source readers, companion registration overrides, + source tabs, window layout, refresh/reset/close, and ETAF Runtime lifecycle. + It does not require a catalog or name a business application. +- A companion owns its Components, storage adapters, state, resources, events, + style consumers, and root factory. The framework must not reference a + business component, database package, table schema, palette, or + application-specific ref. +- `.etaf` and `.ecss` are read as data. `.el` is evaluated only when a preview + is first loaded or the companion source is explicitly dirty; normal ETAF + duplicate-definition errors remain intact outside that deliberate reload + boundary. +- New examples add a same-basename `.etaf`/`.el` pair and may add `.ecss`; the + generic framework and its build file do not change. + +## Research Shelf companion boundary + +Research Shelf is intentionally compact: the executable companion is one file, +with comments making the small app's boundaries visible: + +```text +examples/research-shelf.etaf inert structure source +examples/research-shelf.ecss inert style source +examples/research-shelf.el DATA / THEME / STATE / VIEW / ROOT +``` + +The `.el` file is the only Playground registration point and palette owner: +its THEME section may use the optional `etaf-theme-tp` adapter to turn +TP light/dark pairs into an ETAF semantic Theme plist. The rest of the app +never calls TP or embeds renderer palette names. The VIEW section creates a +Data Controller inside the shell Component, so ETAF owns its effect Scope and +disposes the SQLite source with the Component. Detail and filter Components +consume Context and dispatch named Actions; they do not reach into SQLite or +duplicate selection matching. The `.etaf` structure and `.ecss` tokens are +applied at the root. If the product grows beyond this size, these commented +sections can later move into modules without changing the public Playground +triplet. ## Accessibility @@ -146,8 +173,14 @@ ## Implementation constraints -- Framework/styling: public ETAF View DSL and `etaf-ui`; SQLite through the - sibling `etaf-sqlite` package; no HTML/CSS runtime dependency. +- Framework/styling: source/preview orchestration is public ETAF API only; + concrete examples may use `etaf-ui` and `etaf-sqlite`; no HTML/CSS runtime + dependency. +- Public authoring boundary: intentional hot reload goes through + `etaf-component-redefine-run`; application code does not bind ETAF private + registry variables. Controllers created in Component setup use automatic + Scope ownership, and selected rows use `etaf-data-selected-item` with an + explicit `:item-key`. - Data schema: one typed `reading_items` SQLite table with id/title/author/ kind/status/progress/priority/starred/note/updated columns. - Pressure fixture: `etaf-research-shelf-fixture-size` defaults to 256 and @@ -155,10 +188,12 @@ preserved and missing fixture rows are topped up with fresh IDs. - Performance: one Data mutation -> one Runtime generation/publication; normal warm actions remain under the accepted 105ms 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. +- Compatibility: any same-basename `.etaf`/`.el` example is discoverable; + `.ecss` is optional, and the bundled Research Shelf remains only one + consumer. +- Verification: inert reader tests, source-tab/session tests, unsaved source + refresh tests, SQLite temp-file integration tests, mount/remount tests, + repeated selection/mutation tests, and clean GUI screenshots. ## Open questions diff --git a/DESIGN.zh-CN.md b/DESIGN.zh-CN.md index 9a209ca..3db17cd 100644 --- a/DESIGN.zh-CN.md +++ b/DESIGN.zh-CN.md @@ -3,8 +3,9 @@ ## 来源与状态 - 状态：active -- 更新日期：2026-08-22 -- 主产品面：`examples/research-shelf.etaf` + `examples/research-shelf.el` +- 更新日期：2026-08-23 +- 主产品面：通用 `etaf-playground.el` 工作区，以及 + `examples/research-shelf.etaf` / `.el` / `.ecss` consumer 三件套 - HTML 视觉基线：`design/research-shelf.html` - 已审查：ETAF View/Component/Data API、`etaf-ui` 的公开组件，以及 `etaf-sqlite` 的 typed source 合同。 @@ -21,33 +22,59 @@ Playground 默认安装确定性的 256 条 fixture、每页 12 条，用于真 - Shell：标题/副标题/主题切换 → 三列 workspace → 持久化状态栏。 - 三列 workspace：筛选栏 / SQLite reading list / selected-item detail inspector。 -- `.etaf`：只保存经过白名单校验的静态结构和文案（section、filter、label）。 -- 同名 `.el`：消费 `.etaf`，组合公开 UI Components，创建 SQLite schema、Data +- `.etaf`：只保存经过 inert 校验的静态结构和文案（section、filter、label）。 +- `.ecss`：可选的 inert `(styles ...)` 规则，由 companion 消费并应用到 ETAF + Component style scope。 +- 同名 `.el`：消费 `.etaf/.ecss`，组合公开 UI Components，创建 SQLite schema、Data Controller、refs、事件处理和生命周期清理。 - 现有可复用组件：`button`、`checkbox`、`label`、`panel`、`data-grid`、 `pagination`；应用只负责把它们组合成产品，不复制一套 UI kit。 ## Playground 框架边界（必须长期遵守） -`etaf-playground.el` 是通用 pair playground 框架，不是业务应用模块。 -`etaf-playground-catalog.el` 是独立、可替换的部署目录；业务 pair 的名字、refs -和验证元数据放在 catalog，不写进 loader 实现。 +`etaf-playground.el` 是通用的 source/preview 工作区，不是业务应用模块。它从同名 +`.etaf`/`.el` 文件发现应用，并把可选的 `.ecss` 作为第三个 source tab；左侧是 +源码会话，右侧是 ETAF 预览。 框架只负责： -- pair 注册语义和 catalog 读取； -- `.etaf` 的惰性、inert、白名单读取； -- 按同名 pair 加载 companion； -- mount、reset、close，以及测试/GUI 入口。 +- 惰性、inert 的 `.etaf`/`.ecss` 读取和 companion 注册覆盖； +- `.etaf`、`.el`、`.ecss` source buffer 的 tab 切换； +- 左右窗口布局、刷新、reset、close，以及 ETAF Runtime 生命周期。 框架绝不负责：业务 Component、数据库包或表结构、palette、业务 state、 handlers、resources 或应用 refs。它不能 `require etaf-sqlite`，也不能把业务 -组件实现塞进 loader/helper。未来新增例子时，只增加一个同名 `.etaf`/`.el` pair -和 catalog entry，不改变框架语义。 +组件实现塞进 loader/helper。未来新增例子时，只增加一个同名 `.etaf`/`.el` pair， +必要时再加 `.ecss`，不改变框架语义。 组合和复用是默认设计：优先复用 ETAF/`etaf-ui` 的公开契约，优先拆出清晰的 Component 边界，避免新增 helper 层或抽象泄漏。 +## Research Shelf 的 companion 边界 + +Research Shelf 目前足够小，完整的可执行 companion 放在一个文件中，用注释明确 +业务边界： + +```text +examples/research-shelf.etaf inert 结构 source +examples/research-shelf.ecss inert 样式 source +examples/research-shelf.el DATA / THEME / STATE / VIEW / ROOT +``` + +`.el` 文件是唯一的 Playground 注册点和 palette owner；它的 THEME 区域可以 +通过可选的 `etaf-theme-tp` adapter 把 TP 的亮/暗 pair 转成 ETAF 语义 Theme plist， +其余应用代码不直接调用 TP，也不嵌入 renderer palette 名称。VIEW 区域在 shell +Component 内创建 +Data Controller，因此 ETAF 会自动把它的 effect Scope 归 Component 所有，并在 +Component 销毁时释放 SQLite source。详情和筛选 Component 通过 Context 消费依赖、 +dispatch 命名 Action，不直接访问 SQLite，也不重复实现 selection 匹配。`.etaf` +负责静态结构，`.ecss` 负责 token。未来如果产品复杂度真的增长，再把这些注释区段 +迁移到目录模块，而不改变 Playground 的同名三文件入口。 + +实现约束补充：有意热加载统一通过 `etaf-component-redefine-run`，应用代码不绑定 +ETAF 私有 registry 变量；Component setup 中创建的 Controller 自动归当前 Scope +所有，选中项使用带明确 `:item-key` 的 `etaf-data-selected-item`。 + ## 视觉语言 - 气质：editorial、专注、温暖、安静而聪明；避免通用 admin dashboard、KPI @@ -78,8 +105,9 @@ Component 边界，避免新增 helper 层或抽象泄漏。 - Shell 只使用一套带 basis/grow 权重的 wrapping Flex，不读取窗口宽度、不维护 breakpoint 状态；`row` 只负责紧凑 intrinsic 控件，所有操作控件仍保持独立 hover/focus 语义。 -- 用 SQLite 临时文件测试 mount/remount、筛选、分页、重复选行、mutation、错误 - 状态和 cleanup；GUI 用干净 fullscreen 单窗口截图验证真实布局。 +- 用 inert reader、source tab/session、未保存 source refresh 和 SQLite 临时文件 + 测试 mount/remount、筛选、分页、重复选行、mutation、错误状态和 cleanup；GUI + 用干净 fullscreen 截图验证真实布局。 - 目标：一次 Data mutation 对应一次 Runtime generation/publication；warm 交互 维持已接受的 105ms p50 预算。 - 压测入口：`etaf-research-shelf-fixture-size` 默认 256， diff --git a/Makefile b/Makefile index 89ea2c8..779f989 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,8 @@ EMACS ?= emacs LOAD_PATH = -L . -L ../etaf -L ../etaf-ui -L ../ebox -L ../ecss -L ../tp -L ../etaf-sqlite -EXAMPLE_EL := examples/research-shelf.el +ENTRY_EXAMPLES := $(wildcard examples/*.el) +EXAMPLES := $(ENTRY_EXAMPLES) +EXAMPLE_ELC := $(EXAMPLES:.el=.elc) .PHONY: all compile examples-read test perf check checkdoc load clean @@ -16,19 +18,18 @@ compile: $(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 + rm -f *.elc tests/*.elc $(EXAMPLE_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 '(dolist (file (quote ($(foreach file,$(ENTRY_EXAMPLES),"$(file)")))) (load-file file))' \ + --eval '(dolist (file (quote ($(foreach file,$(EXAMPLES),"$(file)")))) (byte-compile-file file))' \ --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 '(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 '(dolist (file (quote ($(foreach file,$(ENTRY_EXAMPLES),"$(file)")))) (load (file-name-sans-extension file) nil nil nil))' \ --eval '(princ "ETAF example modules load OK\\n")' test: examples-read @@ -44,9 +45,9 @@ load: compile --eval '(princ "etaf-playground load OK\\n")' checkdoc: - $(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)))' + $(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (append (list "etaf-playground.el" "tests/etaf-playground-tests.el") (directory-files-recursively "examples" "\\.el$$"))) (checkdoc-file file)))' check: checkdoc test clean: - rm -f *.elc tests/*.elc examples/*.elc + rm -f *.elc tests/*.elc $(EXAMPLE_ELC) diff --git a/README.md b/README.md index feeeba6..06795d4 100644 --- a/README.md +++ b/README.md @@ -1,23 +1,47 @@ # ETAF Playground -The Playground exposes one canonical product example: the -`examples/research-shelf.etaf` and `examples/research-shelf.el` pair. +ETAF Playground is a generic authoring workspace: the left side edits one +same-basename application's sources and the right side mounts its live ETAF +preview. The framework discovers examples from files; it does not contain a +business catalog or require a concrete application. -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. +Each example follows this contract: + +- `examples/NAME.etaf` — one inert structural form; +- `examples/NAME.el` — the companion Components, state, effects, and root + factory (`etaf-NAME-root` by convention); +- `examples/NAME.ecss` — optional inert `(styles ...)` presentation rules. + +Run `M-x etaf-playground-open` to open the default example. The source header +has clickable `ETAF`, `EL`, and `ECSS` buttons. `C-c 1/2/3` (or +`C-c C-1/C-2/C-3`) switches the source; `C-c C-c` renders the current source +into the right-hand preview. Saving a source file also refreshes by default. +`etaf-playground-register-example` is available when a companion needs a +non-conventional root or feature name. + +The low-level `etaf-playground-mount-example` API remains available for batch +tests and consumers that only need a preview buffer. Business Components, +database schemas, palettes, refs, and handlers stay in the example companion. + +Research Shelf is small enough to keep its complete executable companion in one +`.el` file. Its sections are separated by comments while the Playground entry +files remain easy to discover: + +```text +examples/research-shelf.etaf # inert structure source +examples/research-shelf.ecss # inert style source +examples/research-shelf.el # DATA / THEME / STATE / VIEW / ROOT sections +``` + +The companion registers `:reload-on-refresh t`, so saving the `.el`, `.etaf`, or +`.ecss` source and refreshing reloads the complete consumer before the next +mount. Run `make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`. Run `make perf` for the 1413×62 warm row-selection/theme latency gate. -The example installs a deterministic 256-record SQLite fixture with 12 records -per page. Bind `etaf-research-shelf-fixture-size` and -`etaf-research-shelf-page-size` for smaller tests or larger pressure runs. -In the UI, activate `Rows N ✎` to enter any value from 1 through 100. The -workspace is one responsive wrapping Flex composition: three columns when -wide, rail/list plus wrapped detail at medium widths, and vertical when narrow. +The bundled Research Shelf example installs a deterministic 256-record SQLite +fixture with 12 records per page. Bind `etaf-research-shelf-fixture-size` and +`etaf-research-shelf-page-size` for smaller tests or larger pressure runs. Its +application UI is only a consumer of the generic workspace; activate `Rows N +✎` to enter any value from 1 through 100. diff --git a/README.zh-CN.md b/README.zh-CN.md index f892dd4..47954e2 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -1,19 +1,44 @@ # ETAF Playground -Playground 只公开一个标准产品示例： -`examples/research-shelf.etaf` 与 `examples/research-shelf.el` 配对。 +ETAF Playground 是通用的应用构建工作区：左侧编辑同一个应用的源码，右侧挂载 +实时 ETAF 预览。框架从文件发现 example，不内置具体业务 catalog，也不依赖某个 +具体应用。 -`.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 抽象。 +每个 example 遵循同名文件合同： + +- `examples/NAME.etaf`：一个 inert 的静态结构 form； +- `examples/NAME.el`：Component、状态、effect 和 root factory（默认命名为 + `etaf-NAME-root`）； +- `examples/NAME.ecss`：可选的 inert `(styles ...)` presentation 规则。 + +执行 `M-x etaf-playground-open` 打开默认 example。左侧 source 顶部的 +`ETAF`、`EL`、`ECSS` 是可点击按钮；`C-c 1/2/3`（也支持 +`C-c C-1/C-2/C-3`）分别切换 `.etaf`、`.el`、`.ecss`。在 `.etaf`、`.el` 或 +`.ecss` 窗口按 `C-c C-c` 会把当前 source 渲染到右侧预览；默认保存 source +也会刷新。若 root 或 feature 不遵循命名约定，可在 companion 中调用 +`etaf-playground-register-example` 注册覆盖。 + +`etaf-playground-mount-example` 仍作为低层 batch/consumer API 保留。业务 +Component、数据库 schema、palette、refs 和 handlers 都应该留在 example companion +中；Playground 只提供 source/preview 会话、读文件、窗口切换与生命周期。 + +Research Shelf 本身还没有复杂到需要 feature 目录，所以完整的可执行 companion +集中在一个 `.el` 文件里，用注释区分 DATA / THEME / STATE / VIEW / ROOT；只有 +Playground 需要发现的入口文件保持同名： + +```text +examples/research-shelf.etaf # inert 结构 source +examples/research-shelf.ecss # inert 样式 source +examples/research-shelf.el # DATA / THEME / STATE / VIEW / ROOT 分区 +``` + +该 companion 注册了 `:reload-on-refresh t`；保存 `.el`、`.etaf` 或 `.ecss` 后刷新 +source，会在下一次 mount 前重新加载完整 consumer。 验证命令：`make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。 性能门禁：`make perf`（1413×62 viewport 的 warm 选行/主题延迟）。 -示例默认安装确定性的 256 条 SQLite fixture，每页显示 12 条。测试或压测时可以 -绑定 `etaf-research-shelf-fixture-size` 和 `etaf-research-shelf-page-size` 调整规模； -界面中激活 `Rows N ✎` 可以输入 1–100。Workspace 使用同一套 wrapping Flex： -宽屏三栏，中屏 detail 换行，窄屏按文档顺序变为纵向布局。 +仓库中的 Research Shelf 只是上述通用工作区的一个 consumer。它默认安装确定性的 +256 条 SQLite fixture，每页显示 12 条；测试或压测时可以绑定 +`etaf-research-shelf-fixture-size` 和 `etaf-research-shelf-page-size` 调整规模， +界面中激活 `Rows N ✎` 可以输入 1–100。 diff --git a/etaf-playground-catalog.el b/etaf-playground-catalog.el deleted file mode 100644 index 814a2c1..0000000 --- a/etaf-playground-catalog.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; 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-page-size 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 da57941..1c9479d 100644 --- a/etaf-playground.el +++ b/etaf-playground.el @@ -1,180 +1,985 @@ -;;; etaf-playground.el --- Generic ETAF pair playground framework -*- lexical-binding: t; -*- +;;; etaf-playground.el --- Generic ETAF source and preview workspace -*- lexical-binding: t; -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; Author: ETAF contributors +;; Version: 0.2.0 +;; Package-Requires: ((emacs "29.1") (etaf "0.1.0")) +;; Keywords: tools, convenience, ui ;;; Commentary: -;; 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. + +;; ETAF Playground is an authoring surface, not an application. It discovers +;; same-basename example triplets, opens their `.etaf', `.el', and optional +;; `.ecss' sources on the left, and mounts the companion root in a preview +;; buffer on the right. An example owns its Components, state, storage, and +;; root factory; this file owns only source navigation, inert data readers, +;; loading, window layout, and mount lifecycle. +;; +;; The file contract is deliberately small: +;; +;; examples/NAME.etaf one inert structural form +;; examples/NAME.el a companion which defines NAME's root factory +;; examples/NAME.ecss optional `(styles (SELECTOR PROPERTY VALUE ...))' +;; +;; The default root convention is `etaf-NAME-root'. A companion may call +;; `etaf-playground-register-example' to provide a different root or feature. +;; Root factories receive the validated `.etaf' form and, when they accept a +;; second argument, the validated `.ecss' style form. ;;; Code: + (require 'cl-lib) +(require 'subr-x) +(require 'button) (require 'etaf) -(require 'etaf-playground-catalog) -;; `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) +(defgroup etaf-playground nil + "Authoring workspaces for ETAF applications." + :group 'etaf) -(defconst etaf-playground-buffer-name "*ETAF Playground*" - "Default buffer used by the generic Playground launcher.") -(defconst etaf-playground-example-directory +(defcustom etaf-playground-buffer-name "*ETAF Playground*" + "Fallback name used by direct, non-workspace mounts." + :type 'string + :group 'etaf-playground) + +(defcustom etaf-playground-example-directory (expand-file-name "examples" (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. + "Directory containing same-basename ETAF Playground examples." + :type 'directory + :group 'etaf-playground) -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) +(defcustom etaf-playground-source-extensions + '(".etaf" ".el" ".ecss") + "Source extensions shown in a Playground workspace, in tab order." + :type '(repeat string) + :group 'etaf-playground) -(defun etaf-playground-register-pair (entry) - "Register or replace a generic Playground pair ENTRY. +(defcustom etaf-playground-preview-buffer-format + "*ETAF Preview: %s*" + "Format string used for a mounted example preview buffer." + :type 'string + :group 'etaf-playground) -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)) +(defcustom etaf-playground-refresh-on-save t + "Whether saving a source buffer refreshes its paired preview." + :type 'boolean + :group 'etaf-playground) + +(defcustom etaf-playground-window-layout 'side-by-side + "Window layout used by `etaf-playground-open-example'." + :type '(choice (const side-by-side) (const stacked)) + :group 'etaf-playground) + +;; `read' consults this dynamically scoped safety switch. Declaring it also +;; keeps byte compilation from treating the protected binding as lexical. +(defvar read-eval) + +(cl-defstruct (etaf-playground-session + (:constructor etaf-playground--session-create)) + "State shared by one source/preview workspace." + name + spec + source-buffers + preview-buffer + active-extension + owned-source-buffers + companion-dirty-p + previous-window-configuration) + +(defvar etaf-playground--registrations (make-hash-table :test #'equal) + "Companion-provided root and feature overrides, keyed by example name.") + +(defvar etaf-playground--sessions (make-hash-table :test #'equal) + "Live Playground sessions keyed by example name.") + +(defvar etaf-playground-scenario-manifest nil + "Discovered example specifications. + +This compatibility variable is generated from the example directory. It is +not a business catalog and contains no application metadata beyond file paths +and the root/feature naming convention.") + +(defvar etaf-playground-example-names nil + "Names discovered from `etaf-playground-example-directory'.") + +(defvar etaf-playground-default-pair nil + "Default discovered example opened by `etaf-playground-open'.") + +(defvar-local etaf-playground-session nil + "Session associated with the current source or preview buffer.") + +(defvar-local etaf-playground-current-example nil + "Example name associated with a direct mounted buffer.") + +(defvar-local etaf-playground-source-extension nil + "Extension represented by the current source buffer.") + +(defvar-local etaf-playground-preview-p nil + "Non-nil in a generated Playground preview buffer.") + +(defvar-local etaf-playground-companion-dirty-p nil + "Non-nil when the companion buffer needs an intentional reload.") + +(defvar etaf-playground--current-example nil + "Dynamically bound example name while a root factory is called.") +(defvar etaf-playground--current-static-form nil + "Dynamically bound `.etaf' form while a root factory is called.") +(defvar etaf-playground--current-ecss nil + "Dynamically bound `.ecss' form while a root factory is called.") + +;;; Example discovery and registration + +(defun etaf-playground-register-example + (name &rest options) + "Register companion overrides for example NAME. + +OPTIONS accepts `:root' or `:root-component' and `:feature' or +`:companion-feature'. `:reload-on-refresh' is useful for a companion that +must reload evaluated application behavior. Registration +belongs in an example companion, not in the framework, and is optional when +the default `etaf-NAME-root' and `etaf-NAME' conventions are used." + (unless (stringp name) + (error "ETAF Playground example name must be a string: %S" name)) + (let ((root (or (plist-get options :root) + (plist-get options :root-component))) + (feature (or (plist-get options :feature) + (plist-get options :companion-feature))) + (reload-on-refresh (plist-get options :reload-on-refresh))) + (when (and root (not (or (symbolp root) (functionp root)))) + (error "Invalid ETAF Playground root factory: %S" root)) + (when (and feature (not (symbolp feature))) + (error "Invalid ETAF Playground companion feature: %S" feature)) + (puthash name (list :root-component root + :companion-feature feature + :reload-on-refresh reload-on-refresh) + etaf-playground--registrations) + name)) + +(defun etaf-playground--default-root-symbol (name) + "Return the conventional root factory symbol for NAME." + (intern (format "etaf-%s-root" name))) + +(defun etaf-playground--default-feature-symbol (name) + "Return the conventional companion feature symbol for NAME." + (intern (format "etaf-%s" name))) + +(defun etaf-playground--example-spec (name directory) + "Build a generic file specification for NAME in DIRECTORY." + (let* ((registration (gethash name etaf-playground--registrations)) + (etaf-file (expand-file-name (concat name ".etaf") directory)) + (el-file (expand-file-name (concat name ".el") directory)) + (ecss-file (expand-file-name (concat name ".ecss") directory))) + (list :pair name + :directory directory + :etaf-file etaf-file + :el-file el-file + :ecss-file (and (file-readable-p ecss-file) ecss-file) + :root-component (or (plist-get registration :root-component) + (etaf-playground--default-root-symbol name)) + :companion-feature + (or (plist-get registration :companion-feature) + (etaf-playground--default-feature-symbol name))))) + +(defun etaf-playground-refresh-examples (&optional directory) + "Discover valid `.etaf'/`.el' pairs in DIRECTORY. + +An `.ecss' file is optional so an application can start with structure and +behavior only; when present it is included in the source tabs and passed to +the root factory." + (let* ((directory (file-name-as-directory + (expand-file-name + (or directory etaf-playground-example-directory)))) + (names + (when (file-directory-p directory) + (cl-loop for file in (directory-files directory nil "\\.etaf\\'") + for name = (file-name-sans-extension file) + for el-file = (expand-file-name (concat name ".el") directory) + when (file-readable-p el-file) + collect name))) + (specs (mapcar (lambda (name) + (etaf-playground--example-spec name directory)) + (sort (delete-dups names) #'string<)))) + (setq etaf-playground-scenario-manifest specs + etaf-playground-example-names (mapcar (lambda (spec) + (plist-get spec :pair)) + specs)) + (when (or (null etaf-playground-default-pair) + (not (member etaf-playground-default-pair + etaf-playground-example-names))) + (setq etaf-playground-default-pair + (car etaf-playground-example-names))) + etaf-playground-scenario-manifest)) (defun etaf-playground-scenario (name) - "Return the registered pair specification named NAME." + "Return the discovered generic specification for NAME." + (etaf-playground-refresh-examples) (or (cl-find name etaf-playground-scenario-manifest - :key (lambda (entry) (plist-get entry :pair)) + :key (lambda (spec) (plist-get spec :pair)) :test #'equal) - (user-error "Unknown ETAF Playground pair: %s" name))) + (user-error "Unknown ETAF Playground example: %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)) + "Return NAME's same-basename file ending in SUFFIX." + (expand-file-name (concat name suffix) + (plist-get (etaf-playground-scenario name) :directory))) -(defun etaf-playground--validate-static-node (node tags) - "Validate inert static View NODE against allowlisted TAGS." +(defun etaf-playground-example-files (name) + "Return the source file plist for NAME." + (let ((spec (etaf-playground-scenario name))) + (list :etaf (plist-get spec :etaf-file) + :el (plist-get spec :el-file) + :ecss (plist-get spec :ecss-file)))) + +;;; Static form helpers + +(defun etaf-playground-static-child (form tag) + "Return the first static FORM child whose tag is TAG. + +FORM is the inert structure passed to an example root. Keeping this lookup +in the authoring layer prevents every consumer from reimplementing the same +raw `cl-find-if' traversal while leaving business-specific interpretation in +the consumer." + (cl-find-if (lambda (entry) + (and (consp entry) (eq (car entry) tag))) + (cdr form))) + +(defun etaf-playground-static-value (form key &optional default) + "Return KEY from static FORM, or DEFAULT when FORM omits it." + (or (plist-get (cdr form) key) default)) + +;;; Inert source readers + +(defconst etaf-playground--forbidden-static-heads + '(apply call-process call-process-region byte-code eval + funcall function lambda load load-file message progn require + shell-command start-process start-process-shell-command subprocess + symbol-function setq setf psetq psetf) + "Elisp heads which must never appear as executable static source.") + +(defun etaf-playground--forbidden-static-head-p (head) + "Return non-nil when HEAD is not allowed in inert source data." + (and (symbolp head) + (or (memq head etaf-playground--forbidden-static-heads) + (string-prefix-p "etaf--" (symbol-name head)) + (string-prefix-p "ebox--" (symbol-name head))))) + +(defun etaf-playground--validate-static-node (node &optional _tags) + "Validate inert structural/data NODE. + +The optional second argument is retained for compatibility with the former +catalog-based reader; structural tags are intentionally not allowlisted. A +generic Playground must accept an application's own tags while still +rejecting executable forms and private runtime heads." (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) 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 (lambda (child) (etaf-playground--validate-static-node child tags)) - (cdr node)) + ((or (null node) (stringp node) (numberp node) (characterp node) + (symbolp node) (keywordp node)) + (when (and (symbolp node) + (string-prefix-p "#" (symbol-name node))) + (error "Invalid ETAF static symbol: %S" node)) node) - (t (error "Unsafe ETAF static View value: %S" node)))) + ((vectorp node) + (mapc #'etaf-playground--validate-static-node node) + node) + ((consp node) + (unless (proper-list-p node) + (error "ETAF static source must contain proper lists: %S" node)) + (when (etaf-playground--forbidden-static-head-p (car node)) + (error "Executable or private ETAF static form: %S" node)) + (mapc #'etaf-playground--validate-static-node node) + node) + (t + (error "Unsupported ETAF static value: %S" node)))) -(defun etaf-playground-read-static (name) - "Read and validate NAME's single inert `.etaf' form." - (let ((scenario (etaf-playground-scenario name))) +(defun etaf-playground--read-single-form (content label) + "Read one inert Lisp form from CONTENT labelled LABEL." + (with-temp-buffer + (insert content) + (goto-char (point-min)) + (let ((read-eval nil) + form) + (setq form + (condition-case nil + (read (current-buffer)) + (end-of-file + (error "ETAF Playground %s source is empty" label)))) + (condition-case nil + (progn + (read (current-buffer)) + (error "ETAF Playground %s source contains multiple forms" + label)) + (end-of-file nil)) + form))) + +(defun etaf-playground--source-buffer (session extension) + "Return SESSION's live source buffer for EXTENSION." + (cdr (assoc extension + (and (etaf-playground-session-p session) + (etaf-playground-session-source-buffers session))))) + +(defun etaf-playground--file-content (file session extension) + "Return FILE content, preferring SESSION's unsaved EXTENSION buffer." + (if-let ((buffer (etaf-playground--source-buffer session extension))) + (with-current-buffer buffer + (buffer-substring-no-properties (point-min) (point-max))) (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))))))) + (insert-file-contents file) + (buffer-string)))) -(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 feature) - (load (file-name-sans-extension - (etaf-playground--pair-file name ".el")) nil nil nil)) - (unless (functionp root) (error "Missing root factory: %S" root)) - (funcall root form))) +(defun etaf-playground-read-static (name &optional session) + "Read and validate NAME's single inert `.etaf' form. -(defun etaf-playground-mount-example (buffer-name 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)))) - (with-current-buffer buffer (setq etaf-playground-current-example name)) +When SESSION is supplied, unsaved buffer content is authoritative." + (let* ((spec (etaf-playground-scenario name)) + (file (plist-get spec :etaf-file)) + (form (etaf-playground--read-single-form + (etaf-playground--file-content file session ".etaf") + ".etaf"))) + (etaf-playground--validate-static-node form) + form)) + +(defun etaf-playground--validate-ecss-form (form) + "Validate a static ETAF/ECSS style FORM and return it." + (unless (and (consp form) (eq (car form) 'styles)) + (error "ETAF Playground `.ecss' must start with (styles ...)")) + (dolist (rule (cdr form)) + (unless (and (consp rule) (stringp (car rule)) + (proper-list-p rule)) + (error "Invalid ETAF Playground ECSS rule: %S" rule)) + (let ((properties (cdr rule))) + (unless (zerop (% (length properties) 2)) + (error "ECSS rule has an incomplete property pair: %S" rule)) + (while properties + (let ((key (pop properties)) + (value (pop properties))) + (unless (keywordp key) + (error "ECSS properties must be keywords: %S" key)) + (etaf-playground--validate-static-node value))))) + form) + +(defun etaf-playground-read-ecss (name &optional session) + "Read and validate NAME's optional `.ecss' style form. + +When SESSION is supplied, its unsaved source is authoritative. Missing or +blank style files produce an empty `(styles)' form, so structure and +behavior-only examples remain valid consumers of the same framework." + (let* ((spec (etaf-playground-scenario name)) + (file (plist-get spec :ecss-file))) + (if (not file) + '(styles) + (let ((content (string-trim + (etaf-playground--file-content file session ".ecss")))) + (if (string-empty-p content) + '(styles) + (etaf-playground--validate-ecss-form + (etaf-playground--read-single-form content ".ecss"))))))) + +;;; Pair loading and mounting + +(defun etaf-playground--registration (name) + "Return companion registration for NAME, if any." + (gethash name etaf-playground--registrations)) + +(defun etaf-playground--load-companion (spec &optional session) + "Evaluate or load SPEC's `.el' companion. + +An open source buffer is evaluated so unsaved editor changes participate in +the next preview refresh. A direct mount without SESSION loads the file from +disk." + (let* ((file (plist-get spec :el-file)) + (registration (etaf-playground--registration + (plist-get spec :pair))) + (feature (or (plist-get registration :companion-feature) + (plist-get spec :companion-feature))) + (buffer (and session + (etaf-playground--source-buffer session ".el")))) + (let ((reload-buffer-p + (and (buffer-live-p buffer) + (or (buffer-modified-p buffer) + (etaf-playground-session-companion-dirty-p session) + (plist-get registration :reload-on-refresh)))) + (loaded-p (and (symbolp feature) (featurep feature)))) + (if reload-buffer-p + (with-current-buffer buffer + (save-restriction + (widen) + (etaf-component-redefine-run + (lambda () (eval-buffer nil)))) + (setf (etaf-playground-session-companion-dirty-p session) nil) + (setq-local etaf-playground-companion-dirty-p nil)) + (unless loaded-p + (load (file-name-sans-extension file) nil nil nil)))) + spec)) + +(defun etaf-playground--root-factory (spec) + "Return the loaded root factory for SPEC." + (let* ((name (plist-get spec :pair)) + (registration (etaf-playground--registration name)) + (root (or (plist-get registration :root-component) + (plist-get spec :root-component)))) + (when (and (symbolp root) (not (fboundp root))) + (error "Missing ETAF Playground root factory: %S" root)) + (unless (or (functionp root) (and (symbolp root) (fboundp root))) + (error "Invalid ETAF Playground root factory: %S" root)) + root)) + +(defun etaf-playground--call-root (root name static-form ecss-form) + "Call ROOT with NAME's STATIC-FORM and optional ECSS-FORM. + +One-argument roots remain supported for small existing examples." + (let ((etaf-playground--current-example name) + (etaf-playground--current-static-form static-form) + (etaf-playground--current-ecss ecss-form)) + (condition-case _err + (funcall root static-form ecss-form) + (wrong-number-of-arguments + (funcall root static-form))))) + +(defun etaf-playground-read-pair (name &optional session) + "Load NAME's companion and return its root View value. + +When SESSION is supplied, its current source buffers are authoritative. The +`.etaf' and `.ecss' files are read as inert data. The `.el' companion is the +only file evaluated by the framework." + (let* ((spec (etaf-playground-scenario name)) + (static-form (etaf-playground-read-static name session)) + (ecss-form (etaf-playground-read-ecss name session))) + (etaf-playground--load-companion spec session) + (etaf-playground--call-root + (etaf-playground--root-factory spec) + name static-form ecss-form))) + +(defun etaf-playground--preview-mode-setup (buffer session) + "Prepare generated preview BUFFER for SESSION." + (with-current-buffer buffer + (unless (derived-mode-p 'etaf-playground-preview-mode) + (etaf-playground-preview-mode)) + (setq-local etaf-playground-session session + etaf-playground-current-example + (etaf-playground-session-name session) + etaf-playground-preview-p t + header-line-format + (format " ETAF Preview %s | g refresh q close" + (etaf-playground-session-name session))) + (buffer-disable-undo) + (setq-local truncate-lines nil)) + buffer) + +(defun etaf-playground-mount-example (buffer-name name &optional session) + "Mount example NAME into BUFFER-NAME and return its buffer. + +This is the low-level consumer API. `etaf-playground-open-example' adds the +source editors and side-by-side workspace around it." + (let ((buffer (get-buffer-create buffer-name))) + (when-let ((runtime (etaf-runtime-for-buffer buffer))) + (with-current-buffer buffer + (etaf-unmount runtime))) + ;; Root factories and lifecycle callbacks are application code. Run them + ;; with the preview selected so a consumer using `face-remap' or another + ;; buffer-local display API cannot accidentally style the source editor + ;; which invoked `etaf-playground-refresh'. + (with-current-buffer buffer + (etaf-mount buffer (etaf-playground-read-pair name session))) + (with-current-buffer buffer + (setq-local etaf-playground-current-example name)) buffer)) -(defun etaf-playground--mount-for-display (buffer-name name) - "Display BUFFER-NAME before mounting pair NAME when running in a GUI. +(defun etaf-playground--render-error (session error-data) + "Show ERROR-DATA in SESSION's preview buffer after a failed refresh." + (let ((buffer (etaf-playground-session-preview-buffer session))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (format "ETAF Playground could not render %s.\n\n%s\n" + (etaf-playground-session-name session) + (error-message-string error-data)))) + (setq-local buffer-read-only t) + (setq-local header-line-format + (format " ETAF Preview %s | ERROR | g retry q close" + (etaf-playground-session-name session))))))) -Ebox resolves viewport-relative widths from the window that owns the target -buffer. Mounting first would make an off-window daemon/terminal window the -initial containing block, leaving a responsive pair permanently laid out at -that stale width until a later explicit resize." +(defun etaf-playground-refresh (&optional target) + "Refresh the preview associated with TARGET or the current source buffer. + +The current contents of all three source buffers are read on each refresh; +the companion `.el' is evaluated, the old runtime is unmounted, and the root +is mounted again from the Playground's perspective. Errors stay visible in +the preview instead of destroying the source workspace." + (interactive) + (let ((session (etaf-playground--session-for-target target))) + ;; Make `C-c C-c' useful when the user opened a source file directly + ;; instead of entering through `etaf-playground-open'. + (unless session + (when-let* ((source (cond ((bufferp target) target) + ((and (stringp target) (get-buffer target)) + (get-buffer target)) + (t (current-buffer)))) + (name (etaf-playground--source-example-name source))) + (etaf-playground-open-example name) + (setq session (etaf-playground--session-for-target name)))) + (unless session + (user-error "No ETAF Playground workspace is associated with this buffer")) + (let ((preview (etaf-playground-session-preview-buffer session))) + (condition-case err + (progn + (when-let ((runtime (etaf-runtime-for-buffer preview))) + (with-current-buffer preview + (etaf-unmount runtime))) + (with-current-buffer preview + (setq-local buffer-read-only nil)) + (etaf-playground-mount-example + preview (etaf-playground-session-name session) session) + (with-current-buffer preview + (setq-local buffer-read-only t + header-line-format + (format " ETAF Preview %s | g refresh q close" + (etaf-playground-session-name session)))) + (force-mode-line-update t) + preview) + ((error quit) + (etaf-playground--render-error session err) + nil))))) + +;;; Source modes and navigation + +(defvar etaf-playground--tab-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] #'etaf-playground-click-source-tab) + map) + "Mouse map used by source tabs in the header line.") + +(defvar etaf-playground-source-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'etaf-playground-refresh) + (define-key map (kbd "C-c C-1") #'etaf-playground-show-etaf) + (define-key map (kbd "C-c C-2") #'etaf-playground-show-el) + (define-key map (kbd "C-c C-3") #'etaf-playground-show-ecss) + (define-key map (kbd "C-c 1") #'etaf-playground-show-etaf) + (define-key map (kbd "C-c 2") #'etaf-playground-show-el) + (define-key map (kbd "C-c 3") #'etaf-playground-show-ecss) + (define-key map (kbd "C-c C-n") #'etaf-playground-next-source) + (define-key map (kbd "C-c C-p") #'etaf-playground-previous-source) + (define-key map (kbd "C-c C-r") #'etaf-playground-refresh) + (define-key map (kbd "q") #'etaf-playground-close) + map) + "Keymap used by source buffers in a Playground workspace.") + +(define-minor-mode etaf-playground-source-mode + "Minor mode shared by ETAF, Elisp, and ECSS Playground source buffers." + :lighter " ETAF-Play" + :keymap etaf-playground-source-mode-map + (if etaf-playground-source-mode + (progn + (add-hook 'after-save-functions + #'etaf-playground--after-save nil t) + (add-hook 'after-change-functions + #'etaf-playground--after-source-change nil t) + (setq-local truncate-lines nil) + (setq-local header-line-format + '(:eval (etaf-playground--source-header)))) + (remove-hook 'after-save-functions + #'etaf-playground--after-save t) + (remove-hook 'after-change-functions + #'etaf-playground--after-source-change t))) + +(define-derived-mode etaf-playground-etaf-mode emacs-lisp-mode "ETAF" + "Major mode for inert ETAF structural source files." + (etaf-playground-source-mode 1)) + +(define-derived-mode etaf-playground-ecss-mode emacs-lisp-mode "ECSS" + "Major mode for inert ETAF ECSS style source files." + (etaf-playground-source-mode 1)) + +(define-derived-mode etaf-playground-preview-mode special-mode "ETAF-Preview" + "Read-only major mode for a mounted ETAF Playground preview." + (setq-local truncate-lines nil) + (setq-local buffer-read-only nil) + (setq-local mode-line-process nil)) + +(add-to-list 'auto-mode-alist '("\\.etaf\\'" . etaf-playground-etaf-mode)) +(add-to-list 'auto-mode-alist '("\\.ecss\\'" . etaf-playground-ecss-mode)) + +(defun etaf-playground--source-header () + "Return the button-based source tab header for the current buffer." + (let ((session etaf-playground-session)) + (if (not (etaf-playground-session-p session)) + " ETAF Source" + (concat + " ETAF Source " + (mapconcat + (lambda (extension) + (when-let ((buffer (etaf-playground--source-buffer + session extension))) + (let* ((active (equal extension + (etaf-playground-session-active-extension + session))) + (label (upcase (string-remove-prefix "." extension))) + (text (format " %s%s " label + (if (buffer-modified-p buffer) "*" "")))) + (make-text-button + text nil + 'action #'etaf-playground--activate-source-tab + 'follow-link t + 'button-data extension + 'etaf-playground-extension extension + 'face (if active 'mode-line-emphasis + 'mode-line-inactive) + 'mouse-face 'mode-line-highlight + 'help-echo (format "Switch to %s" extension))))) + etaf-playground-source-extensions + " | ") + " C-c C-c refresh")))) + +(defun etaf-playground--activate-source-tab (button) + "Activate source tab BUTTON from a header-line text button." + (let ((extension + (or (and (stringp button) + (get-text-property 0 'etaf-playground-extension button)) + (and (fboundp 'button-get) + (ignore-errors + (button-get button 'etaf-playground-extension))) + (and (fboundp 'button-get) + (ignore-errors (button-get button 'button-data)))))) + (when extension + (etaf-playground-switch-source extension)))) + +(defun etaf-playground--refresh-source-headers (session) + "Refresh source tab headers for SESSION." + (dolist (entry (etaf-playground-session-source-buffers session)) + (when (buffer-live-p (cdr entry)) + (with-current-buffer (cdr entry) + (setq header-line-format '(:eval (etaf-playground--source-header))) + (force-mode-line-update t))))) + +(defun etaf-playground-click-source-tab (event) + "Switch to the source tab under mouse EVENT." + (interactive "e") + (let* ((start (event-start event)) + (window (posn-window start)) + (position (posn-point start))) + (when (and (window-live-p window) (integer-or-marker-p position)) + (with-current-buffer (window-buffer window) + (when-let ((extension + (get-text-property position + 'etaf-playground-extension))) + (etaf-playground-switch-source extension)))))) + +(defun etaf-playground--session-for-target (&optional target) + "Return live session for TARGET, current buffer, or selected workspace." + (cond + ((etaf-playground-session-p target) target) + ((bufferp target) + (buffer-local-value 'etaf-playground-session target)) + ((stringp target) + (or (gethash target etaf-playground--sessions) + (and (get-buffer target) + (buffer-local-value 'etaf-playground-session + (get-buffer target))))) + ((etaf-playground-session-p etaf-playground-session) + etaf-playground-session) + (t + (let ((buffer (window-buffer (selected-window)))) + (and (buffer-live-p buffer) + (buffer-local-value 'etaf-playground-session buffer)))))) + +(defun etaf-playground--source-example-name (&optional buffer) + "Return the discovered example name owning BUFFER's source file." + (when-let ((file (buffer-file-name (or buffer (current-buffer))))) + (let ((file (file-truename file))) + (cl-loop for spec in etaf-playground-scenario-manifest + for name = (plist-get spec :pair) + for source-files = + (delq nil (list (plist-get spec :etaf-file) + (plist-get spec :el-file) + (plist-get spec :ecss-file))) + when (cl-some (lambda (source-file) + (equal file (file-truename source-file))) + source-files) + return name)))) + +(defun etaf-playground--source-window (session) + "Return the visible source window for SESSION, if any." + (cl-find-if + (lambda (window) + (memq (window-buffer window) + (mapcar #'cdr (etaf-playground-session-source-buffers session)))) + (window-list nil 'no-minibuf))) + +(defun etaf-playground-switch-source (extension &optional target) + "Show EXTENSION in the left source window for TARGET's session." + (interactive + (list (completing-read + "Source: " + (mapcar (lambda (extension) + (cons (upcase (string-remove-prefix "." extension)) + extension)) + etaf-playground-source-extensions) + nil t))) + (let* ((session (etaf-playground--session-for-target target)) + (buffer (and session (etaf-playground--source-buffer + session extension)))) + (unless (and session (buffer-live-p buffer)) + (user-error "No live ETAF Playground source %s" extension)) + (setf (etaf-playground-session-active-extension session) extension) + (etaf-playground--refresh-source-headers session) + (when-let ((window (etaf-playground--source-window session))) + (set-window-buffer window buffer) + (select-window window)) + buffer)) + +(defun etaf-playground-next-source (&optional target) + "Switch to the next available source for TARGET's session." + (interactive) + (let* ((session (etaf-playground--session-for-target target)) + (extensions + (cl-remove-if-not + (lambda (extension) + (and session (etaf-playground--source-buffer session extension))) + etaf-playground-source-extensions)) + (current (and session + (cl-position + (etaf-playground-session-active-extension session) + extensions :test #'equal)))) + (unless (and session extensions) (user-error "No ETAF source session")) + (etaf-playground-switch-source + (nth (mod (1+ (or current -1)) (length extensions)) extensions) + session))) + +(defun etaf-playground-previous-source (&optional target) + "Switch to the previous available source for TARGET's session." + (interactive) + (let* ((session (etaf-playground--session-for-target target)) + (extensions + (cl-remove-if-not + (lambda (extension) + (and session (etaf-playground--source-buffer session extension))) + etaf-playground-source-extensions)) + (current (and session + (cl-position + (etaf-playground-session-active-extension session) + extensions :test #'equal)))) + (unless (and session extensions) (user-error "No ETAF source session")) + (etaf-playground-switch-source + (nth (mod (1- (or current 0)) (length extensions)) extensions) + session))) + +(defun etaf-playground-show-etaf (&optional target) + "Show the `.etaf' source for TARGET's session." + (interactive) + (etaf-playground-switch-source ".etaf" target)) + +(defun etaf-playground-show-el (&optional target) + "Show the `.el' source for TARGET's session." + (interactive) + (etaf-playground-switch-source ".el" target)) + +(defun etaf-playground-show-ecss (&optional target) + "Show the `.ecss' source for TARGET's session." + (interactive) + (etaf-playground-switch-source ".ecss" target)) + +(defun etaf-playground--after-save () + "Refresh the current session after saving a source buffer." + (when etaf-playground-refresh-on-save + (etaf-playground-refresh (current-buffer)))) + +(defun etaf-playground--after-source-change (_beg _end _old-length) + "Mark a companion as needing reload after an editor change." + (when (and (equal etaf-playground-source-extension ".el") + (etaf-playground-session-p etaf-playground-session)) + (setq-local etaf-playground-companion-dirty-p t) + (setf (etaf-playground-session-companion-dirty-p + etaf-playground-session) + t))) + +;;; Workspace layout and public entry points + +(defun etaf-playground--session-preview-name (name) + "Return the generated preview buffer name for NAME." + (format etaf-playground-preview-buffer-format name)) + +(defun etaf-playground--setup-source-buffer (session extension buffer) + "Prepare BUFFER as SESSION's EXTENSION source editor." + (with-current-buffer buffer + (pcase extension + (".etaf" (unless (derived-mode-p 'etaf-playground-etaf-mode) + (etaf-playground-etaf-mode))) + (".ecss" (unless (derived-mode-p 'etaf-playground-ecss-mode) + (etaf-playground-ecss-mode))) + (".el" (unless (derived-mode-p 'emacs-lisp-mode) + (emacs-lisp-mode)))) + (setq-local etaf-playground-session session + etaf-playground-source-extension extension + etaf-playground-current-example + (etaf-playground-session-name session) + header-line-format '(:eval (etaf-playground--source-header))) + (etaf-playground-source-mode 1)) + buffer) + +(defun etaf-playground--make-session (name) + "Create or reuse the source/preview session for NAME." + (or (gethash name etaf-playground--sessions) + (let* ((spec (etaf-playground-scenario name)) + (source-buffers nil) + (owned nil)) + (dolist (extension etaf-playground-source-extensions) + (let* ((file (pcase extension + (".etaf" (plist-get spec :etaf-file)) + (".el" (plist-get spec :el-file)) + (".ecss" (plist-get spec :ecss-file)))) + (existing (and file (get-file-buffer file))) + (buffer (and file (or existing (find-file-noselect file))))) + (when buffer + (push (cons extension buffer) source-buffers) + (unless existing (push buffer owned))))) + (setq source-buffers (nreverse source-buffers)) + (let* ((session (etaf-playground--session-create + :name name :spec spec + :source-buffers source-buffers + :active-extension (caar source-buffers) + :owned-source-buffers owned)) + (preview (get-buffer-create + (etaf-playground--session-preview-name name)))) + (setf (etaf-playground-session-preview-buffer session) preview) + (puthash name session etaf-playground--sessions) + (dolist (entry source-buffers) + (etaf-playground--setup-source-buffer + session (car entry) (cdr entry))) + (etaf-playground--preview-mode-setup preview session) + session)))) + +(defun etaf-playground--show-session (session) + "Display SESSION in a left-source/right-preview layout." + (unless noninteractive + (unless (etaf-playground-session-previous-window-configuration session) + (setf (etaf-playground-session-previous-window-configuration session) + (current-window-configuration))) + (delete-other-windows) + (let* ((window-min-width 1) + (window-min-height 1) + (left (selected-window)) + (right (if (eq etaf-playground-window-layout 'stacked) + (progn (set-window-buffer + left + (etaf-playground--source-buffer + session + (etaf-playground-session-active-extension session))) + (split-window-below)) + (split-window-right))) + (source (etaf-playground--source-buffer + session + (etaf-playground-session-active-extension session))) + (preview (etaf-playground-session-preview-buffer session))) + (set-window-buffer left source) + (set-window-buffer right preview) + (select-window left)))) + +(defun etaf-playground--active-source-buffer (session) + "Return SESSION's active source buffer." + (etaf-playground--source-buffer + session (etaf-playground-session-active-extension session))) + +(defun etaf-playground-open-example (name &optional buffer-name) + "Open example NAME as a source/preview workspace. + +When BUFFER-NAME is supplied, retain the low-level direct-mount behavior for +batch tests and callers which do not need editor windows." + (interactive + (list (completing-read "ETAF example: " + (progn (etaf-playground-refresh-examples) + etaf-playground-example-names) + nil t))) + (if buffer-name + (etaf-playground--mount-for-display buffer-name name) + (let ((session (etaf-playground--make-session name))) + (etaf-playground--show-session session) + (etaf-playground-refresh session) + (etaf-playground--refresh-source-headers session) + (etaf-playground--active-source-buffer session)))) + +(defun etaf-playground--mount-for-display (buffer-name name) + "Display BUFFER-NAME before mounting NAME in its containing window." (unless noninteractive - ;; Keep the current window as the containing block. `pop-to-buffer' may - ;; split a clean frame, cutting a responsive three-column app in half. (switch-to-buffer (get-buffer-create buffer-name))) (etaf-playground-mount-example buffer-name name)) ;;;###autoload -(defun etaf-playground-open (&optional buffer-name) - "Open the registered default pair in BUFFER-NAME." +(defun etaf-playground-open (&optional target) + "Open the default or selected generic ETAF Playground. + +With a known example name, TARGET selects that workspace. A target beginning +with `*' is treated as a legacy direct preview buffer name and mounts the +default example there." (interactive) - (etaf-playground--mount-for-display - (or buffer-name etaf-playground-buffer-name) - etaf-playground-default-pair)) + (etaf-playground-refresh-examples) + (cond + ((null target) + (etaf-playground-open-example etaf-playground-default-pair)) + ((member target etaf-playground-example-names) + (etaf-playground-open-example target)) + ((string-match-p "\\`[[:space:]]*\\*" target) + (etaf-playground--mount-for-display + target etaf-playground-default-pair)) + (t + (user-error "Unknown ETAF Playground target: %s" target)))) ;;;###autoload -(defun etaf-playground-open-example (name &optional buffer-name) - "Open registered pair NAME in BUFFER-NAME." - (interactive (list (completing-read "Pair: " etaf-playground-example-names))) - (etaf-playground--mount-for-display - (or buffer-name etaf-playground-buffer-name) name)) +(defun etaf-playground-reset (&optional target) + "Refresh TARGET's workspace or remount its direct preview." + (interactive) + (if-let ((session (etaf-playground--session-for-target target))) + (etaf-playground-refresh session) + (let* ((buffer (cond ((bufferp target) target) + ((stringp target) (get-buffer target)) + (t (current-buffer)))) + (name (and (buffer-live-p buffer) + (buffer-local-value 'etaf-playground-current-example + buffer)))) + (unless (and buffer name) + (user-error "No ETAF Playground session is mounted")) + (etaf-playground-mount-example (buffer-name buffer) name)))) ;;;###autoload -(defun etaf-playground-reset (&optional buffer-name) - "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--mount-for-display name pair))) +(defun etaf-playground-close (&optional target) + "Close TARGET's workspace, or unmount and kill a direct preview buffer." + (interactive) + (if-let ((session (etaf-playground--session-for-target target))) + (let* ((preview (etaf-playground-session-preview-buffer session)) + (configuration + (etaf-playground-session-previous-window-configuration session))) + (when-let ((runtime (and (buffer-live-p preview) + (etaf-runtime-for-buffer preview)))) + (with-current-buffer preview + (etaf-unmount runtime))) + (remhash (etaf-playground-session-name session) + etaf-playground--sessions) + (dolist (entry (etaf-playground-session-source-buffers session)) + (when (buffer-live-p (cdr entry)) + (with-current-buffer (cdr entry) + (setq-local etaf-playground-session nil + etaf-playground-source-extension nil)))) + (dolist (buffer (etaf-playground-session-owned-source-buffers session)) + (when (buffer-live-p buffer) (kill-buffer buffer))) + (when (buffer-live-p preview) + (kill-buffer preview)) + (when (and configuration (window-configuration-p configuration)) + (set-window-configuration configuration)) + session) + (let* ((buffer (cond ((bufferp target) target) + ((and (stringp target) (get-buffer target)) + (get-buffer target)) + ((null target) (current-buffer)))) + (runtime (and (buffer-live-p buffer) + (etaf-runtime-for-buffer buffer)))) + (when runtime + (with-current-buffer buffer + (etaf-unmount runtime))) + (when (buffer-live-p buffer) (kill-buffer buffer)) + buffer))) -;;;###autoload -(defun etaf-playground-close (&optional buffer-name) - "Unmount and kill the Playground BUFFER-NAME." - (let* ((name (or buffer-name etaf-playground-buffer-name)) - (buffer (get-buffer name))) - (when-let ((runtime (and buffer (etaf-runtime-for-buffer buffer)))) - (etaf-unmount runtime)) - (when (buffer-live-p buffer) (kill-buffer buffer)) - buffer)) +(etaf-playground-refresh-examples) (provide 'etaf-playground) ;;; etaf-playground.el ends here diff --git a/examples/research-shelf.ecss b/examples/research-shelf.ecss new file mode 100644 index 0000000..83299b5 --- /dev/null +++ b/examples/research-shelf.ecss @@ -0,0 +1,10 @@ +;; Static presentation belongs to the ECSS companion, not the behavior file. +;; The form deliberately uses ETAF's validated Component style contract so it +;; can be re-read safely by the generic Playground on every refresh. +(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))) diff --git a/examples/research-shelf.el b/examples/research-shelf.el index 5929810..484e3b2 100644 --- a/examples/research-shelf.el +++ b/examples/research-shelf.el @@ -1,17 +1,24 @@ -;;; research-shelf.el --- SQLite-backed research library -*- lexical-binding: t; -*- +;;; research-shelf.el --- Research Shelf application -*- 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. + +;; This deliberately compact companion keeps the small application's complete +;; behavior in one file. The sections make the boundaries visible without +;; introducing a feature directory. The neighboring .etaf and .ecss files +;; remain the Playground's inert authoring sources. ;;; Code: + (require 'cl-lib) -(require 'subr-x) (require 'etaf) (require 'etaf-ui) (require 'etaf-sqlite) +(require 'etaf-theme-tp) (require 'etaf-playground) -(require 'face-remap) + +;;; --------------------------------------------------------------------------- +;;; DATA / SQLITE SOURCE +;;; --------------------------------------------------------------------------- (defcustom etaf-research-shelf-database-file (expand-file-name "research-shelf.sqlite" user-emacs-directory) @@ -20,12 +27,7 @@ :group 'etaf) (defcustom etaf-research-shelf-fixture-size 256 - "Minimum deterministic records installed in the Playground database. - -The example deliberately uses a realistic fixture size so pagination, SQLite -counting, DataGrid Range updates, and repeated selection exercise more than a -toy four-row surface. Tests and small teaching fixtures may bind this to a -smaller value." + "Minimum deterministic records installed in the Playground database." :type 'natnum :group 'etaf) @@ -34,14 +36,6 @@ smaller value." :type 'positive-integer :group 'etaf) -(defconst etaf-research-shelf--grid-columns - '((:key :title :label "Title" :width 21) - (:key :author :label "Author" :width 12) - (:key :status :label "Status" :width 10) - (:key :progress :label "Progress" :width 8) - (:key :kind :label "Kind" :width 7)) - "Compact DataGrid columns that remain readable in a wrapped workspace.") - (defconst etaf-research-shelf-seed-records '((:id 1 :title "The Shape of Tools" :author "M. Abramson" :kind "Essay" :status "reading" :progress 64 :priority "High" @@ -84,7 +78,7 @@ smaller value." "Stable author vocabulary for generated fixture records.") (defun etaf-research-shelf--generated-record (id index) - "Return deterministic generated fixture record ID at INDEX." + "Return deterministic generated record ID at INDEX." (let* ((status (nth (mod index 4) '("reading" "unread" "finished" "reading"))) (progress (pcase status ("finished" 100) @@ -106,7 +100,7 @@ smaller value." :updated (format "D-%03d" (1+ index))))) (defun etaf-research-shelf--fixture-records () - "Return the deterministic fixture set sized by `...-fixture-size'." + "Return the deterministic fixture set sized by the user configuration." (let* ((target (max 0 etaf-research-shelf-fixture-size)) (base (copy-tree etaf-research-shelf-seed-records)) (base-count (length base))) @@ -117,17 +111,8 @@ smaller value." for index from 0 collect (etaf-research-shelf--generated-record id index)))))) -(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." + "Return the typed Research Shelf SQLite database description." (etaf-sqlite-database etaf-research-shelf-database-file (etaf-sqlite-table @@ -173,40 +158,117 @@ user's prior local additions cannot collide with the generated dataset." (setq next-id (1+ next-id)))))) database)) +;;; --------------------------------------------------------------------------- +;;; THEME / PALETTE CONTRACT +;;; --------------------------------------------------------------------------- + +(etaf-theme-define-palette etaf-research-shelf-ink + :fg ("#172033" . "#F4F7FF")) +(etaf-theme-define-palette etaf-research-shelf-paper + :bg ("#F7F3EA" . "#111827")) +(etaf-theme-define-palette etaf-research-shelf-panel + :bg ("#FFFDF8" . "#182235")) +(etaf-theme-define-palette etaf-research-shelf-line + :border ("#D9D4C9" . "#34435A")) +(etaf-theme-define-palette etaf-research-shelf-muted + :fg ("#6D7482" . "#AAB5C8")) +(etaf-theme-define-palette etaf-research-shelf-accent + :fg ("#3657D6" . "#8EA7FF")) +(etaf-theme-define-palette etaf-research-shelf-mint + :fg ("#3E9B8F" . "#76D6C3") + :bg ("#DCEBDD" . "#1B4721")) +(etaf-theme-define-palette etaf-research-shelf-coral + :fg ("#D86B5D" . "#FF9A8E")) +(etaf-theme-define-palette etaf-research-shelf-amber + :fg ("#C58A3A" . "#F0C36A")) +(etaf-theme-define-palette etaf-research-shelf-soft + :bg ("#F1EEE7" . "#202C42")) + +(defconst etaf-research-shelf--palette-bindings + '(:ink (etaf-research-shelf-ink . :fg) + :paper (etaf-research-shelf-paper . :bg) + :panel (etaf-research-shelf-panel . :bg) + :line (etaf-research-shelf-line . :border) + :muted (etaf-research-shelf-muted . :fg) + :accent (etaf-research-shelf-accent . :fg) + :mint (etaf-research-shelf-mint . :fg) + :mint-bg (etaf-research-shelf-mint . :bg) + :coral (etaf-research-shelf-coral . :fg) + :amber (etaf-research-shelf-amber . :fg) + :soft (etaf-research-shelf-soft . :bg)) + "Mapping from product roles to the optional TP palette adapter.") + +(defun etaf-research-shelf--theme (model) + "Return MODEL's current semantic product palette." + (etaf-theme-from-tp-palettes + etaf-research-shelf--palette-bindings + (if (etaf-value (plist-get model :dark)) 'dark 'light))) + +(defun etaf-research-shelf--theme-defaults (model) + "Return MODEL palette plus the public ETAF UI semantic token contract." + (let* ((palette (etaf-research-shelf--theme model)) + (ink (plist-get palette :ink)) + (paper (plist-get palette :paper)) + (panel (plist-get palette :panel)) + (line (plist-get palette :line)) + (muted (plist-get palette :muted)) + (accent (plist-get palette :accent)) + (mint (plist-get palette :mint)) + (mint-bg (plist-get palette :mint-bg)) + (coral (plist-get palette :coral)) + (soft (plist-get palette :soft))) + (append + palette + (list + :ui-fg ink :ui-bg paper :ui-border line :ui-muted-fg muted + :ui-danger-fg coral :ui-success-fg mint + :ui-disabled-fg muted :ui-disabled-bg soft + :ui-disabled-border line + :ui-button-primary-fg paper :ui-button-primary-bg accent + :ui-button-primary-border accent + :ui-button-secondary-fg ink :ui-button-secondary-bg mint + :ui-button-secondary-border mint + :ui-button-ghost-fg ink :ui-button-ghost-bg panel + :ui-button-ghost-border line + :ui-checkbox-enabled-fg ink :ui-checkbox-enabled-bg mint + :ui-checkbox-enabled-border mint + :ui-checkbox-disabled-fg muted :ui-checkbox-disabled-bg soft + :ui-checkbox-disabled-border line + :ui-grid-border line :ui-grid-selected-fg mint + :ui-grid-selected-bg mint-bg + :ui-grid-error-fg coral :ui-pagination-muted-fg muted + :ui-panel-fg ink :ui-panel-bg panel :ui-panel-border line)))) + +;;; --------------------------------------------------------------------------- +;;; STATE / DATA CONTROLLER / ACTIONS +;;; --------------------------------------------------------------------------- + +(defun etaf-research-shelf--item-id (row) + "Return stable identity for a reading ROW." + (plist-get row :id)) + (defun etaf-research-shelf--create-model () - "Create the application model and its SQLite-backed Data Controller." + "Create the Research Shelf model inside the owning Component Scope." (let* ((database (etaf-research-shelf--ensure-database)) (controller (etaf-data-controller (etaf-sqlite-source database) :page-size etaf-research-shelf-page-size - :auto-load nil :name 'etaf-research-shelf)) + :auto-load nil :item-key #'etaf-research-shelf--item-id + :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 - (let* ((load (plist-get (etaf-sqlite-source database) :load)) - (items (plist-get - (funcall load nil 1 - (max 1 etaf-research-shelf-fixture-size)) - :items))) - (1+ (if items - (apply #'max - (mapcar (lambda (row) - (or (plist-get row :id) 0)) - items)) - 0))) - :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))) + (toast (etaf-ref "Ready to read." :name 'research-shelf-toast))) + (list :database database + :database-file etaf-research-shelf-database-file + :controller controller :filter filter :dark dark :toast toast))) (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." + "Translate a product FILTER into an allowlisted equality query." (pcase filter ('reading '(:status "reading")) ('unread '(:status "unread")) @@ -232,40 +294,33 @@ user's prior local additions cannot collide with the generated dataset." (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)))))) + (etaf-research-shelf--load + model (format "Showing %s" (capitalize (symbol-name filter)))))) -(defun etaf-research-shelf--change-page-size (model) - "Prompt for MODEL's page size, validate it, and reload from page one." - (let* ((controller (etaf-research-shelf--controller model)) - (current (etaf-value (etaf-data-page-size controller))) - (next (read-number "Rows per page (1–100): " current))) - (unless (and (integerp next) (<= 1 next 100)) - (user-error "Rows per page must be an integer from 1 to 100")) - (etaf-data-set-page-size controller next) +(defun etaf-research-shelf--set-page-size (model page-size) + "Apply PAGE-SIZE to MODEL and reload from page one." + (unless (and (integerp page-size) (<= 1 page-size 100)) + (user-error "Rows per page must be an integer from 1 to 100")) + (let ((controller (etaf-research-shelf--controller model))) + (etaf-data-set-page-size controller page-size) (etaf-data-set-page controller 1) (etaf-research-shelf--load - model (format "Showing %d rows per page" next)))) + model (format "Showing %d rows per page" page-size)))) (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))) + "Return MODEL's selected item through the Data Controller identity contract." + (etaf-data-selected-item (etaf-research-shelf--controller model))) (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." + "Apply OPERATION PAYLOAD for MODEL and show MESSAGE on success." (let ((controller (etaf-research-shelf--controller model))) (condition-case err - (progn - (etaf-data-mutate controller operation payload) + (prog1 + (etaf-data-mutate controller operation payload) (setf (etaf-value (plist-get model :toast)) message)) (error (setf (etaf-value (plist-get model :toast)) @@ -279,32 +334,90 @@ Show MESSAGE on success, or preserve the resulting error state." (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"))) +;; Named Actions keep product mutations out of View callbacks. The View layer +;; only dispatches these stable application commands with the current model. +(etaf-action-define etaf-research-shelf-filter (runtime model filter) + "Apply FILTER to MODEL." + (ignore runtime) + (etaf-research-shelf--set-filter model filter)) -(defun etaf-research-shelf--color (model key) - "Return palette KEY for MODEL." - (plist-get (etaf-research-shelf--theme model) key)) +(etaf-action-define etaf-research-shelf-reload (runtime model) + "Reload MODEL's data source." + (ignore runtime) + (etaf-research-shelf--load model "✓ Library reloaded")) -(defun etaf-research-shelf--apply-buffer-palette (palette) - "Paint the GUI buffer's unused viewport columns with PALETTE. +(etaf-action-define etaf-research-shelf-page-size (runtime model page-size) + "Apply MODEL's page size from the controlled number input." + (ignore runtime) + (etaf-research-shelf--set-page-size model page-size)) -Ebox intentionally reserves a couple of rightmost display columns so a safe -layout never becomes a continuation line. Those columns contain no text -properties, so the buffer's default face must carry the same product surface -color or the frame edge exposes Emacs's unrelated default background." - (when (and (display-graphic-p) (fboundp 'face-remap-set-base)) - (face-remap-set-base - 'default - (list :foreground (plist-get palette :ink) - :background (plist-get palette :paper))))) +(etaf-action-define etaf-research-shelf-add (runtime model) + "Insert a new reading into MODEL." + (ignore runtime) + (etaf-research-shelf--mutate + model 'insert + '(:title "New reading" :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")) + +(etaf-action-define etaf-research-shelf-progress (runtime model) + "Advance the selected reading by ten percent." + (ignore runtime) + (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"))) + +(etaf-action-define etaf-research-shelf-finish (runtime model) + "Mark the selected reading finished." + (ignore runtime) + (etaf-research-shelf--update-selected + model '(:progress 100 :status "finished" :updated "Just now") + "✓ Marked finished")) + +(etaf-action-define etaf-research-shelf-star (runtime model) + "Toggle the selected reading's star." + (ignore runtime) + (when-let ((current (etaf-research-shelf--selected model))) + (let ((starred (= 1 (or (plist-get current :starred) 0)))) + (etaf-research-shelf--update-selected + model (list :starred (if starred 0 1) :updated "Just now") + (if starred "Removed star" "★ Starred locally"))))) + +(etaf-action-define etaf-research-shelf-archive (runtime model) + "Archive the selected reading." + (ignore runtime) + (etaf-research-shelf--update-selected + model '(:status "archived" :updated "Just now") "↗ Archived")) + +;;; --------------------------------------------------------------------------- +;;; VIEW / COMPONENTS / COMPOSITION +;;; --------------------------------------------------------------------------- + +(defconst etaf-research-shelf--grid-columns + '((:key :title :label "Title" :width 21) + (:key :author :label "Author" :width 12) + (:key :status :label "Status" :width 10) + (:key :progress :label "Progress" :width 8) + (:key :kind :label "Kind" :width 7)) + "Compact DataGrid columns for the Research Shelf list.") + +(defun etaf-research-shelf--theme-value (key &optional default) + "Return inherited Research Shelf Theme token KEY or DEFAULT." + (etaf-theme-value key default)) + +(defun etaf-research-shelf--static-child (form tag) + "Return the first TAG child from inert FORM." + (etaf-playground-static-child form tag)) + +(defun etaf-research-shelf--static-value (form key default) + "Return KEY from inert FORM, or DEFAULT." + (etaf-playground-static-value form key default)) (defun etaf-research-shelf--status-label (status) "Return a readable status label for STATUS." @@ -314,203 +427,142 @@ color or the frame edge exposes Emacs's unrelated default background." ("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-label (form key fallback) + "Return the static FILTER label from FORM for KEY, or FALLBACK." + (let ((entry (etaf-research-shelf--static-child form 'filter))) + (or (and entry (eq (plist-get (cdr entry) :key) key) + (plist-get (cdr entry) :label)) + (let ((entry (cl-find-if + (lambda (item) + (and (consp item) (eq (car item) 'filter) + (eq (plist-get (cdr item) :key) key))) + (cdr form)))) + (or (and entry (plist-get (cdr entry) :label)) fallback))))) -(defun etaf-research-shelf--button-style (palette variant disabled) - "Return style props for PALETTE, VARIANT, and DISABLED button state. - -The public `button' Component owns native interaction state; this small -adapter only maps the app palette to its ordinary presentation props so ghost -buttons do not fall back to a light-theme paper surface in dark mode." - (let ((secondary (eq variant 'secondary))) - (list :color (plist-get palette (if disabled :muted - (if secondary :paper :ink))) - :bgcolor (plist-get palette (if disabled :soft - (if secondary :mint :panel))) - :border (plist-get palette (if secondary :mint :line)) - :face (if (and secondary (not disabled)) 'bold 'normal)))) - -(etaf-define-component etaf-research-shelf-button - (&key theme label ref variant disabled on-press) - "Compose the public Button with the Research Shelf theme palette." +(etaf-define-component etaf-research-shelf-filter-button + (&key filter-key fallback ref) + "Render one filter Button from inherited model and static filter Context." :setup - (lambda () - (let* ((theme (etaf-current-prop :theme)) - (label (etaf-current-prop :label)) - (ref (etaf-current-prop :ref)) - (variant (etaf-current-prop :variant)) - (disabled (etaf-current-prop :disabled)) - (on-press (etaf-current-prop :on-press)) - (style (etaf-research-shelf--button-style - theme variant disabled))) - (etaf-view - (button :label label :ref ref :variant variant :disabled disabled - :on-press on-press - :color (plist-get style :color) - :bgcolor (plist-get style :bgcolor) - :border (plist-get style :border) - :face (plist-get style :face)))))) + (let ((model (etaf-inject 'research-shelf-model nil t)) + (form (etaf-inject 'research-shelf-filters nil t)) + (filter-key (etaf-current-prop :filter-key)) + (fallback (etaf-current-prop :fallback)) + (ref (etaf-current-prop :ref))) + (lambda () + (let ((active (eq filter-key (etaf-value (plist-get model :filter))))) + (etaf-view + (button :label + (let ((label (etaf-research-shelf--filter-label + form filter-key fallback))) + (if active (concat "● " label) label)) + :ref ref :variant (if active 'secondary 'ghost) + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-filter + model filter-key)))))))) -(defun etaf-research-shelf--filter-view (model form) - "Return the filter rail from MODEL and static FILTER FORM." - (etaf-view +(defun etaf-research-shelf--filter-view (model) + "Return the filter rail for MODEL and inherited filter Context." + (let ((theme (etaf-theme-defaults))) + (etaf-view (column :class "research-shelf-filter-rail" :width 'stretch :min-width 0 :flex-grow 1 :flex-shrink 1 :flex-basis '(220) :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)) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :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))) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :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))) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :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))) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :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))) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :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))) + :border (plist-get theme :line) + :color (plist-get theme :ink) + :bgcolor (plist-get theme :panel) + (label :text "Library" :face 'bold) + (label :text "VIEWS" :color (plist-get theme :muted)) + (etaf-research-shelf-filter-button + :filter-key 'all :fallback "All" :ref 'research-shelf-filter-all) + (etaf-research-shelf-filter-button + :filter-key 'reading :fallback "In progress" + :ref 'research-shelf-filter-reading) + (etaf-research-shelf-filter-button + :filter-key 'unread :fallback "Unread" :ref 'research-shelf-filter-unread) + (etaf-research-shelf-filter-button + :filter-key 'finished :fallback "Finished" + :ref 'research-shelf-filter-finished) + (etaf-research-shelf-filter-button + :filter-key 'starred :fallback "★ Starred" + :ref 'research-shelf-filter-starred) (spacer :height 1) - (label :text "STORAGE" :color (etaf-research-shelf--color model :muted) - :bgcolor (etaf-research-shelf--color model :panel)) + (label :text "STORAGE" :color (plist-get theme :muted)) (label :text (file-name-nondirectory - (plist-get model :database-file)) - :color (etaf-research-shelf--color model :ink) - :bgcolor (etaf-research-shelf--color model :panel)) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :label "↻ Reload library" :ref 'research-shelf-reload - :variant 'ghost - :on-press (lambda () (etaf-research-shelf--load model "✓ Library reloaded")))))) + (plist-get model :database-file))) + (button :label "↻ Reload library" :ref 'research-shelf-reload + :variant 'ghost + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-reload + model))))))) (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))) + "Return the reading list for MODEL and static MAIN FORM." + (let ((controller (etaf-research-shelf--controller model)) + (theme (etaf-theme-defaults))) (etaf-view (column :class "research-shelf-list" :width 'stretch :min-width 0 :flex-grow 4 :flex-shrink 1 :flex-basis '(620) :padding '(1 2) - :border (etaf-research-shelf--color model :line) - :color (etaf-research-shelf--color model :ink) - :bgcolor (etaf-research-shelf--color model :panel) + :border (plist-get theme :line) + :bgcolor (plist-get theme :panel) (flex :width 'stretch :flex-wrap 'wrap :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 (etaf-research-shelf--static-value + form :title "Reading queue") :face 'bold) (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))) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :label (format "Rows %d ✎" - (etaf-value (etaf-data-page-size controller))) - :ref 'research-shelf-page-size - :variant 'ghost - :on-press (lambda () - (etaf-research-shelf--change-page-size model))) - (etaf-research-shelf-button - :theme (etaf-research-shelf--theme model) - :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)))))) + :color (plist-get theme :muted))) + (number-input :label "Rows" + :value (etaf-value (etaf-data-page-size controller)) + :ref 'research-shelf-page-size :min 1 :max 100 + :on-change + (lambda (next) + (etaf-dispatch 'etaf-research-shelf-page-size + model next))) + (button :label "＋ Add reading" :ref 'research-shelf-add + :variant 'secondary + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-add model)))) (data-grid :controller controller :columns etaf-research-shelf--grid-columns - :row-key (lambda (row) (plist-get row :id)) + :row-key #'etaf-research-shelf--item-id :row-ref (lambda (row) (intern (format "research-shelf-row-%s" - (plist-get row :id)))) + (etaf-research-shelf--item-id row)))) :row-selected-p (lambda (row) - (etaf-data-selected-p controller (plist-get row :id))) + (etaf-data-selected-p controller + (etaf-research-shelf--item-id row))) :on-row-press (lambda (row) - (etaf-data-select-one controller (plist-get row :id))) + (etaf-data-select-one controller + (etaf-research-shelf--item-id 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)))))) + :color (plist-get theme :ink)))))) (defun etaf-research-shelf--detail-view (model form) "Return the selected record inspector for MODEL and static FORM." - (etaf-view + (let ((theme (etaf-theme-defaults))) + (etaf-view (column :class "research-shelf-detail" :width 'stretch :min-width 0 :flex-grow 2 :flex-shrink 1 :flex-basis '(340) :padding '(2 2) - :border (etaf-research-shelf--color model :line) - :color (etaf-research-shelf--color model :ink) - :bgcolor (etaf-research-shelf--color model :panel) + :border (plist-get theme :line) + :bgcolor (plist-get theme :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)) + :color (plist-get theme :accent)) (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) + (text :color (plist-get theme :muted) (expr :value (if-let ((row (etaf-research-shelf--selected model))) (format "%s · %s" (plist-get row :author) @@ -529,7 +581,7 @@ buttons do not fall back to a light-theme paper surface in dark mode." (or (plist-get row :progress) 0) (plist-get row :priority)) "Progress — · Priority —"))) - (text :color (etaf-research-shelf--color model :accent) + (text :color (plist-get theme :accent) (expr :value (let* ((row (etaf-research-shelf--selected model)) (progress (or (and row (plist-get row :progress)) 0)) @@ -537,198 +589,155 @@ buttons do not fall back to a light-theme paper surface in dark mode." (format "%s %s" (make-string filled ?█) (make-string (- 10 filled) ?░))))) (spacer :height 1) - (text :color (etaf-research-shelf--color model :muted) + (text :color (plist-get theme :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-research-shelf-detail-actions))))) -(etaf-define-component etaf-research-shelf-detail-actions (&key model) - "Render stable selected-record actions for MODEL." +(etaf-define-component etaf-research-shelf-detail-actions () + "Render selected-record actions from the inherited Research Shelf model." :setup - (let ((model (etaf-current-prop :model))) + (let ((model (etaf-inject 'research-shelf-model nil t))) (lambda () - (let* ((theme (etaf-research-shelf--theme model)) - (row (etaf-research-shelf--selected model)) + (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)) - (etaf-research-shelf-button - :theme theme :label "+ 10%" :ref 'research-shelf-progress - :variant 'secondary - :disabled (or (null row) archived (>= 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")))) - (etaf-research-shelf-button - :theme theme :label "✓ Finish" :ref 'research-shelf-finish - :variant 'secondary :disabled (or (null row) finished archived) - :on-press - (lambda () - (etaf-research-shelf--update-selected - model '(:progress 100 :status "finished" :updated "Just now") - "✓ Marked finished"))) - (etaf-research-shelf-button - :theme theme :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")))))) - (etaf-research-shelf-button - :theme theme :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"))))))))) + (button :label "+ 10%" :ref 'research-shelf-progress + :variant 'secondary + :disabled (or (null row) archived (>= progress 100)) + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-progress + model))) + (button :label "✓ Finish" :ref 'research-shelf-finish + :variant 'secondary :disabled (or (null row) finished archived) + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-finish + model))) + (button :label "★ Star" :ref 'research-shelf-star + :variant 'ghost :disabled (null row) + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-star model))) + (button :label "Archive" :ref 'research-shelf-archive + :variant 'ghost :disabled (or (null row) archived) + :on-press (lambda () + (etaf-dispatch 'etaf-research-shelf-archive + model))))))))) -(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'." +(etaf-define-component etaf-research-shelf-filter-rail () + "Render the Research Shelf filter rail from inherited Context." :setup - (let ((model (etaf-current-prop :model)) - (static-form (etaf-current-prop :static-form))) - (lambda () (etaf-research-shelf--filter-view model static-form)))) + (let ((model (etaf-inject 'research-shelf-model nil t))) + (lambda () (etaf-research-shelf--filter-view model)))) -(etaf-define-component etaf-research-shelf-reading-list - (&key model static-form) - "Render the reusable Research Shelf reading list." +(etaf-define-component etaf-research-shelf-reading-list () + "Render the Research Shelf reading list from inherited Context." :setup - (let ((model (etaf-current-prop :model)) - (static-form (etaf-current-prop :static-form))) - (lambda () (etaf-research-shelf--reading-list-view model static-form)))) + (let ((model (etaf-inject 'research-shelf-model nil t)) + (form (etaf-inject 'research-shelf-library nil t))) + (lambda () (etaf-research-shelf--reading-list-view model form)))) -(etaf-define-component etaf-research-shelf-detail-inspector - (&key model static-form) - "Render the reusable Research Shelf detail inspector." +(etaf-define-component etaf-research-shelf-detail-inspector () + "Render the Research Shelf detail inspector from inherited Context." :setup - (let ((model (etaf-current-prop :model)) - (static-form (etaf-current-prop :static-form))) - (lambda () (etaf-research-shelf--detail-view model static-form)))) + (let ((model (etaf-inject 'research-shelf-model nil t)) + (form (etaf-inject 'research-shelf-detail nil t))) + (lambda () (etaf-research-shelf--detail-view model 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))) +(etaf-define-component etaf-research-shelf-shell (&key static-form) + "Compose the Research Shelf app and provide its model/theme Context." :setup - (let ((model (etaf-current-prop :model)) - (static-form (etaf-current-prop :static-form))) - (etaf-on-unmounted + (let* ((static-form (etaf-current-prop :static-form)) + (model (etaf-research-shelf--create-model)) + (theme (etaf-computed + (lambda () + (etaf-research-shelf--theme-defaults model)) + :name 'research-shelf-theme)) + (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))) + (etaf-on-mounted (lambda () - (etaf-data-stop (etaf-research-shelf--controller model)) - (when (and (display-graphic-p) - (fboundp 'face-remap-set-base)) - (face-remap-set-base 'default 'default)))) + (etaf-research-shelf--load model "✓ SQLite shelf ready"))) + (etaf-theme-provide theme) + (etaf-provide 'research-shelf-model model) + (etaf-provide 'research-shelf-filters filters) + (etaf-provide 'research-shelf-library library) + (etaf-provide 'research-shelf-detail detail) (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-research-shelf--apply-buffer-palette palette) + (let ((dark (etaf-value (plist-get model :dark)))) (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 - :flex-wrap 'wrap - :align-items 'center :gap '(1 (10)) + :color (etaf-research-shelf--theme-value :ink) + :bgcolor (etaf-research-shelf--theme-value :paper) + (flex :class "research-shelf-header" :width 'stretch :min-width 0 + :flex-wrap 'wrap :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)) + :color (etaf-research-shelf--theme-value :accent)) (label :text (etaf-research-shelf--static-value - static-form :title "Research Shelf") :face 'bold - :color (plist-get palette :ink) - :bgcolor (plist-get palette :paper)) + static-form :title "Research Shelf") :face 'bold) (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) - (etaf-research-shelf--apply-buffer-palette - (etaf-research-shelf--theme model)) - (setf (etaf-value (plist-get model :toast)) - (if value "Dark theme" "Light theme"))))) + static-form :subtitle + "A quiet place for unfinished ideas") + :color (etaf-research-shelf--theme-value :muted))) + (column :width 'max-content :min-width 0 + :flex-grow 0 :flex-shrink 0 + (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")))))) (flex :class "research-shelf-workspace" :width 'stretch :flex-wrap 'wrap :align-items 'stretch :align-content 'start - :gap '(1 (6)) :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)) + :gap '(1 (6)) + (etaf-research-shelf-filter-rail) + (etaf-research-shelf-reading-list) + (etaf-research-shelf-detail-inspector)) (flex :class "research-shelf-footer" :width 'stretch :flex-wrap 'wrap :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 (or (etaf-value (plist-get model :toast)) "Ready"))) (label :text (file-name-nondirectory (plist-get model :database-file)) - :color (plist-get palette :muted) - :bgcolor (plist-get palette :paper))))))))) + :color (etaf-research-shelf--theme-value :muted))))))))) -(defun etaf-research-shelf-root (static-form) - "Consume validated STATIC-FORM and return one owned application root View." +;;; --------------------------------------------------------------------------- +;;; ROOT / PLAYGROUND REGISTRATION +;;; --------------------------------------------------------------------------- + +(defun etaf-research-shelf-root (static-form &optional ecss-form) + "Consume validated STATIC-FORM and ECSS-FORM as one 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-view - (research-shelf-shell :model model :static-form static-form))))) + (etaf-component-set-styles 'etaf-research-shelf-shell ecss-form) + (lambda () + (etaf-view + (research-shelf-shell :static-form static-form)))) + +(etaf-playground-register-example + "research-shelf" + :root #'etaf-research-shelf-root + :feature 'etaf-research-shelf + :reload-on-refresh t) ;;;###autoload (defun etaf-research-shelf-open (&optional buffer-name) - "Mount and optionally display the Research Shelf application in BUFFER-NAME." + "Mount the Research Shelf, optionally displaying it in BUFFER-NAME." (interactive) - (let* ((name (or buffer-name "*ETAF Research Shelf*")) - ;; Put the target in its real GUI window before the first Ebox - ;; projection so `(viewport)' resolves against the user's frame. - (buffer (get-buffer-create name))) - (when (called-interactively-p 'interactive) - (switch-to-buffer buffer)) - (etaf-mount buffer - (etaf-research-shelf-root - (etaf-playground-read-static "research-shelf"))))) + (if buffer-name + (etaf-playground-open-example "research-shelf" buffer-name) + (etaf-playground-open-example "research-shelf"))) (provide 'etaf-research-shelf) ;;; research-shelf.el ends here diff --git a/scripts/benchmark-research-shelf.el b/scripts/benchmark-research-shelf.el index 3c37318..4615111 100644 --- a/scripts/benchmark-research-shelf.el +++ b/scripts/benchmark-research-shelf.el @@ -8,7 +8,7 @@ (require 'cl-lib) (require 'etaf-playground) -(defconst etaf-research-shelf-benchmark-row-p50-budget-ms 105.0) +(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) @@ -40,8 +40,14 @@ The number of measured events is `RUNS'." (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* ((source (expand-file-name "examples/research-shelf.el" + default-directory)) + (compiled (concat (file-name-sans-extension source) ".elc")) + (file (if (and (file-readable-p compiled) + (not (file-newer-than-file-p source compiled))) + compiled + source))) + (load file nil nil t)) (let ((database (make-temp-file "etaf-research-shelf-perf-" nil ".sqlite")) (buffer " *etaf-research-shelf-perf*")) (unwind-protect diff --git a/tests/etaf-playground-tests.el b/tests/etaf-playground-tests.el index 167af18..a0f0c68 100644 --- a/tests/etaf-playground-tests.el +++ b/tests/etaf-playground-tests.el @@ -23,6 +23,8 @@ (defun etaf-playground-test--close (buffer) "Close BUFFER when it exists." + (when (gethash "research-shelf" etaf-playground--sessions) + (etaf-playground-close "research-shelf")) (when (get-buffer buffer) (etaf-playground-close buffer))) @@ -51,30 +53,36 @@ database and mounts a test buffer before running BODY." (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)) +(ert-deftest etaf-playground-framework-discovers-generic-file-triplets () + "Discover examples from files without a business catalog in the framework." + (should (member "research-shelf" etaf-playground-example-names)) + (let ((entry (etaf-playground-scenario "research-shelf")) (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 :companion-feature :static-tags - :capabilities :refs :gui-checkpoints :performance)) + (buffer-string))) + (companion (with-temp-buffer + (insert-file-contents "examples/research-shelf.el") + (buffer-string)))) + (dolist (key '(:pair :directory :etaf-file :el-file :ecss-file + :root-component :companion-feature)) (should (plist-member entry key))) - (should (string-match-p - "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 (file-readable-p (plist-get entry :etaf-file))) + (should (file-readable-p (plist-get entry :el-file))) + (should (file-readable-p (plist-get entry :ecss-file))) + (should (string-match-p "wildcard examples" makefile)) + (should-not (string-match-p "mindepth 2" makefile)) + (should-not (string-match-p "etaf-playground-catalog" framework)) (should-not (string-match-p "research-shelf" framework)) (should-not (string-match-p "operations-console" framework)) - (should (string-match-p "research-shelf" catalog)))) + (dolist (section '("DATA / SQLITE SOURCE" + "THEME / PALETTE CONTRACT" + "STATE / DATA CONTROLLER / ACTIONS" + "VIEW / COMPONENTS / COMPOSITION" + "ROOT / PLAYGROUND REGISTRATION")) + (should (string-match-p (regexp-quote section) companion))))) (ert-deftest etaf-playground-displays-before-responsive-mount () "GUI entry points establish the containing window before Ebox mount." @@ -131,6 +139,145 @@ database and mounts a test buffer before running BODY." (should-error (etaf-playground--validate-static-node unsafe tags) :type 'error)))) +(ert-deftest etaf-playground-ecss-reader-is-inert-and-usable () + "Read the optional style companion as validated static Component styles." + (let ((form (etaf-playground-read-ecss "research-shelf"))) + (should (equal 'styles (car form))) + (should (= 6 (length (cdr form)))) + (dolist (rule (cdr form)) + (should (stringp (car rule))) + (should (cl-every #'keywordp + (cl-loop for (key _value) on (cdr rule) by #'cddr + collect key)))))) + +(ert-deftest etaf-playground-workspace-switches-three-source-buffers () + "One session switches `.etaf', `.el', and `.ecss' beside one preview." + (etaf-playground-test--with-app (buffer database) + (ignore buffer) + (let ((etaf-research-shelf-database-file database) + (source (etaf-playground-open-example "research-shelf"))) + (ignore etaf-research-shelf-database-file) + (let* ((session (buffer-local-value 'etaf-playground-session source)) + (preview (etaf-playground-session-preview-buffer session))) + (should (etaf-playground-session-p session)) + (should (= 3 (length (etaf-playground-session-source-buffers session)))) + (should (equal ".etaf" + (etaf-playground-session-active-extension session))) + (should (etaf-runtime-p (etaf-runtime-for-buffer preview))) + (etaf-playground-show-el source) + (should (equal ".el" + (etaf-playground-session-active-extension session))) + (etaf-playground-show-ecss source) + (should (equal ".ecss" + (etaf-playground-session-active-extension session))) + (should (equal (etaf-playground-read-ecss "research-shelf" session) + (etaf-component-styles 'etaf-research-shelf-shell))))))) + +(ert-deftest etaf-playground-source-tabs-have-buttons-and-shortcuts () + "Source tabs work through both header buttons and keyboard shortcuts." + (etaf-playground-test--with-app (buffer database) + (ignore buffer) + (let ((etaf-research-shelf-database-file database) + (source (etaf-playground-open-example "research-shelf"))) + (ignore etaf-research-shelf-database-file) + (with-current-buffer source + (should (eq #'etaf-playground-refresh + (key-binding (kbd "C-c C-c")))) + (should (eq #'etaf-playground-show-etaf + (key-binding (kbd "C-c 1")))) + (should (eq #'etaf-playground-show-el + (key-binding (kbd "C-c 2")))) + (should (eq #'etaf-playground-show-ecss + (key-binding (kbd "C-c 3")))) + (call-interactively (key-binding (kbd "C-c C-c"))) + (should (etaf-runtime-p + (etaf-runtime-for-buffer + (etaf-playground-session-preview-buffer + etaf-playground-session)))) + (let* ((header (etaf-playground--source-header)) + (position (string-match " EL" header))) + (should position) + (should (get-text-property position 'button header)) + (should (equal ".el" + (get-text-property position 'button-data header))) + (etaf-playground--activate-source-tab + (propertize " EL " 'etaf-playground-extension ".el")) + (should (equal ".el" + (etaf-playground-session-active-extension + etaf-playground-session)))))))) + +(ert-deftest etaf-playground-direct-etaf-c-c-c-opens-workspace () + "The source render command opens a workspace for a directly opened `.etaf'." + (etaf-playground-test--with-app (buffer database) + (ignore buffer) + (let* ((etaf-research-shelf-database-file database) + (source (find-file-noselect + (expand-file-name "examples/research-shelf.etaf" + default-directory)))) + (ignore etaf-research-shelf-database-file) + (unwind-protect + (with-current-buffer source + (should (eq #'etaf-playground-refresh + (key-binding (kbd "C-c C-c")))) + (should (etaf-playground-refresh source)) + (let ((session (buffer-local-value 'etaf-playground-session source))) + (should (etaf-playground-session-p session)) + (should (etaf-runtime-p + (etaf-runtime-for-buffer + (etaf-playground-session-preview-buffer session)))))) + (when (buffer-live-p source) + (etaf-playground-close source)))))) + +(ert-deftest etaf-playground-does-not-remap-source-buffer () + "The Research Shelf surface does not remap the source editor buffer." + (etaf-playground-test--with-app (buffer database) + (ignore buffer) + (let ((etaf-research-shelf-database-file database)) + (ignore etaf-research-shelf-database-file) + (let* ((source (etaf-playground-open-example "research-shelf")) + (session (buffer-local-value 'etaf-playground-session source)) + (preview (etaf-playground-session-preview-buffer session))) + (should (null (buffer-local-value 'face-remapping-alist source))) + (should (etaf-runtime-p (etaf-runtime-for-buffer preview))))))) + +(ert-deftest etaf-playground-refresh-uses-unsaved-etaf-source () + "Refreshing a workspace reads the current source buffer, not disk only." + (etaf-playground-test--with-app (buffer database) + (ignore buffer) + (let ((etaf-research-shelf-database-file database) + (source (etaf-playground-open-example "research-shelf"))) + (ignore etaf-research-shelf-database-file) + (with-current-buffer source + (goto-char (point-min)) + (search-forward ":title \"Research Shelf\"") + (replace-match ":title \"Research Shelf (edited)\"" t t) + (set-buffer-modified-p t)) + (should (etaf-playground-refresh source)) + (should (string-match-p "Research Shelf (edited)" + (etaf-playground-test--text + (etaf-playground-session-preview-buffer + (buffer-local-value 'etaf-playground-session + source)))))))) + +(ert-deftest etaf-playground-refresh-reloads-unsaved-el-companion () + "Refreshing a dirty `.el' companion redefines its consumer intentionally." + (etaf-playground-test--with-app (buffer database) + (ignore buffer) + (let ((etaf-research-shelf-database-file database) + (source (etaf-playground-open-example "research-shelf"))) + (ignore etaf-research-shelf-database-file) + (let* ((session (buffer-local-value 'etaf-playground-session source)) + (el (etaf-playground--source-buffer session ".el"))) + (with-current-buffer el + (goto-char (point-max)) + (insert "\n;; dirty companion reload sentinel\n") + (set-buffer-modified-p t)) + (should (etaf-playground-refresh source)) + (should-not (etaf-playground-session-companion-dirty-p session)) + (should (etaf-runtime-p + (etaf-runtime-for-buffer + (etaf-playground-session-preview-buffer session)))))))) + (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) @@ -216,12 +363,18 @@ database and mounts a test buffer before running BODY." (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) + (let ((page-one (etaf-playground-test--text buffer))) + (should (string-match-p "The Shape of Tools" page-one)) + (should-not (string-match-p "The Craftsman" page-one))) (etaf-dispatch-event runtime 'research-shelf-page-next 'press) - (should (string-match-p "Page 2 / 2" - (etaf-playground-test--text buffer))) + (let ((page-two (etaf-playground-test--text buffer))) + (should (string-match-p "Page 2 / 2" page-two)) + (should (string-match-p "The Craftsman" page-two)) + (should-not (string-match-p "The Shape of Tools" page-two))) (etaf-dispatch-event runtime 'research-shelf-page-previous 'press) - (should (string-match-p "Page 1 / 2" - (etaf-playground-test--text buffer))) + (let ((page-one-again (etaf-playground-test--text buffer))) + (should (string-match-p "Page 1 / 2" page-one-again)) + (should (string-match-p "The Shape of Tools" page-one-again))) (cl-letf (((symbol-function 'read-number) (lambda (&rest _) 6))) (etaf-dispatch-event runtime 'research-shelf-page-size 'press)) @@ -253,11 +406,13 @@ database and mounts a test buffer before running BODY." (line-of "Selected item")))) (pcase-let ((`(,filter-line ,list-line ,detail-line) (layout-at 1600))) - (should (= filter-line list-line)) + ;; Different child Components may start their first text baseline one + ;; line apart while still sharing the same wide Flex row. + (should (<= (abs (- filter-line list-line)) 1)) (should (<= (- detail-line list-line) 1))) (pcase-let ((`(,filter-line ,list-line ,detail-line) (layout-at 900))) - (should (= filter-line list-line)) + (should (<= (abs (- filter-line list-line)) 1)) (should (> detail-line list-line))) (pcase-let ((`(,filter-line ,list-line ,detail-line) (layout-at 600)))