Simplify Research Shelf authoring workflow
This commit is contained in:
parent
658a086cbc
commit
ae76271e81
79
DESIGN.md
79
DESIGN.md
@ -3,8 +3,9 @@
|
|||||||
## Source of truth
|
## Source of truth
|
||||||
|
|
||||||
- Status: Active
|
- Status: Active
|
||||||
- Last refreshed: 2026-08-22
|
- Last refreshed: 2026-08-23
|
||||||
- Primary product surface: `examples/research-shelf.etaf` + `examples/research-shelf.el`
|
- Primary product surface: generic `etaf-playground.el` workspace plus the
|
||||||
|
`examples/research-shelf.etaf` / `.el` / `.ecss` consumer triplet
|
||||||
- Visual reference: `design/research-shelf.html`
|
- Visual reference: `design/research-shelf.html`
|
||||||
- Evidence reviewed: ETAF public View/Component/Data/Resource APIs, `etaf-ui`
|
- Evidence reviewed: ETAF public View/Component/Data/Resource APIs, `etaf-ui`
|
||||||
Button/Checkbox/Panel/DataGrid/Pagination, and `etaf-sqlite`'s typed source
|
Button/Checkbox/Panel/DataGrid/Pagination, and `etaf-sqlite`'s typed source
|
||||||
@ -92,20 +93,46 @@
|
|||||||
|
|
||||||
## Playground framework boundary
|
## Playground framework boundary
|
||||||
|
|
||||||
- `etaf-playground.el` is a reusable framework, not an application module.
|
- `etaf-playground.el` is a reusable source/preview workspace, not an
|
||||||
- The framework owns pair registration semantics, safe inert `.etaf` parsing,
|
application module. It discovers same-basename `.etaf`/`.el` files and an
|
||||||
companion loading, mount/reset/close, and test/GUI entry points. Replaceable
|
optional `.ecss` file, creates the left source session, and mounts the right
|
||||||
deployment metadata lives in `etaf-playground-catalog.el`, outside the
|
preview.
|
||||||
loader implementation.
|
- The framework owns inert source readers, companion registration overrides,
|
||||||
- A pair companion owns its Components, storage adapters, state, resources,
|
source tabs, window layout, refresh/reset/close, and ETAF Runtime lifecycle.
|
||||||
events, and root factory. The framework must not reference a business
|
It does not require a catalog or name a business application.
|
||||||
component, database package, table schema, palette, or application-specific
|
- A companion owns its Components, storage adapters, state, resources, events,
|
||||||
ref.
|
style consumers, and root factory. The framework must not reference a
|
||||||
- Reuse is expressed through the generic manifest/loader contract and the
|
business component, database package, table schema, palette, or
|
||||||
existing public ETAF/etaf-ui components. New business behavior belongs in a
|
application-specific ref.
|
||||||
same-basename pair, never in the framework.
|
- `.etaf` and `.ecss` are read as data. `.el` is evaluated only when a preview
|
||||||
- Any future Playground example must add a catalog entry and its own `.etaf`/
|
is first loaded or the companion source is explicitly dirty; normal ETAF
|
||||||
`.el` files without changing framework semantics.
|
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
|
## Accessibility
|
||||||
|
|
||||||
@ -146,8 +173,14 @@
|
|||||||
|
|
||||||
## Implementation constraints
|
## Implementation constraints
|
||||||
|
|
||||||
- Framework/styling: public ETAF View DSL and `etaf-ui`; SQLite through the
|
- Framework/styling: source/preview orchestration is public ETAF API only;
|
||||||
sibling `etaf-sqlite` package; no HTML/CSS runtime dependency.
|
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/
|
- Data schema: one typed `reading_items` SQLite table with id/title/author/
|
||||||
kind/status/progress/priority/starred/note/updated columns.
|
kind/status/progress/priority/starred/note/updated columns.
|
||||||
- Pressure fixture: `etaf-research-shelf-fixture-size` defaults to 256 and
|
- 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.
|
preserved and missing fixture rows are topped up with fresh IDs.
|
||||||
- Performance: one Data mutation -> one Runtime generation/publication; normal
|
- Performance: one Data mutation -> one Runtime generation/publication; normal
|
||||||
warm actions remain under the accepted 105ms p50 target.
|
warm actions remain under the accepted 105ms p50 target.
|
||||||
- Compatibility: one same-basename `research-shelf` pair only; old console
|
- Compatibility: any same-basename `.etaf`/`.el` example is discoverable;
|
||||||
examples are removed from the active manifest and compile surface.
|
`.ecss` is optional, and the bundled Research Shelf remains only one
|
||||||
- Verification: SQLite temp-file integration tests, pair mount/remount tests,
|
consumer.
|
||||||
repeated selection/mutation tests, and clean fullscreen GUI screenshots.
|
- 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
|
## Open questions
|
||||||
|
|
||||||
|
|||||||
@ -3,8 +3,9 @@
|
|||||||
## 来源与状态
|
## 来源与状态
|
||||||
|
|
||||||
- 状态:active
|
- 状态:active
|
||||||
- 更新日期:2026-08-22
|
- 更新日期:2026-08-23
|
||||||
- 主产品面:`examples/research-shelf.etaf` + `examples/research-shelf.el`
|
- 主产品面:通用 `etaf-playground.el` 工作区,以及
|
||||||
|
`examples/research-shelf.etaf` / `.el` / `.ecss` consumer 三件套
|
||||||
- HTML 视觉基线:`design/research-shelf.html`
|
- HTML 视觉基线:`design/research-shelf.html`
|
||||||
- 已审查:ETAF View/Component/Data API、`etaf-ui` 的公开组件,以及
|
- 已审查:ETAF View/Component/Data API、`etaf-ui` 的公开组件,以及
|
||||||
`etaf-sqlite` 的 typed source 合同。
|
`etaf-sqlite` 的 typed source 合同。
|
||||||
@ -21,33 +22,59 @@ Playground 默认安装确定性的 256 条 fixture、每页 12 条,用于真
|
|||||||
|
|
||||||
- Shell:标题/副标题/主题切换 → 三列 workspace → 持久化状态栏。
|
- Shell:标题/副标题/主题切换 → 三列 workspace → 持久化状态栏。
|
||||||
- 三列 workspace:筛选栏 / SQLite reading list / selected-item detail inspector。
|
- 三列 workspace:筛选栏 / SQLite reading list / selected-item detail inspector。
|
||||||
- `.etaf`:只保存经过白名单校验的静态结构和文案(section、filter、label)。
|
- `.etaf`:只保存经过 inert 校验的静态结构和文案(section、filter、label)。
|
||||||
- 同名 `.el`:消费 `.etaf`,组合公开 UI Components,创建 SQLite schema、Data
|
- `.ecss`:可选的 inert `(styles ...)` 规则,由 companion 消费并应用到 ETAF
|
||||||
|
Component style scope。
|
||||||
|
- 同名 `.el`:消费 `.etaf/.ecss`,组合公开 UI Components,创建 SQLite schema、Data
|
||||||
Controller、refs、事件处理和生命周期清理。
|
Controller、refs、事件处理和生命周期清理。
|
||||||
- 现有可复用组件:`button`、`checkbox`、`label`、`panel`、`data-grid`、
|
- 现有可复用组件:`button`、`checkbox`、`label`、`panel`、`data-grid`、
|
||||||
`pagination`;应用只负责把它们组合成产品,不复制一套 UI kit。
|
`pagination`;应用只负责把它们组合成产品,不复制一套 UI kit。
|
||||||
|
|
||||||
## Playground 框架边界(必须长期遵守)
|
## Playground 框架边界(必须长期遵守)
|
||||||
|
|
||||||
`etaf-playground.el` 是通用 pair playground 框架,不是业务应用模块。
|
`etaf-playground.el` 是通用的 source/preview 工作区,不是业务应用模块。它从同名
|
||||||
`etaf-playground-catalog.el` 是独立、可替换的部署目录;业务 pair 的名字、refs
|
`.etaf`/`.el` 文件发现应用,并把可选的 `.ecss` 作为第三个 source tab;左侧是
|
||||||
和验证元数据放在 catalog,不写进 loader 实现。
|
源码会话,右侧是 ETAF 预览。
|
||||||
|
|
||||||
框架只负责:
|
框架只负责:
|
||||||
|
|
||||||
- pair 注册语义和 catalog 读取;
|
- 惰性、inert 的 `.etaf`/`.ecss` 读取和 companion 注册覆盖;
|
||||||
- `.etaf` 的惰性、inert、白名单读取;
|
- `.etaf`、`.el`、`.ecss` source buffer 的 tab 切换;
|
||||||
- 按同名 pair 加载 companion;
|
- 左右窗口布局、刷新、reset、close,以及 ETAF Runtime 生命周期。
|
||||||
- mount、reset、close,以及测试/GUI 入口。
|
|
||||||
|
|
||||||
框架绝不负责:业务 Component、数据库包或表结构、palette、业务 state、
|
框架绝不负责:业务 Component、数据库包或表结构、palette、业务 state、
|
||||||
handlers、resources 或应用 refs。它不能 `require etaf-sqlite`,也不能把业务
|
handlers、resources 或应用 refs。它不能 `require etaf-sqlite`,也不能把业务
|
||||||
组件实现塞进 loader/helper。未来新增例子时,只增加一个同名 `.etaf`/`.el` pair
|
组件实现塞进 loader/helper。未来新增例子时,只增加一个同名 `.etaf`/`.el` pair,
|
||||||
和 catalog entry,不改变框架语义。
|
必要时再加 `.ecss`,不改变框架语义。
|
||||||
|
|
||||||
组合和复用是默认设计:优先复用 ETAF/`etaf-ui` 的公开契约,优先拆出清晰的
|
组合和复用是默认设计:优先复用 ETAF/`etaf-ui` 的公开契约,优先拆出清晰的
|
||||||
Component 边界,避免新增 helper 层或抽象泄漏。
|
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
|
- 气质:editorial、专注、温暖、安静而聪明;避免通用 admin dashboard、KPI
|
||||||
@ -78,8 +105,9 @@ Component 边界,避免新增 helper 层或抽象泄漏。
|
|||||||
- Shell 只使用一套带 basis/grow 权重的 wrapping Flex,不读取窗口宽度、不维护
|
- Shell 只使用一套带 basis/grow 权重的 wrapping Flex,不读取窗口宽度、不维护
|
||||||
breakpoint 状态;`row` 只负责紧凑 intrinsic 控件,所有操作控件仍保持独立
|
breakpoint 状态;`row` 只负责紧凑 intrinsic 控件,所有操作控件仍保持独立
|
||||||
hover/focus 语义。
|
hover/focus 语义。
|
||||||
- 用 SQLite 临时文件测试 mount/remount、筛选、分页、重复选行、mutation、错误
|
- 用 inert reader、source tab/session、未保存 source refresh 和 SQLite 临时文件
|
||||||
状态和 cleanup;GUI 用干净 fullscreen 单窗口截图验证真实布局。
|
测试 mount/remount、筛选、分页、重复选行、mutation、错误状态和 cleanup;GUI
|
||||||
|
用干净 fullscreen 截图验证真实布局。
|
||||||
- 目标:一次 Data mutation 对应一次 Runtime generation/publication;warm 交互
|
- 目标:一次 Data mutation 对应一次 Runtime generation/publication;warm 交互
|
||||||
维持已接受的 105ms p50 预算。
|
维持已接受的 105ms p50 预算。
|
||||||
- 压测入口:`etaf-research-shelf-fixture-size` 默认 256,
|
- 压测入口:`etaf-research-shelf-fixture-size` 默认 256,
|
||||||
|
|||||||
17
Makefile
17
Makefile
@ -1,6 +1,8 @@
|
|||||||
EMACS ?= emacs
|
EMACS ?= emacs
|
||||||
LOAD_PATH = -L . -L ../etaf -L ../etaf-ui -L ../ebox -L ../ecss -L ../tp -L ../etaf-sqlite
|
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
|
.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 compile EMACS="$(EMACS)"
|
||||||
$(MAKE) -C ../etaf-ui compile EMACS="$(EMACS)"
|
$(MAKE) -C ../etaf-ui compile EMACS="$(EMACS)"
|
||||||
$(MAKE) -C ../etaf-sqlite 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)' \
|
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
|
||||||
--eval '(load-file "etaf-playground.el")' \
|
--eval '(load-file "etaf-playground.el")' \
|
||||||
--eval '(dolist (file (quote ($(foreach file,$(EXAMPLE_EL),"$(file)")))) (byte-compile-file file))' \
|
--eval '(dolist (file (quote ($(foreach file,$(ENTRY_EXAMPLES),"$(file)")))) (load-file file))' \
|
||||||
--eval '(byte-compile-file "etaf-playground-catalog.el")' \
|
--eval '(dolist (file (quote ($(foreach file,$(EXAMPLES),"$(file)")))) (byte-compile-file file))' \
|
||||||
--eval '(byte-compile-file "etaf-playground.el")' \
|
--eval '(byte-compile-file "etaf-playground.el")' \
|
||||||
--eval '(byte-compile-file "tests/etaf-playground-tests.el")'
|
--eval '(byte-compile-file "tests/etaf-playground-tests.el")'
|
||||||
|
|
||||||
examples-read: compile
|
examples-read: compile
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
|
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
|
||||||
--eval '(require (quote etaf-playground))' \
|
--eval '(require (quote etaf-playground))' \
|
||||||
--eval '(load-file "examples/research-shelf.el")' \
|
--eval '(dolist (file (quote ($(foreach file,$(ENTRY_EXAMPLES),"$(file)")))) (load (file-name-sans-extension file) nil nil nil))' \
|
||||||
--eval '(let ((database (make-temp-file "etaf-playground-read-" nil ".sqlite")) (buffer " *etaf-playground-read*")) (unwind-protect (let ((etaf-research-shelf-database-file database)) (etaf-playground-mount-example buffer "research-shelf")) (etaf-playground-close buffer) (when (file-exists-p database) (delete-file database))))' \
|
|
||||||
--eval '(princ "ETAF example modules load OK\\n")'
|
--eval '(princ "ETAF example modules load OK\\n")'
|
||||||
|
|
||||||
test: examples-read
|
test: examples-read
|
||||||
@ -44,9 +45,9 @@ load: compile
|
|||||||
--eval '(princ "etaf-playground load OK\\n")'
|
--eval '(princ "etaf-playground load OK\\n")'
|
||||||
|
|
||||||
checkdoc:
|
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
|
check: checkdoc test
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f *.elc tests/*.elc examples/*.elc
|
rm -f *.elc tests/*.elc $(EXAMPLE_ELC)
|
||||||
|
|||||||
56
README.md
56
README.md
@ -1,23 +1,47 @@
|
|||||||
# ETAF Playground
|
# ETAF Playground
|
||||||
|
|
||||||
The Playground exposes one canonical product example: the
|
ETAF Playground is a generic authoring workspace: the left side edits one
|
||||||
`examples/research-shelf.etaf` and `examples/research-shelf.el` pair.
|
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-
|
Each example follows this contract:
|
||||||
basename companion owns Components, state, theme, storage, events, and
|
|
||||||
lifecycle. `etaf-playground.el` is a reusable pair framework: it owns only
|
- `examples/NAME.etaf` — one inert structural form;
|
||||||
registration, safe loading, mounting, reset, close, and verification entry
|
- `examples/NAME.el` — the companion Components, state, effects, and root
|
||||||
points. `etaf-playground-catalog.el` is the replaceable deployment catalog;
|
factory (`etaf-NAME-root` by convention);
|
||||||
business Components, database schemas, palettes, refs, and handlers
|
- `examples/NAME.ecss` — optional inert `(styles ...)` presentation rules.
|
||||||
must stay in the companion. Compose and reuse public ETAF/`etaf-ui` contracts
|
|
||||||
before adding abstractions.
|
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 check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`.
|
||||||
Run `make perf` for the 1413×62 warm row-selection/theme latency gate.
|
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
|
The bundled Research Shelf example installs a deterministic 256-record SQLite
|
||||||
per page. Bind `etaf-research-shelf-fixture-size` and
|
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.
|
`etaf-research-shelf-page-size` for smaller tests or larger pressure runs. Its
|
||||||
In the UI, activate `Rows N ✎` to enter any value from 1 through 100. The
|
application UI is only a consumer of the generic workspace; activate `Rows N
|
||||||
workspace is one responsive wrapping Flex composition: three columns when
|
✎` to enter any value from 1 through 100.
|
||||||
wide, rail/list plus wrapped detail at medium widths, and vertical when narrow.
|
|
||||||
|
|||||||
@ -1,19 +1,44 @@
|
|||||||
# ETAF Playground
|
# ETAF Playground
|
||||||
|
|
||||||
Playground 只公开一个标准产品示例:
|
ETAF Playground 是通用的应用构建工作区:左侧编辑同一个应用的源码,右侧挂载
|
||||||
`examples/research-shelf.etaf` 与 `examples/research-shelf.el` 配对。
|
实时 ETAF 预览。框架从文件发现 example,不内置具体业务 catalog,也不依赖某个
|
||||||
|
具体应用。
|
||||||
|
|
||||||
`.etaf` 是惰性、inert、经过白名单验证的静态结构数据;同名 companion 负责
|
每个 example 遵循同名文件合同:
|
||||||
Component、状态、主题、SQLite、事件与生命周期。`etaf-playground.el` 是通用
|
|
||||||
pair playground 框架,只负责注册、白名单读取、加载、mount/reset/close 和验证
|
- `examples/NAME.etaf`:一个 inert 的静态结构 form;
|
||||||
入口;`etaf-playground-catalog.el` 是可替换的部署目录。业务 Component、数据库
|
- `examples/NAME.el`:Component、状态、effect 和 root factory(默认命名为
|
||||||
schema、palette、refs 与 handlers 不能泄漏进框架。
|
`etaf-NAME-root`);
|
||||||
默认原则是组合和复用公开 ETAF/`etaf-ui` 契约,而不是再造一套组件或 helper 抽象。
|
- `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 check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。
|
||||||
性能门禁:`make perf`(1413×62 viewport 的 warm 选行/主题延迟)。
|
性能门禁:`make perf`(1413×62 viewport 的 warm 选行/主题延迟)。
|
||||||
|
|
||||||
示例默认安装确定性的 256 条 SQLite fixture,每页显示 12 条。测试或压测时可以
|
仓库中的 Research Shelf 只是上述通用工作区的一个 consumer。它默认安装确定性的
|
||||||
绑定 `etaf-research-shelf-fixture-size` 和 `etaf-research-shelf-page-size` 调整规模;
|
256 条 SQLite fixture,每页显示 12 条;测试或压测时可以绑定
|
||||||
界面中激活 `Rows N ✎` 可以输入 1–100。Workspace 使用同一套 wrapping Flex:
|
`etaf-research-shelf-fixture-size` 和 `etaf-research-shelf-page-size` 调整规模,
|
||||||
宽屏三栏,中屏 detail 换行,窄屏按文档顺序变为纵向布局。
|
界面中激活 `Rows N ✎` 可以输入 1–100。
|
||||||
|
|||||||
@ -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
|
|
||||||
1069
etaf-playground.el
1069
etaf-playground.el
File diff suppressed because it is too large
Load Diff
10
examples/research-shelf.ecss
Normal file
10
examples/research-shelf.ecss
Normal 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)))
|
||||||
@ -1,17 +1,24 @@
|
|||||||
;;; research-shelf.el --- SQLite-backed research library -*- lexical-binding: t; -*-
|
;;; research-shelf.el --- Research Shelf application -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
;;; Commentary:
|
;;; 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:
|
;;; Code:
|
||||||
|
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(require 'subr-x)
|
|
||||||
(require 'etaf)
|
(require 'etaf)
|
||||||
(require 'etaf-ui)
|
(require 'etaf-ui)
|
||||||
(require 'etaf-sqlite)
|
(require 'etaf-sqlite)
|
||||||
|
(require 'etaf-theme-tp)
|
||||||
(require 'etaf-playground)
|
(require 'etaf-playground)
|
||||||
(require 'face-remap)
|
|
||||||
|
;;; ---------------------------------------------------------------------------
|
||||||
|
;;; DATA / SQLITE SOURCE
|
||||||
|
;;; ---------------------------------------------------------------------------
|
||||||
|
|
||||||
(defcustom etaf-research-shelf-database-file
|
(defcustom etaf-research-shelf-database-file
|
||||||
(expand-file-name "research-shelf.sqlite" user-emacs-directory)
|
(expand-file-name "research-shelf.sqlite" user-emacs-directory)
|
||||||
@ -20,12 +27,7 @@
|
|||||||
:group 'etaf)
|
:group 'etaf)
|
||||||
|
|
||||||
(defcustom etaf-research-shelf-fixture-size 256
|
(defcustom etaf-research-shelf-fixture-size 256
|
||||||
"Minimum deterministic records installed in the Playground database.
|
"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."
|
|
||||||
:type 'natnum
|
:type 'natnum
|
||||||
:group 'etaf)
|
:group 'etaf)
|
||||||
|
|
||||||
@ -34,14 +36,6 @@ smaller value."
|
|||||||
:type 'positive-integer
|
:type 'positive-integer
|
||||||
:group 'etaf)
|
: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
|
(defconst etaf-research-shelf-seed-records
|
||||||
'((:id 1 :title "The Shape of Tools" :author "M. Abramson"
|
'((:id 1 :title "The Shape of Tools" :author "M. Abramson"
|
||||||
:kind "Essay" :status "reading" :progress 64 :priority "High"
|
:kind "Essay" :status "reading" :progress 64 :priority "High"
|
||||||
@ -84,7 +78,7 @@ smaller value."
|
|||||||
"Stable author vocabulary for generated fixture records.")
|
"Stable author vocabulary for generated fixture records.")
|
||||||
|
|
||||||
(defun etaf-research-shelf--generated-record (id index)
|
(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")))
|
(let* ((status (nth (mod index 4) '("reading" "unread" "finished" "reading")))
|
||||||
(progress (pcase status
|
(progress (pcase status
|
||||||
("finished" 100)
|
("finished" 100)
|
||||||
@ -106,7 +100,7 @@ smaller value."
|
|||||||
:updated (format "D-%03d" (1+ index)))))
|
:updated (format "D-%03d" (1+ index)))))
|
||||||
|
|
||||||
(defun etaf-research-shelf--fixture-records ()
|
(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))
|
(let* ((target (max 0 etaf-research-shelf-fixture-size))
|
||||||
(base (copy-tree etaf-research-shelf-seed-records))
|
(base (copy-tree etaf-research-shelf-seed-records))
|
||||||
(base-count (length base)))
|
(base-count (length base)))
|
||||||
@ -117,17 +111,8 @@ smaller value."
|
|||||||
for index from 0
|
for index from 0
|
||||||
collect (etaf-research-shelf--generated-record id index))))))
|
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 ()
|
(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-sqlite-database
|
||||||
etaf-research-shelf-database-file
|
etaf-research-shelf-database-file
|
||||||
(etaf-sqlite-table
|
(etaf-sqlite-table
|
||||||
@ -173,40 +158,117 @@ user's prior local additions cannot collide with the generated dataset."
|
|||||||
(setq next-id (1+ next-id))))))
|
(setq next-id (1+ next-id))))))
|
||||||
database))
|
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 ()
|
(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))
|
(let* ((database (etaf-research-shelf--ensure-database))
|
||||||
(controller
|
(controller
|
||||||
(etaf-data-controller
|
(etaf-data-controller
|
||||||
(etaf-sqlite-source database)
|
(etaf-sqlite-source database)
|
||||||
:page-size etaf-research-shelf-page-size
|
: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))
|
(filter (etaf-ref 'all :name 'research-shelf-filter))
|
||||||
(dark (etaf-ref nil :name 'research-shelf-dark-theme))
|
(dark (etaf-ref nil :name 'research-shelf-dark-theme))
|
||||||
(toast (etaf-ref "Ready to read." :name 'research-shelf-toast))
|
(toast (etaf-ref "Ready to read." :name 'research-shelf-toast)))
|
||||||
(next-id (etaf-ref
|
(list :database database
|
||||||
(let* ((load (plist-get (etaf-sqlite-source database) :load))
|
:database-file etaf-research-shelf-database-file
|
||||||
(items (plist-get
|
:controller controller :filter filter :dark dark :toast toast)))
|
||||||
(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)))
|
|
||||||
|
|
||||||
(defun etaf-research-shelf--controller (model)
|
(defun etaf-research-shelf--controller (model)
|
||||||
"Return MODEL's Data Controller."
|
"Return MODEL's Data Controller."
|
||||||
(plist-get model :controller))
|
(plist-get model :controller))
|
||||||
|
|
||||||
(defun etaf-research-shelf--query (filter)
|
(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
|
(pcase filter
|
||||||
('reading '(:status "reading"))
|
('reading '(:status "reading"))
|
||||||
('unread '(:status "unread"))
|
('unread '(:status "unread"))
|
||||||
@ -232,39 +294,32 @@ user's prior local additions cannot collide with the generated dataset."
|
|||||||
(setf (etaf-value (plist-get model :filter)) filter)
|
(setf (etaf-value (plist-get model :filter)) filter)
|
||||||
(etaf-data-set-query controller (etaf-research-shelf--query filter))
|
(etaf-data-set-query controller (etaf-research-shelf--query filter))
|
||||||
(etaf-data-set-page controller 1)
|
(etaf-data-set-page controller 1)
|
||||||
(etaf-research-shelf--load model
|
(etaf-research-shelf--load
|
||||||
(format "Showing %s"
|
model (format "Showing %s" (capitalize (symbol-name filter))))))
|
||||||
(capitalize (symbol-name filter))))))
|
|
||||||
|
|
||||||
(defun etaf-research-shelf--change-page-size (model)
|
(defun etaf-research-shelf--set-page-size (model page-size)
|
||||||
"Prompt for MODEL's page size, validate it, and reload from page one."
|
"Apply PAGE-SIZE to MODEL and reload from page one."
|
||||||
(let* ((controller (etaf-research-shelf--controller model))
|
(unless (and (integerp page-size) (<= 1 page-size 100))
|
||||||
(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"))
|
(user-error "Rows per page must be an integer from 1 to 100"))
|
||||||
(etaf-data-set-page-size controller next)
|
(let ((controller (etaf-research-shelf--controller model)))
|
||||||
|
(etaf-data-set-page-size controller page-size)
|
||||||
(etaf-data-set-page controller 1)
|
(etaf-data-set-page controller 1)
|
||||||
(etaf-research-shelf--load
|
(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)
|
(defun etaf-research-shelf--items (model)
|
||||||
"Return loaded items for MODEL."
|
"Return loaded items for MODEL."
|
||||||
(etaf-value (etaf-data-items (etaf-research-shelf--controller model))))
|
(etaf-value (etaf-data-items (etaf-research-shelf--controller model))))
|
||||||
|
|
||||||
(defun etaf-research-shelf--selected (model)
|
(defun etaf-research-shelf--selected (model)
|
||||||
"Return the selected item in MODEL, or nil."
|
"Return MODEL's selected item through the Data Controller identity contract."
|
||||||
(let* ((controller (etaf-research-shelf--controller model))
|
(etaf-data-selected-item (etaf-research-shelf--controller model)))
|
||||||
(id (car (etaf-value (etaf-data-selection controller)))))
|
|
||||||
(cl-find id (etaf-research-shelf--items model)
|
|
||||||
:key (lambda (row) (plist-get row :id)) :test #'equal)))
|
|
||||||
|
|
||||||
(defun etaf-research-shelf--mutate (model operation payload message)
|
(defun etaf-research-shelf--mutate (model operation payload message)
|
||||||
"Apply SQLite OPERATION PAYLOAD for MODEL.
|
"Apply OPERATION PAYLOAD for MODEL and show MESSAGE on success."
|
||||||
Show MESSAGE on success, or preserve the resulting error state."
|
|
||||||
(let ((controller (etaf-research-shelf--controller model)))
|
(let ((controller (etaf-research-shelf--controller model)))
|
||||||
(condition-case err
|
(condition-case err
|
||||||
(progn
|
(prog1
|
||||||
(etaf-data-mutate controller operation payload)
|
(etaf-data-mutate controller operation payload)
|
||||||
(setf (etaf-value (plist-get model :toast)) message))
|
(setf (etaf-value (plist-get model :toast)) message))
|
||||||
(error
|
(error
|
||||||
@ -279,32 +334,90 @@ Show MESSAGE on success, or preserve the resulting error state."
|
|||||||
(append (list :id (plist-get row :id)) fields)
|
(append (list :id (plist-get row :id)) fields)
|
||||||
message)))
|
message)))
|
||||||
|
|
||||||
(defun etaf-research-shelf--theme (model)
|
;; Named Actions keep product mutations out of View callbacks. The View layer
|
||||||
"Return MODEL's current palette."
|
;; only dispatches these stable application commands with the current model.
|
||||||
(if (etaf-value (plist-get model :dark))
|
(etaf-action-define etaf-research-shelf-filter (runtime model filter)
|
||||||
'(:ink "#F4F7FF" :paper "#111827" :panel "#182235" :line "#34435A"
|
"Apply FILTER to MODEL."
|
||||||
:muted "#AAB5C8" :accent "#8EA7FF" :mint "#76D6C3" :coral "#FF9A8E"
|
(ignore runtime)
|
||||||
:amber "#F0C36A" :soft "#202C42")
|
(etaf-research-shelf--set-filter model filter))
|
||||||
'(:ink "#172033" :paper "#F7F3EA" :panel "#FFFDF8" :line "#D9D4C9"
|
|
||||||
:muted "#6D7482" :accent "#3657D6" :mint "#3E9B8F" :coral "#D86B5D"
|
|
||||||
:amber "#C58A3A" :soft "#F1EEE7")))
|
|
||||||
|
|
||||||
(defun etaf-research-shelf--color (model key)
|
(etaf-action-define etaf-research-shelf-reload (runtime model)
|
||||||
"Return palette KEY for MODEL."
|
"Reload MODEL's data source."
|
||||||
(plist-get (etaf-research-shelf--theme model) key))
|
(ignore runtime)
|
||||||
|
(etaf-research-shelf--load model "✓ Library reloaded"))
|
||||||
|
|
||||||
(defun etaf-research-shelf--apply-buffer-palette (palette)
|
(etaf-action-define etaf-research-shelf-page-size (runtime model page-size)
|
||||||
"Paint the GUI buffer's unused viewport columns with PALETTE.
|
"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
|
(etaf-action-define etaf-research-shelf-add (runtime model)
|
||||||
layout never becomes a continuation line. Those columns contain no text
|
"Insert a new reading into MODEL."
|
||||||
properties, so the buffer's default face must carry the same product surface
|
(ignore runtime)
|
||||||
color or the frame edge exposes Emacs's unrelated default background."
|
(etaf-research-shelf--mutate
|
||||||
(when (and (display-graphic-p) (fboundp 'face-remap-set-base))
|
model 'insert
|
||||||
(face-remap-set-base
|
'(:title "New reading" :author "You" :kind "Notes"
|
||||||
'default
|
:status "unread" :progress 0 :priority "Medium"
|
||||||
(list :foreground (plist-get palette :ink)
|
:starred 0 :note "A new note waiting for your attention."
|
||||||
:background (plist-get palette :paper)))))
|
: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)
|
(defun etaf-research-shelf--status-label (status)
|
||||||
"Return a readable status label for 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")
|
("archived" "↗ Archived")
|
||||||
(_ "○ Unread")))
|
(_ "○ Unread")))
|
||||||
|
|
||||||
(defun etaf-research-shelf--filter-label (model form key fallback)
|
(defun etaf-research-shelf--filter-label (form key fallback)
|
||||||
"Return MODEL's active-aware label for KEY from static FILTER FORM."
|
"Return the static FILTER label from FORM for KEY, or FALLBACK."
|
||||||
(let* ((entry (cl-find-if
|
(let ((entry (etaf-research-shelf--static-child form 'filter)))
|
||||||
(lambda (item) (and (consp item) (eq (car item) '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)))
|
(eq (plist-get (cdr item) :key) key)))
|
||||||
(cdr form)))
|
(cdr form))))
|
||||||
(label (or (and entry (plist-get (cdr entry) :label)) fallback)))
|
(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--button-style (palette variant disabled)
|
(etaf-define-component etaf-research-shelf-filter-button
|
||||||
"Return style props for PALETTE, VARIANT, and DISABLED button state.
|
(&key filter-key fallback ref)
|
||||||
|
"Render one filter Button from inherited model and static filter Context."
|
||||||
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."
|
|
||||||
:setup
|
:setup
|
||||||
|
(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 ()
|
(lambda ()
|
||||||
(let* ((theme (etaf-current-prop :theme))
|
(let ((active (eq filter-key (etaf-value (plist-get model :filter)))))
|
||||||
(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
|
(etaf-view
|
||||||
(button :label label :ref ref :variant variant :disabled disabled
|
(button :label
|
||||||
:on-press on-press
|
(let ((label (etaf-research-shelf--filter-label
|
||||||
:color (plist-get style :color)
|
form filter-key fallback)))
|
||||||
:bgcolor (plist-get style :bgcolor)
|
(if active (concat "● " label) label))
|
||||||
:border (plist-get style :border)
|
:ref ref :variant (if active 'secondary 'ghost)
|
||||||
:face (plist-get style :face))))))
|
:on-press (lambda ()
|
||||||
|
(etaf-dispatch 'etaf-research-shelf-filter
|
||||||
|
model filter-key))))))))
|
||||||
|
|
||||||
(defun etaf-research-shelf--filter-view (model form)
|
(defun etaf-research-shelf--filter-view (model)
|
||||||
"Return the filter rail from MODEL and static FILTER FORM."
|
"Return the filter rail for MODEL and inherited filter Context."
|
||||||
|
(let ((theme (etaf-theme-defaults)))
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(column :class "research-shelf-filter-rail" :width 'stretch :min-width 0
|
(column :class "research-shelf-filter-rail" :width 'stretch :min-width 0
|
||||||
:flex-grow 1 :flex-shrink 1 :flex-basis '(220)
|
:flex-grow 1 :flex-shrink 1 :flex-basis '(220)
|
||||||
:padding '(1 1)
|
:padding '(1 1)
|
||||||
:border (etaf-research-shelf--color model :line)
|
:border (plist-get theme :line)
|
||||||
:color (etaf-research-shelf--color model :ink)
|
:color (plist-get theme :ink)
|
||||||
:bgcolor (etaf-research-shelf--color model :panel)
|
:bgcolor (plist-get theme :panel)
|
||||||
(label :text "Library" :face 'bold
|
(label :text "Library" :face 'bold)
|
||||||
:color (etaf-research-shelf--color model :ink)
|
(label :text "VIEWS" :color (plist-get theme :muted))
|
||||||
:bgcolor (etaf-research-shelf--color model :panel))
|
(etaf-research-shelf-filter-button
|
||||||
(label :text "VIEWS" :color (etaf-research-shelf--color model :muted)
|
:filter-key 'all :fallback "All" :ref 'research-shelf-filter-all)
|
||||||
:bgcolor (etaf-research-shelf--color model :panel))
|
(etaf-research-shelf-filter-button
|
||||||
(etaf-research-shelf-button
|
:filter-key 'reading :fallback "In progress"
|
||||||
:theme (etaf-research-shelf--theme model)
|
:ref 'research-shelf-filter-reading)
|
||||||
:label (etaf-research-shelf--filter-label model form 'all "All")
|
(etaf-research-shelf-filter-button
|
||||||
:ref 'research-shelf-filter-all
|
:filter-key 'unread :fallback "Unread" :ref 'research-shelf-filter-unread)
|
||||||
:variant (if (eq (etaf-value (plist-get model :filter)) 'all)
|
(etaf-research-shelf-filter-button
|
||||||
'secondary 'ghost)
|
:filter-key 'finished :fallback "Finished"
|
||||||
:on-press (lambda () (etaf-research-shelf--set-filter model 'all)))
|
:ref 'research-shelf-filter-finished)
|
||||||
(etaf-research-shelf-button
|
(etaf-research-shelf-filter-button
|
||||||
:theme (etaf-research-shelf--theme model)
|
:filter-key 'starred :fallback "★ Starred"
|
||||||
:label (etaf-research-shelf--filter-label
|
:ref 'research-shelf-filter-starred)
|
||||||
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)))
|
|
||||||
(spacer :height 1)
|
(spacer :height 1)
|
||||||
(label :text "STORAGE" :color (etaf-research-shelf--color model :muted)
|
(label :text "STORAGE" :color (plist-get theme :muted))
|
||||||
:bgcolor (etaf-research-shelf--color model :panel))
|
|
||||||
(label :text (file-name-nondirectory
|
(label :text (file-name-nondirectory
|
||||||
(plist-get model :database-file))
|
(plist-get model :database-file)))
|
||||||
:color (etaf-research-shelf--color model :ink)
|
(button :label "↻ Reload library" :ref 'research-shelf-reload
|
||||||
: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
|
:variant 'ghost
|
||||||
:on-press (lambda () (etaf-research-shelf--load model "✓ Library reloaded"))))))
|
:on-press (lambda ()
|
||||||
|
(etaf-dispatch 'etaf-research-shelf-reload
|
||||||
|
model)))))))
|
||||||
|
|
||||||
(defun etaf-research-shelf--reading-list-view (model form)
|
(defun etaf-research-shelf--reading-list-view (model form)
|
||||||
"Return the main reading list for MODEL and static MAIN FORM."
|
"Return the reading list for MODEL and static MAIN FORM."
|
||||||
(let ((controller (etaf-research-shelf--controller model)))
|
(let ((controller (etaf-research-shelf--controller model))
|
||||||
|
(theme (etaf-theme-defaults)))
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(column :class "research-shelf-list" :width 'stretch :min-width 0
|
(column :class "research-shelf-list" :width 'stretch :min-width 0
|
||||||
:flex-grow 4 :flex-shrink 1 :flex-basis '(620)
|
:flex-grow 4 :flex-shrink 1 :flex-basis '(620)
|
||||||
:padding '(1 2)
|
:padding '(1 2)
|
||||||
:border (etaf-research-shelf--color model :line)
|
:border (plist-get theme :line)
|
||||||
:color (etaf-research-shelf--color model :ink)
|
:bgcolor (plist-get theme :panel)
|
||||||
:bgcolor (etaf-research-shelf--color model :panel)
|
|
||||||
(flex :width 'stretch :flex-wrap 'wrap :align-items 'center :gap '(1 (8))
|
(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
|
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
|
||||||
(label :text (etaf-research-shelf--static-value form :title
|
(label :text (etaf-research-shelf--static-value
|
||||||
"Reading queue")
|
form :title "Reading queue") :face 'bold)
|
||||||
:face 'bold
|
|
||||||
:color (etaf-research-shelf--color model :ink)
|
|
||||||
:bgcolor (etaf-research-shelf--color model :panel))
|
|
||||||
(label :text (format "%d items · SQLite-backed"
|
(label :text (format "%d items · SQLite-backed"
|
||||||
(or (etaf-value (etaf-data-total controller)) 0))
|
(or (etaf-value (etaf-data-total controller)) 0))
|
||||||
:color (etaf-research-shelf--color model :muted)
|
:color (plist-get theme :muted)))
|
||||||
:bgcolor (etaf-research-shelf--color model :panel)))
|
(number-input :label "Rows"
|
||||||
(etaf-research-shelf-button
|
:value (etaf-value (etaf-data-page-size controller))
|
||||||
:theme (etaf-research-shelf--theme model)
|
:ref 'research-shelf-page-size :min 1 :max 100
|
||||||
:label (format "Rows %d ✎"
|
:on-change
|
||||||
(etaf-value (etaf-data-page-size controller)))
|
(lambda (next)
|
||||||
:ref 'research-shelf-page-size
|
(etaf-dispatch 'etaf-research-shelf-page-size
|
||||||
:variant 'ghost
|
model next)))
|
||||||
:on-press (lambda ()
|
(button :label "+ Add reading" :ref 'research-shelf-add
|
||||||
(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
|
:variant 'secondary
|
||||||
:on-press
|
:on-press (lambda ()
|
||||||
(lambda ()
|
(etaf-dispatch 'etaf-research-shelf-add model))))
|
||||||
(let ((id (etaf-value (plist-get model :next-id))))
|
|
||||||
(etaf-research-shelf--mutate
|
|
||||||
model 'insert
|
|
||||||
(list :id id :title (format "New reading %d" id)
|
|
||||||
:author "You" :kind "Notes" :status "unread"
|
|
||||||
:progress 0 :priority "Medium" :starred 0
|
|
||||||
:note "A new note waiting for your attention."
|
|
||||||
:updated "Just now")
|
|
||||||
"✓ Added to your shelf")
|
|
||||||
(setf (etaf-value (plist-get model :next-id)) (1+ id))))))
|
|
||||||
(data-grid
|
(data-grid
|
||||||
:controller controller
|
:controller controller
|
||||||
:columns etaf-research-shelf--grid-columns
|
: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)
|
:row-ref (lambda (row)
|
||||||
(intern (format "research-shelf-row-%s"
|
(intern (format "research-shelf-row-%s"
|
||||||
(plist-get row :id))))
|
(etaf-research-shelf--item-id row))))
|
||||||
:row-selected-p
|
:row-selected-p
|
||||||
(lambda (row)
|
(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
|
:on-row-press
|
||||||
(lambda (row)
|
(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…"
|
:loading-label "◷ Loading library…"
|
||||||
:error-label "⚠ Could not read the shelf. Use Reload.")
|
:error-label "⚠ Could not read the shelf. Use Reload.")
|
||||||
(etaf-pagination :controller controller
|
(etaf-pagination :controller controller
|
||||||
:previous-ref 'research-shelf-page-previous
|
:previous-ref 'research-shelf-page-previous
|
||||||
:next-ref 'research-shelf-page-next
|
:next-ref 'research-shelf-page-next
|
||||||
:color (etaf-research-shelf--color model :ink)
|
:color (plist-get theme :ink))))))
|
||||||
:bgcolor (etaf-research-shelf--color model :panel))))))
|
|
||||||
|
|
||||||
(defun etaf-research-shelf--detail-view (model form)
|
(defun etaf-research-shelf--detail-view (model form)
|
||||||
"Return the selected record inspector for MODEL and static FORM."
|
"Return the selected record inspector for MODEL and static FORM."
|
||||||
|
(let ((theme (etaf-theme-defaults)))
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(column :class "research-shelf-detail" :width 'stretch :min-width 0
|
(column :class "research-shelf-detail" :width 'stretch :min-width 0
|
||||||
:flex-grow 2 :flex-shrink 1 :flex-basis '(340)
|
:flex-grow 2 :flex-shrink 1 :flex-basis '(340)
|
||||||
:padding '(2 2)
|
:padding '(2 2)
|
||||||
:border (etaf-research-shelf--color model :line)
|
:border (plist-get theme :line)
|
||||||
:color (etaf-research-shelf--color model :ink)
|
:bgcolor (plist-get theme :panel)
|
||||||
:bgcolor (etaf-research-shelf--color model :panel)
|
|
||||||
(label :text (etaf-research-shelf--static-value form :title
|
(label :text (etaf-research-shelf--static-value form :title
|
||||||
"Selected item")
|
"Selected item")
|
||||||
:color (etaf-research-shelf--color model :accent)
|
:color (plist-get theme :accent))
|
||||||
:bgcolor (etaf-research-shelf--color model :panel))
|
|
||||||
(text :face 'bold
|
(text :face 'bold
|
||||||
(expr :value
|
(expr :value
|
||||||
(if-let ((row (etaf-research-shelf--selected model)))
|
(if-let ((row (etaf-research-shelf--selected model)))
|
||||||
(plist-get row :title)
|
(plist-get row :title)
|
||||||
"Choose a record")))
|
"Choose a record")))
|
||||||
(text :color (etaf-research-shelf--color model :muted)
|
(text :color (plist-get theme :muted)
|
||||||
(expr :value
|
(expr :value
|
||||||
(if-let ((row (etaf-research-shelf--selected model)))
|
(if-let ((row (etaf-research-shelf--selected model)))
|
||||||
(format "%s · %s" (plist-get row :author)
|
(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)
|
(or (plist-get row :progress) 0)
|
||||||
(plist-get row :priority))
|
(plist-get row :priority))
|
||||||
"Progress — · Priority —")))
|
"Progress — · Priority —")))
|
||||||
(text :color (etaf-research-shelf--color model :accent)
|
(text :color (plist-get theme :accent)
|
||||||
(expr :value
|
(expr :value
|
||||||
(let* ((row (etaf-research-shelf--selected model))
|
(let* ((row (etaf-research-shelf--selected model))
|
||||||
(progress (or (and row (plist-get row :progress)) 0))
|
(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 ?█)
|
(format "%s %s" (make-string filled ?█)
|
||||||
(make-string (- 10 filled) ?░)))))
|
(make-string (- 10 filled) ?░)))))
|
||||||
(spacer :height 1)
|
(spacer :height 1)
|
||||||
(text :color (etaf-research-shelf--color model :muted)
|
(text :color (plist-get theme :muted)
|
||||||
(expr :value
|
(expr :value
|
||||||
(if-let ((row (etaf-research-shelf--selected model)))
|
(if-let ((row (etaf-research-shelf--selected model)))
|
||||||
(concat "“" (or (plist-get row :note) "No note yet.") "”")
|
(concat "“" (or (plist-get row :note) "No note yet.") "”")
|
||||||
"Your notes and actions will appear here.")))
|
"Your notes and actions will appear here.")))
|
||||||
(spacer :height 1)
|
(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)
|
(etaf-define-component etaf-research-shelf-detail-actions ()
|
||||||
"Render stable selected-record actions for MODEL."
|
"Render selected-record actions from the inherited Research Shelf model."
|
||||||
:setup
|
:setup
|
||||||
(let ((model (etaf-current-prop :model)))
|
(let ((model (etaf-inject 'research-shelf-model nil t)))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let* ((theme (etaf-research-shelf--theme model))
|
(let* ((row (etaf-research-shelf--selected model))
|
||||||
(row (etaf-research-shelf--selected model))
|
|
||||||
(progress (or (and row (plist-get row :progress)) 0))
|
(progress (or (and row (plist-get row :progress)) 0))
|
||||||
(finished (and row (equal (plist-get row :status) "finished")))
|
(finished (and row (equal (plist-get row :status) "finished")))
|
||||||
(archived (and row (equal (plist-get row :status) "archived"))))
|
(archived (and row (equal (plist-get row :status) "archived"))))
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(flex :width 'stretch :flex-wrap 'wrap :gap '(1 (6))
|
(flex :width 'stretch :flex-wrap 'wrap :gap '(1 (6))
|
||||||
(etaf-research-shelf-button
|
(button :label "+ 10%" :ref 'research-shelf-progress
|
||||||
:theme theme :label "+ 10%" :ref 'research-shelf-progress
|
|
||||||
:variant 'secondary
|
:variant 'secondary
|
||||||
:disabled (or (null row) archived (>= progress 100))
|
:disabled (or (null row) archived (>= progress 100))
|
||||||
:on-press
|
:on-press (lambda ()
|
||||||
(lambda ()
|
(etaf-dispatch 'etaf-research-shelf-progress
|
||||||
(when-let* ((current (etaf-research-shelf--selected model))
|
model)))
|
||||||
(value (or (plist-get current :progress) 0)))
|
(button :label "✓ Finish" :ref 'research-shelf-finish
|
||||||
(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)
|
:variant 'secondary :disabled (or (null row) finished archived)
|
||||||
:on-press
|
:on-press (lambda ()
|
||||||
(lambda ()
|
(etaf-dispatch 'etaf-research-shelf-finish
|
||||||
(etaf-research-shelf--update-selected
|
model)))
|
||||||
model '(:progress 100 :status "finished" :updated "Just now")
|
(button :label "★ Star" :ref 'research-shelf-star
|
||||||
"✓ Marked finished")))
|
|
||||||
(etaf-research-shelf-button
|
|
||||||
:theme theme :label "★ Star" :ref 'research-shelf-star
|
|
||||||
:variant 'ghost :disabled (null row)
|
:variant 'ghost :disabled (null row)
|
||||||
:on-press
|
:on-press (lambda ()
|
||||||
(lambda ()
|
(etaf-dispatch 'etaf-research-shelf-star model)))
|
||||||
(when-let ((current (etaf-research-shelf--selected model)))
|
(button :label "Archive" :ref 'research-shelf-archive
|
||||||
(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)
|
:variant 'ghost :disabled (or (null row) archived)
|
||||||
:on-press
|
:on-press (lambda ()
|
||||||
|
(etaf-dispatch 'etaf-research-shelf-archive
|
||||||
|
model)))))))))
|
||||||
|
|
||||||
|
(etaf-define-component etaf-research-shelf-filter-rail ()
|
||||||
|
"Render the Research Shelf filter rail from inherited Context."
|
||||||
|
:setup
|
||||||
|
(let ((model (etaf-inject 'research-shelf-model nil t)))
|
||||||
|
(lambda () (etaf-research-shelf--filter-view model))))
|
||||||
|
|
||||||
|
(etaf-define-component etaf-research-shelf-reading-list ()
|
||||||
|
"Render the Research Shelf reading list from inherited Context."
|
||||||
|
:setup
|
||||||
|
(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 ()
|
||||||
|
"Render the Research Shelf detail inspector from inherited Context."
|
||||||
|
:setup
|
||||||
|
(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 static-form)
|
||||||
|
"Compose the Research Shelf app and provide its model/theme Context."
|
||||||
|
:setup
|
||||||
|
(let* ((static-form (etaf-current-prop :static-form))
|
||||||
|
(model (etaf-research-shelf--create-model))
|
||||||
|
(theme (etaf-computed
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(etaf-research-shelf--update-selected
|
(etaf-research-shelf--theme-defaults model))
|
||||||
model '(:status "archived" :updated "Just now")
|
:name 'research-shelf-theme))
|
||||||
"↗ Archived")))))))))
|
(header (etaf-research-shelf--static-child static-form 'header))
|
||||||
|
|
||||||
(etaf-define-component etaf-research-shelf-filter-rail
|
|
||||||
(&key model static-form)
|
|
||||||
"Render the reusable Research Shelf filter rail.
|
|
||||||
|
|
||||||
The rail is a Component boundary so its button Components remain ordinary
|
|
||||||
structural children instead of leaking through a direct material `expr'."
|
|
||||||
:setup
|
|
||||||
(let ((model (etaf-current-prop :model))
|
|
||||||
(static-form (etaf-current-prop :static-form)))
|
|
||||||
(lambda () (etaf-research-shelf--filter-view model static-form))))
|
|
||||||
|
|
||||||
(etaf-define-component etaf-research-shelf-reading-list
|
|
||||||
(&key model static-form)
|
|
||||||
"Render the reusable Research Shelf reading list."
|
|
||||||
:setup
|
|
||||||
(let ((model (etaf-current-prop :model))
|
|
||||||
(static-form (etaf-current-prop :static-form)))
|
|
||||||
(lambda () (etaf-research-shelf--reading-list-view model static-form))))
|
|
||||||
|
|
||||||
(etaf-define-component etaf-research-shelf-detail-inspector
|
|
||||||
(&key model static-form)
|
|
||||||
"Render the reusable Research Shelf detail inspector."
|
|
||||||
:setup
|
|
||||||
(let ((model (etaf-current-prop :model))
|
|
||||||
(static-form (etaf-current-prop :static-form)))
|
|
||||||
(lambda () (etaf-research-shelf--detail-view model static-form))))
|
|
||||||
|
|
||||||
(etaf-define-component etaf-research-shelf-shell (&key model static-form)
|
|
||||||
"Compose the SQLite-backed Research Shelf application."
|
|
||||||
:styles
|
|
||||||
(styles
|
|
||||||
(".research-shelf-shell" :width stretch)
|
|
||||||
(".research-shelf-header" :width stretch :padding (1 0))
|
|
||||||
(".research-shelf-filter-rail" :width stretch)
|
|
||||||
(".research-shelf-list" :width stretch)
|
|
||||||
(".research-shelf-detail" :width stretch)
|
|
||||||
(".research-shelf-footer" :width stretch :padding (0 1)))
|
|
||||||
:setup
|
|
||||||
(let ((model (etaf-current-prop :model))
|
|
||||||
(static-form (etaf-current-prop :static-form)))
|
|
||||||
(etaf-on-unmounted
|
|
||||||
(lambda ()
|
|
||||||
(etaf-data-stop (etaf-research-shelf--controller model))
|
|
||||||
(when (and (display-graphic-p)
|
|
||||||
(fboundp 'face-remap-set-base))
|
|
||||||
(face-remap-set-base 'default 'default))))
|
|
||||||
(lambda ()
|
|
||||||
(let* ((header (etaf-research-shelf--static-child static-form 'header))
|
|
||||||
(filters (etaf-research-shelf--static-child static-form 'filters))
|
(filters (etaf-research-shelf--static-child static-form 'filters))
|
||||||
(main (etaf-research-shelf--static-child static-form 'main))
|
(main (etaf-research-shelf--static-child static-form 'main))
|
||||||
(library (etaf-research-shelf--static-child main 'library))
|
(library (etaf-research-shelf--static-child main 'library))
|
||||||
(detail (etaf-research-shelf--static-child main 'detail))
|
(detail (etaf-research-shelf--static-child main 'detail)))
|
||||||
(dark (etaf-value (plist-get model :dark)))
|
(etaf-on-mounted
|
||||||
(palette (etaf-research-shelf--theme model)))
|
(lambda ()
|
||||||
(etaf-research-shelf--apply-buffer-palette palette)
|
(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 ((dark (etaf-value (plist-get model :dark))))
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(column :class "research-shelf-shell" :width '(viewport)
|
(column :class "research-shelf-shell" :width '(viewport)
|
||||||
:height '(viewport-height)
|
:height '(viewport-height)
|
||||||
:color (plist-get palette :ink)
|
:color (etaf-research-shelf--theme-value :ink)
|
||||||
:bgcolor (plist-get palette :paper)
|
:bgcolor (etaf-research-shelf--theme-value :paper)
|
||||||
(flex :class "research-shelf-header" :width 'stretch
|
(flex :class "research-shelf-header" :width 'stretch :min-width 0
|
||||||
:flex-wrap 'wrap
|
:flex-wrap 'wrap :align-items 'center :gap '(1 (10))
|
||||||
:align-items 'center :gap '(1 (10))
|
|
||||||
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
|
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
|
||||||
(label :text (etaf-research-shelf--static-value
|
(label :text (etaf-research-shelf--static-value
|
||||||
header :eyebrow "Research Shelf")
|
header :eyebrow "Research Shelf")
|
||||||
:color (plist-get palette :accent)
|
:color (etaf-research-shelf--theme-value :accent))
|
||||||
:bgcolor (plist-get palette :paper))
|
|
||||||
(label :text (etaf-research-shelf--static-value
|
(label :text (etaf-research-shelf--static-value
|
||||||
static-form :title "Research Shelf") :face 'bold
|
static-form :title "Research Shelf") :face 'bold)
|
||||||
:color (plist-get palette :ink)
|
|
||||||
:bgcolor (plist-get palette :paper))
|
|
||||||
(label :text (etaf-research-shelf--static-value
|
(label :text (etaf-research-shelf--static-value
|
||||||
static-form :subtitle "A quiet place for unfinished ideas")
|
static-form :subtitle
|
||||||
:color (plist-get palette :muted)
|
"A quiet place for unfinished ideas")
|
||||||
:bgcolor (plist-get palette :paper)))
|
: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
|
(checkbox :label "Dark" :ref 'research-shelf-theme-toggle
|
||||||
:checked dark
|
:checked dark
|
||||||
:on-change (lambda (value)
|
:on-change (lambda (value)
|
||||||
(setf (etaf-value (plist-get model :dark)) 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))
|
(setf (etaf-value (plist-get model :toast))
|
||||||
(if value "Dark theme" "Light theme")))))
|
(if value "Dark theme" "Light theme"))))))
|
||||||
(flex :class "research-shelf-workspace" :width 'stretch
|
(flex :class "research-shelf-workspace" :width 'stretch
|
||||||
:flex-wrap 'wrap :align-items 'stretch :align-content 'start
|
:flex-wrap 'wrap :align-items 'stretch :align-content 'start
|
||||||
:gap '(1 (6)) :color (plist-get palette :ink)
|
:gap '(1 (6))
|
||||||
:bgcolor (plist-get palette :paper)
|
(etaf-research-shelf-filter-rail)
|
||||||
(etaf-research-shelf-filter-rail :model model :static-form filters)
|
(etaf-research-shelf-reading-list)
|
||||||
(etaf-research-shelf-reading-list :model model :static-form library)
|
(etaf-research-shelf-detail-inspector))
|
||||||
(etaf-research-shelf-detail-inspector :model model :static-form detail))
|
|
||||||
(flex :class "research-shelf-footer" :width 'stretch
|
(flex :class "research-shelf-footer" :width 'stretch
|
||||||
:flex-wrap 'wrap :gap '(1 (8))
|
:flex-wrap 'wrap :gap '(1 (8))
|
||||||
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
|
(column :flex-grow 1 :flex-shrink 1 :flex-basis '(0) :min-width 0
|
||||||
(label :text (or (etaf-value (plist-get model :toast)) "Ready")
|
(label :text (or (etaf-value (plist-get model :toast)) "Ready")))
|
||||||
:color (plist-get palette :ink)
|
|
||||||
:bgcolor (plist-get palette :paper)))
|
|
||||||
(label :text (file-name-nondirectory
|
(label :text (file-name-nondirectory
|
||||||
(plist-get model :database-file))
|
(plist-get model :database-file))
|
||||||
:color (plist-get palette :muted)
|
:color (etaf-research-shelf--theme-value :muted)))))))))
|
||||||
:bgcolor (plist-get palette :paper)))))))))
|
|
||||||
|
|
||||||
(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)
|
(unless (eq (car static-form) 'research-shelf-shell)
|
||||||
(error "Unsupported Research Shelf static root: %S" static-form))
|
(error "Unsupported Research Shelf static root: %S" static-form))
|
||||||
(let ((model (etaf-research-shelf--create-model)))
|
(etaf-component-set-styles 'etaf-research-shelf-shell ecss-form)
|
||||||
;; 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 ()
|
(lambda ()
|
||||||
(etaf-view
|
(etaf-view
|
||||||
(research-shelf-shell :model model :static-form static-form)))))
|
(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
|
;;;###autoload
|
||||||
(defun etaf-research-shelf-open (&optional buffer-name)
|
(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)
|
(interactive)
|
||||||
(let* ((name (or buffer-name "*ETAF Research Shelf*"))
|
(if buffer-name
|
||||||
;; Put the target in its real GUI window before the first Ebox
|
(etaf-playground-open-example "research-shelf" buffer-name)
|
||||||
;; projection so `(viewport)' resolves against the user's frame.
|
(etaf-playground-open-example "research-shelf")))
|
||||||
(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")))))
|
|
||||||
|
|
||||||
(provide 'etaf-research-shelf)
|
(provide 'etaf-research-shelf)
|
||||||
;;; research-shelf.el ends here
|
;;; research-shelf.el ends here
|
||||||
|
|||||||
@ -8,7 +8,7 @@
|
|||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(require 'etaf-playground)
|
(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-row-max-budget-ms 250.0)
|
||||||
(defconst etaf-research-shelf-benchmark-theme-p50-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)
|
(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 ()
|
(defun etaf-research-shelf-benchmark-run ()
|
||||||
"Run the Research Shelf evaluator and return non-nil on success."
|
"Run the Research Shelf evaluator and return non-nil on success."
|
||||||
(load-file (expand-file-name "examples/research-shelf.el"
|
(let* ((source (expand-file-name "examples/research-shelf.el"
|
||||||
default-directory))
|
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"))
|
(let ((database (make-temp-file "etaf-research-shelf-perf-" nil ".sqlite"))
|
||||||
(buffer " *etaf-research-shelf-perf*"))
|
(buffer " *etaf-research-shelf-perf*"))
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
|
|||||||
@ -23,6 +23,8 @@
|
|||||||
|
|
||||||
(defun etaf-playground-test--close (buffer)
|
(defun etaf-playground-test--close (buffer)
|
||||||
"Close BUFFER when it exists."
|
"Close BUFFER when it exists."
|
||||||
|
(when (gethash "research-shelf" etaf-playground--sessions)
|
||||||
|
(etaf-playground-close "research-shelf"))
|
||||||
(when (get-buffer buffer)
|
(when (get-buffer buffer)
|
||||||
(etaf-playground-close buffer)))
|
(etaf-playground-close buffer)))
|
||||||
|
|
||||||
@ -51,30 +53,36 @@ database and mounts a test buffer before running BODY."
|
|||||||
(when (file-exists-p ,database)
|
(when (file-exists-p ,database)
|
||||||
(delete-file ,database))))))
|
(delete-file ,database))))))
|
||||||
|
|
||||||
(ert-deftest etaf-playground-manifest-describes-one-pair ()
|
(ert-deftest etaf-playground-framework-discovers-generic-file-triplets ()
|
||||||
"Expose one reviewed pair through a generic manifest."
|
"Discover examples from files without a business catalog in the framework."
|
||||||
(should (equal '("research-shelf") etaf-playground-example-names))
|
(should (member "research-shelf" etaf-playground-example-names))
|
||||||
(should (= 1 (length etaf-playground-scenario-manifest)))
|
(let ((entry (etaf-playground-scenario "research-shelf"))
|
||||||
(let ((entry (car etaf-playground-scenario-manifest))
|
|
||||||
(framework (with-temp-buffer
|
(framework (with-temp-buffer
|
||||||
(insert-file-contents "etaf-playground.el")
|
(insert-file-contents "etaf-playground.el")
|
||||||
(buffer-string)))
|
(buffer-string)))
|
||||||
(catalog (with-temp-buffer
|
|
||||||
(insert-file-contents "etaf-playground-catalog.el")
|
|
||||||
(buffer-string)))
|
|
||||||
(makefile (with-temp-buffer
|
(makefile (with-temp-buffer
|
||||||
(insert-file-contents "Makefile")
|
(insert-file-contents "Makefile")
|
||||||
|
(buffer-string)))
|
||||||
|
(companion (with-temp-buffer
|
||||||
|
(insert-file-contents "examples/research-shelf.el")
|
||||||
(buffer-string))))
|
(buffer-string))))
|
||||||
(dolist (key '(:pair :root-component :companion-feature :static-tags
|
(dolist (key '(:pair :directory :etaf-file :el-file :ecss-file
|
||||||
:capabilities :refs :gui-checkpoints :performance))
|
:root-component :companion-feature))
|
||||||
(should (plist-member entry key)))
|
(should (plist-member entry key)))
|
||||||
(should (string-match-p
|
(should (file-readable-p (plist-get entry :etaf-file)))
|
||||||
"EXAMPLE_EL := examples/research-shelf.el" makefile))
|
(should (file-readable-p (plist-get entry :el-file)))
|
||||||
(should-not (string-match-p "wildcard examples" makefile))
|
(should (file-readable-p (plist-get entry :ecss-file)))
|
||||||
(should-not (string-match-p "require.*etaf-sqlite" framework))
|
(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 "research-shelf" framework))
|
||||||
(should-not (string-match-p "operations-console" 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 ()
|
(ert-deftest etaf-playground-displays-before-responsive-mount ()
|
||||||
"GUI entry points establish the containing window before Ebox 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)
|
(should-error (etaf-playground--validate-static-node unsafe tags)
|
||||||
:type 'error))))
|
: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 ()
|
(ert-deftest etaf-playground-pair-mounts-sqlite-backed-surface ()
|
||||||
"Mounting the pair initializes SQLite and renders the real app shell."
|
"Mounting the pair initializes SQLite and renders the real app shell."
|
||||||
(etaf-playground-test--with-app (buffer database)
|
(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 (string-match-p "Designing for Calm" text))
|
||||||
(should-not (string-match-p "Ways of Seeing" text)))
|
(should-not (string-match-p "Ways of Seeing" text)))
|
||||||
(etaf-dispatch-event runtime 'research-shelf-filter-all 'press)
|
(etaf-dispatch-event runtime 'research-shelf-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)
|
(etaf-dispatch-event runtime 'research-shelf-page-next 'press)
|
||||||
(should (string-match-p "Page 2 / 2"
|
(let ((page-two (etaf-playground-test--text buffer)))
|
||||||
(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)
|
(etaf-dispatch-event runtime 'research-shelf-page-previous 'press)
|
||||||
(should (string-match-p "Page 1 / 2"
|
(let ((page-one-again (etaf-playground-test--text buffer)))
|
||||||
(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)
|
(cl-letf (((symbol-function 'read-number)
|
||||||
(lambda (&rest _) 6)))
|
(lambda (&rest _) 6)))
|
||||||
(etaf-dispatch-event runtime 'research-shelf-page-size 'press))
|
(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"))))
|
(line-of "Selected item"))))
|
||||||
(pcase-let ((`(,filter-line ,list-line ,detail-line)
|
(pcase-let ((`(,filter-line ,list-line ,detail-line)
|
||||||
(layout-at 1600)))
|
(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)))
|
(should (<= (- detail-line list-line) 1)))
|
||||||
(pcase-let ((`(,filter-line ,list-line ,detail-line)
|
(pcase-let ((`(,filter-line ,list-line ,detail-line)
|
||||||
(layout-at 900)))
|
(layout-at 900)))
|
||||||
(should (= filter-line list-line))
|
(should (<= (abs (- filter-line list-line)) 1))
|
||||||
(should (> detail-line list-line)))
|
(should (> detail-line list-line)))
|
||||||
(pcase-let ((`(,filter-line ,list-line ,detail-line)
|
(pcase-let ((`(,filter-line ,list-line ,detail-line)
|
||||||
(layout-at 600)))
|
(layout-at 600)))
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user