geekinney/etaf-playground
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Simplify Research Shelf authoring workflow

Browse Source
This commit is contained in:
Kinneyzhang 2026-08-24 02:08:54 +08:00
parent 658a086cbc
commit ae76271e81
11 changed files with 1728 additions and 661 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
DESIGN.md
View File

@ -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

58
DESIGN.zh-CN.md
View File

@ -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，

17
Makefile
View File

@ -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)

56
README.md
View File

@ -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.

49
README.zh-CN.md
View File

@ -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。

31
etaf-playground-catalog.el
View File

@ -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

1079
etaf-playground.el
View File

File diff suppressed because it is too large Load Diff

10
examples/research-shelf.ecss Normal file
View File

@ -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)))

799
examples/research-shelf.el
View File

@ -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

12
scripts/benchmark-research-shelf.el
View File

@ -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

199
tests/etaf-playground-tests.el
View File

@ -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)))