feat: add complete composable task workbench
This commit is contained in:
Kinneyzhang
parent
9fc022c974
commit
2b5793acd6
85
DESIGN.md
85
DESIGN.md
@ -3,9 +3,13 @@
|
||||
## Source of truth
|
||||
|
||||
- Status: Active
|
||||
- Last refreshed: 2026-08-23
|
||||
- Last refreshed: 2026-09-05
|
||||
- Primary product surface: generic `etaf-playground.el` workspace plus the
|
||||
`examples/research-shelf.etaf` / `.el` / `.ecss` consumer triplet
|
||||
- Additional product surface: `examples/task-workbench.el`, a complete
|
||||
composable task app. Its initial layout, interactions, and visual states are
|
||||
checked in real GUI Emacs; current user direction is modern, spacious,
|
||||
consistently aligned controls and a 100-task dataset.
|
||||
- Visual reference: `design/research-shelf.html`
|
||||
- Evidence reviewed: ETAF public View/Component/Data/Resource APIs, `etaf-ui`
|
||||
Button/Checkbox/Panel/DataGrid/Pagination, and `etaf-sqlite`'s typed source
|
||||
@ -81,8 +85,8 @@
|
||||
|
||||
## Components
|
||||
|
||||
- Existing components to reuse: public `button`, `checkbox`, `label`, `panel`,
|
||||
`data-grid`, and `pagination` from `etaf-ui`.
|
||||
- Existing components to reuse: `etaf-button`, `etaf-checkbox`, `etaf-label`,
|
||||
`etaf-panel`, `etaf-data-grid`, and `etaf-pagination` from `etaf-ui`.
|
||||
- Companion composition: `research-shelf-shell`, `filter-rail`,
|
||||
`reading-list`, and `detail-inspector`; these are ordinary ETAF Components,
|
||||
not a second UI kit.
|
||||
@ -187,10 +191,11 @@ triplet.
|
||||
`etaf-research-shelf-page-size` defaults to 12; existing local rows are
|
||||
preserved and missing fixture rows are topped up with fresh IDs.
|
||||
- Performance: one Data mutation -> one Runtime generation/publication. The
|
||||
current active latency lane uses 5 unmeasured warmups and 30 measured samples
|
||||
at fixed 1413×62 geometry; every scenario must satisfy p95 and max at or below
|
||||
50ms. The accepted 105ms p50 wording is historical design context, not the
|
||||
current evaluator gate; `DOC-PERF-001` keeps its formal disposition in M0b1.
|
||||
retained Research Shelf batch evaluator uses 5 unmeasured warmups and 30
|
||||
measured samples at fixed 1413×62 geometry, with p95 and max at most 50ms.
|
||||
Current GUI acceptance has the additional requirements below. The accepted
|
||||
105ms p50 wording is historical design context, not the current evaluator
|
||||
gate; `DOC-PERF-001` keeps its formal disposition in M0b1.
|
||||
- Compatibility: any same-basename `.etaf`/`.el` example is discoverable;
|
||||
`.ecss` is optional, and the bundled Research Shelf remains only one
|
||||
consumer.
|
||||
@ -200,17 +205,71 @@ triplet.
|
||||
|
||||
## Performance evidence lanes
|
||||
|
||||
The latency lane, trace lane, and GUI lane share one
|
||||
The batch regression lane, trace lane, and GUI lane share one
|
||||
repository/environment/scenario/fixture/build identity but remain separate
|
||||
measurements. The latency lane owns the uninstrumented 5/30 p95/max 50ms gate.
|
||||
measurements. The retained Research Shelf 1413×62 batch evaluator owns its
|
||||
uninstrumented 5/30 p95/max 50ms regression checks.
|
||||
The trace lane owns a representative instrumented invocation with cost class,
|
||||
work counters, turns, allocation, and GC. The GUI lane owns the real Emacs
|
||||
action sequence, screenshots, recording, and temporal-review verdict. Batch
|
||||
verifier duration is not GUI first paint; action-start through forced redisplay
|
||||
completion remains an explicitly separate future first-paint gate and an M0a
|
||||
observed gap. No one lane may be used to claim another lane passed.
|
||||
action sequence and reviewed visual evidence. Current GUI acceptance additionally
|
||||
requires three independent foreground sample sets with each operation's p95 and
|
||||
max at most 50ms from action callback through forced redisplay. This gate remains
|
||||
outstanding. Preserve all warmups, GC observations and samples through the
|
||||
measurement entry in `../etaf/scripts/README.md`; returning from redisplay does
|
||||
not certify compositor presentation. No one lane may be used to claim another
|
||||
lane passed.
|
||||
|
||||
## Open questions
|
||||
|
||||
- [ ] User may rename the product after reviewing the first HTML/ETAF render;
|
||||
architecture and interaction contracts remain unchanged.
|
||||
|
||||
## Task Workbench visual contract
|
||||
|
||||
- Source: user review of the actual Workbench GUI on 2026-09-05, especially
|
||||
adjacent buttons, cramped rows and excessive detail-panel width. Reuse the
|
||||
existing restrained cobalt emphasis; no separate design-system layer.
|
||||
- Hierarchy: a title and quiet workspace subtitle, a grouped toolbar, then
|
||||
filter rail / primary task list / compact detail and service cards. Footer
|
||||
counts and storage scope use muted text. The task list receives extra width.
|
||||
- Color: cool gray canvas, white cards, soft slate borders, cobalt primary
|
||||
action; dark mode has a charcoal canvas and lighter slate cards. All official
|
||||
control states use the existing semantic Theme tokens, including disabled,
|
||||
selected, checkbox and pagination colors.
|
||||
- Actions: New task is primary. Search and retry are secondary; location,
|
||||
deletion and error simulation are quiet controls. The current filter is
|
||||
derived from the Data query and visibly distinct. Disabled controls retain
|
||||
their official semantics and palette.
|
||||
- Rhythm: 10px within a horizontal control group, 16px between workspace
|
||||
columns, one text line between vertical groups, and `(1 2)` card padding.
|
||||
Ebox Row `:item-gap` is pixels; Column `:item-gap` is lines. Flex uses
|
||||
`:gap '(1 (16))` for one line vertically and 16px horizontally. Keep buttons
|
||||
compact with horizontal padding, rather than making every table row tall.
|
||||
- Data: 100 deterministic tasks, mixed completion states, 10 rows per page.
|
||||
Test all pages, search, filtering, selection, CRUD, two independent Apps and
|
||||
resource recovery. Do not replace the real dataset with a smaller acceptance
|
||||
fixture. Initial seed titles remain stable for reproducible input checks.
|
||||
- Responsive: retain declarative Flex wrapping in source order. Side columns
|
||||
have stable basis sizes; the task list grows. Root padding and viewport scroll
|
||||
are legitimate composition and must work together without example workarounds.
|
||||
- Panel alignment: each workspace Flex line stretches its columns to a shared
|
||||
height, keeping the filter panel's bottom aligned with the main content. A
|
||||
wrapped row sizes independently; no viewport-specific height constants.
|
||||
- Width distribution: filter/list/inspector grow with weights `1/4/1`, keeping
|
||||
emphasis on the task list while a side column fills its line when wrapped.
|
||||
Filter buttons wrap into a horizontal group when their panel has room.
|
||||
Detail and service cards share a wrapping Flex: stacked in the desktop side
|
||||
column, side by side with equal heights on a wider wrapped row, then stacked
|
||||
again when each card's usable minimum width no longer fits.
|
||||
- Table sizing: the task title receives the remaining column width through the
|
||||
existing `(fr 1)` Grid track convention; the action column keeps its compact
|
||||
character width. Header and body consume the same tracks. Resizing changes
|
||||
geometry without replacing custom cell state or semantic identity.
|
||||
- Pagination: full previous/next buttons with readable labels and horizontal
|
||||
padding, a quiet centered page/range summary, and clear disabled states.
|
||||
Workbench uses Chinese labels; the shared component retains configurable text.
|
||||
- Acceptance: inspect light/dark, selected/disabled, wide/compact and scrolled
|
||||
GUI states after functional checks. Preserve the goal's three real GUI
|
||||
performance sample sets with per-operation p95 and max at most 50ms.
|
||||
- Assumption: no new brand was requested; the repository's existing cobalt,
|
||||
neutral surfaces and typography are the design basis.
|
||||
|
||||
3
Makefile
3
Makefile
@ -32,6 +32,7 @@ compile:
|
||||
--eval '(dolist (file (quote ($(foreach file,$(EXAMPLES),"$(file)")))) (byte-compile-file file))' \
|
||||
--eval '(byte-compile-file "etaf-playground.el")' \
|
||||
--eval '(byte-compile-file "scripts/playground-gui-scenarios.el")' \
|
||||
--eval '(byte-compile-file "scripts/task-workbench-gui-scenarios.el")' \
|
||||
--eval '(byte-compile-file "scripts/research-shelf-m0a-evidence.el")' \
|
||||
--eval '(dolist (file (quote ($(foreach file,$(TEST_FILES),"$(file)")))) (byte-compile-file file))'
|
||||
|
||||
@ -108,7 +109,7 @@ load: compile
|
||||
--eval '(princ "etaf-playground load OK\\n")'
|
||||
|
||||
checkdoc:
|
||||
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (append (list "etaf-playground.el" "scripts/benchmark-research-shelf.el" "scripts/playground-gui-scenarios.el" "scripts/research-shelf-m0a-evidence.el") (directory-files-recursively "tests" "\\.el$$") (directory-files-recursively "examples" "\\.el$$"))) (checkdoc-file file)))'
|
||||
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (append (list "etaf-playground.el" "scripts/benchmark-research-shelf.el" "scripts/playground-gui-scenarios.el" "scripts/task-workbench-gui-scenarios.el" "scripts/research-shelf-m0a-evidence.el") (directory-files-recursively "tests" "\\.el$$") (directory-files-recursively "examples" "\\.el$$"))) (checkdoc-file file)))'
|
||||
|
||||
check: checkdoc test
|
||||
|
||||
|
||||
61
README.md
61
README.md
@ -70,15 +70,50 @@ mount.
|
||||
|
||||
## Repeatable Emacs 31.1 GUI verification
|
||||
|
||||
The repository owns one stable real-GUI runner instead of relying on ad-hoc
|
||||
`emacsclient`, focus, and recording commands:
|
||||
Use the user's running graphical Emacs server for current GUI acceptance.
|
||||
Connect with `emacsclient`, render into an explicit buffer in the existing
|
||||
frame, then inspect a capture of that window without changing application focus.
|
||||
Preserve the user's font,
|
||||
coding settings and normal GC policy. A missing server is not a reason to
|
||||
silently start a daemon or create another frame.
|
||||
|
||||
With this checkout and its sibling dependencies already on Emacs's load path:
|
||||
|
||||
```sh
|
||||
emacsclient --eval '(progn (require (quote task-workbench)) (wb-open "*Workbench review*"))'
|
||||
```
|
||||
|
||||
The maintained example is `examples/task-workbench.el`; add that directory to
|
||||
`load-path` before requiring it. For automated interaction checks, load
|
||||
`scripts/task-workbench-gui-scenarios.el` with its `emacs-gui-verifier` engine
|
||||
and adapter dependencies available, then use the existing frame:
|
||||
|
||||
```elisp
|
||||
(task-workbench-gui-prepare)
|
||||
(run-at-time 0.05 nil #'task-workbench-gui-run "/absolute/fresh/evidence-directory")
|
||||
```
|
||||
|
||||
The caller owns window capture and evidence review. The adapter requires fresh
|
||||
dedicated acceptance buffers and preserves the current rendering backend.
|
||||
Preparation also preserves application focus; `(task-workbench-gui-prepare t)`
|
||||
explicitly requests foreground activation. Background Emacs-local actions can
|
||||
verify app behavior, but their timing does not certify foreground display latency.
|
||||
When `EBOX_NATIVE_REFLOW_MODULE_PATH` is explicitly set, it requires that exact
|
||||
compatible module. It does not start a server. Check the mounted Runtime,
|
||||
action assertions and the actual
|
||||
images. Screenshots alone do not prove a latency bound or absence of flicker.
|
||||
See `../etaf/scripts/README.md` for existing-server capture and recording details.
|
||||
|
||||
The following commands are **legacy isolated-environment tools**, retained for
|
||||
explicit requests to use a separate test Emacs. They are not the default
|
||||
existing-server workflow:
|
||||
|
||||
```sh
|
||||
make gui-doctor
|
||||
make gui-research
|
||||
make gui-flex
|
||||
make gui-grid
|
||||
# Or capture all three sequentially:
|
||||
# Or capture all four sequentially in isolated test instances:
|
||||
make gui-all
|
||||
```
|
||||
|
||||
@ -106,7 +141,9 @@ After that temporal review, finalize the exact run directory:
|
||||
scripts/run-gui-verification.sh review /private/tmp/etaf-playground-gui.XXXXXX
|
||||
```
|
||||
|
||||
Only `VERDICT=PASS` is valid GUI evidence. Assertion failure, a black segment,
|
||||
For this legacy capture bundle, only `VERDICT=PASS` certifies its review.
|
||||
This verdict is not required by the separate existing-server workflow.
|
||||
Assertion failure, a black segment,
|
||||
missing recording, wrong buffer, split window, stale frame, or missing temporal
|
||||
review remains fail-closed.
|
||||
|
||||
@ -123,16 +160,18 @@ rebuilding the dependency graph.
|
||||
Performance evidence has three separate lanes correlated by one
|
||||
repository/environment/scenario/fixture/build identity:
|
||||
|
||||
- The latency lane runs the fixed 1413×62 batch evaluator with 5 unmeasured
|
||||
warmups and 30 measured samples. The current active gate requires both p95
|
||||
and max to be at or below 50ms for every scenario.
|
||||
- The batch regression lane runs the retained Research Shelf 1413×62 evaluator
|
||||
with 5 unmeasured warmups and 30 measured samples. Its p95/max 50ms checks
|
||||
diagnose regressions in that batch fixture.
|
||||
- The trace lane runs a separate instrumented representative invocation. Its
|
||||
cost classes, work counters, turns, allocation, and GC data are not inserted
|
||||
into the timed latency distribution.
|
||||
- The GUI lane captures the real Emacs interaction sequence, screenshots, and
|
||||
temporal-review verdict. Batch verifier duration is not GUI first paint;
|
||||
action-start to forced-redisplay-complete first-paint timing remains a
|
||||
separately identified future gate and an observed M0a gap.
|
||||
- The GUI lane checks the real Emacs interaction sequence and reviewed images.
|
||||
Current acceptance also requires three independent foreground GUI sample sets
|
||||
with per-operation p95 and max at or below 50ms, from action callback through
|
||||
forced redisplay. This gate remains outstanding. Use the measurement boundary
|
||||
in `../etaf/scripts/README.md`, preserving warmups, GC and all samples. Returning
|
||||
from redisplay does not certify compositor presentation.
|
||||
|
||||
Evidence from one lane supports only that lane's conclusion. A
|
||||
performance-complete or user-visible-non-regression claim requires the
|
||||
|
||||
@ -67,15 +67,42 @@ source，会在下一次 mount 前重新加载完整 consumer。
|
||||
|
||||
## 可重复执行的 Emacs 31.1 GUI 实测
|
||||
|
||||
仓库提供一个稳定的真实 GUI runner，不再临时拼接 `emacsclient`、前台激活和录屏
|
||||
命令：
|
||||
当前 GUI 验收使用用户已经运行的图形 Emacs server：通过 `emacsclient`
|
||||
在明确命名的 buffer 中渲染，保留当前应用焦点，只截取已有窗口并检查。
|
||||
保留用户字体、编码设置和正常 GC 策略；连接失败时不自动启动 daemon 或另建 frame。
|
||||
|
||||
本仓库及 sibling 依赖已在 Emacs 的 load-path 中时：
|
||||
|
||||
```sh
|
||||
emacsclient --eval '(progn (require (quote task-workbench)) (wb-open "*Workbench review*"))'
|
||||
```
|
||||
|
||||
维护中的例子位于 `examples/task-workbench.el`；require 前需将 examples
|
||||
目录加入 load-path。自动交互验证可在 `emacs-gui-verifier` 引擎及适配器
|
||||
依赖已经可用后，加载 `scripts/task-workbench-gui-scenarios.el`，在已有 frame 执行：
|
||||
|
||||
```elisp
|
||||
(task-workbench-gui-prepare)
|
||||
(run-at-time 0.05 nil #'task-workbench-gui-run "/absolute/fresh/evidence-directory")
|
||||
```
|
||||
|
||||
调用方负责窗口截图及证据检查。适配器要求新的专用验收 buffer，并保留当前
|
||||
渲染后端。准备阶段也保留应用焦点；显式调用 `(task-workbench-gui-prepare t)`
|
||||
才会切到前台。后台的 Emacs 本地动作可以验证功能，其耗时不能证明前台显示延迟。
|
||||
只有显式设置 `EBOX_NATIVE_REFLOW_MODULE_PATH` 时，才要求加载该路径下的兼容
|
||||
native 模块。适配器不启动 server。需检查 mounted Runtime、动作断言和实际截图；
|
||||
截图本身不能证明延迟上界或无闪烁。现有 server 的截图与录屏细节见
|
||||
`../etaf/scripts/README.md`。
|
||||
|
||||
以下命令是保留的 **legacy 隔离环境工具**，只用于明确选择独立测试 Emacs 的
|
||||
场景，不是当前默认的 existing-server 流程：
|
||||
|
||||
```sh
|
||||
make gui-doctor
|
||||
make gui-research
|
||||
make gui-flex
|
||||
make gui-grid
|
||||
# 或按顺序采集三个场景：
|
||||
# 或在独立测试实例中按顺序采集四个场景：
|
||||
make gui-all
|
||||
```
|
||||
|
||||
@ -100,11 +127,16 @@ scenario factory 的两个输入。增加新应用时不会复制第二套 daemo
|
||||
scripts/run-gui-verification.sh review /private/tmp/etaf-playground-gui.XXXXXX
|
||||
```
|
||||
|
||||
只有 `VERDICT=PASS` 才是有效 GUI 证据。assertion 失败、黑帧、录屏缺失、错误 buffer、
|
||||
对于这套 legacy 录屏包，只有 `VERDICT=PASS` 才证明其审查完成；这个 verdict
|
||||
不是另一条 existing-server 流程的必要条件。assertion 失败、黑帧、录屏缺失、错误 buffer、
|
||||
split window、陈旧 frame 或没有完成时序审查都会保持 fail-closed。
|
||||
|
||||
验证命令：`make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`。
|
||||
性能门禁：`make perf`（1413×62 viewport 的 warm 选行/主题延迟）。
|
||||
批处理回归：`make perf`（Research Shelf 的 1413×62 viewport，选行/主题延迟）。
|
||||
当前 GUI 验收还要求三组独立的前台实测，每项操作从回调开始到强制 redisplay
|
||||
返回的 p95 和 max 均不超过 50ms；该门禁尚未通过。使用
|
||||
`../etaf/scripts/README.md` 中的测量入口，保留预热、GC 记录和全部样本。
|
||||
redisplay 返回不能证明操作系统已经呈现画面，批处理结果也不能替代 GUI 门禁。
|
||||
|
||||
仓库中的 Research Shelf 只是上述通用工作区的一个 consumer。它默认安装确定性的
|
||||
256 条 SQLite fixture，每页显示 12 条；测试或压测时可以绑定
|
||||
|
||||
374
examples/task-workbench.el
Normal file
374
examples/task-workbench.el
Normal file
@ -0,0 +1,374 @@
|
||||
;;; task-workbench.el --- Composable task workbench -*- lexical-binding: t; -*-
|
||||
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; A complete public API example: reusable components and cells, controlled
|
||||
;; inputs, slots, Context, Theme, resources, lifecycle, and independent Apps.
|
||||
;; Load this module and run `wb-open'. Use `wb-close' to dispose the App.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'subr-x)
|
||||
(require 'etaf-ui)
|
||||
|
||||
;;; Data and ordinary functions
|
||||
|
||||
(defconst wb-tasks
|
||||
(append
|
||||
'((:id 1 :title "设计组件接口" :done nil)
|
||||
(:id 2 :title "编写使用示例" :done nil)
|
||||
(:id 3 :title "检查状态隔离" :done t)
|
||||
(:id 4 :title "验证键盘操作" :done nil)
|
||||
(:id 5 :title "补充文档" :done t))
|
||||
(cl-loop for id from 6 to 100
|
||||
for title = (nth (mod id 10)
|
||||
'("整理项目资料" "检查发布清单" "优化任务流程"
|
||||
"更新使用指南" "确认界面文案" "梳理组件边界"
|
||||
"复核交互细节" "清理过期任务" "完善测试记录"
|
||||
"准备版本说明"))
|
||||
collect (list :id id :title (format "%s %03d" title id)
|
||||
:done (zerop (mod id 4)))))
|
||||
"Initial rows copied independently into each workbench.")
|
||||
|
||||
(defun wb-task-id (task)
|
||||
"Return TASK's stable identity."
|
||||
(plist-get task :id))
|
||||
|
||||
(defun wb-query (data query)
|
||||
"Apply QUERY to DATA and load its first page."
|
||||
(etaf-data-set-query data query)
|
||||
(etaf-data-set-page data 1)
|
||||
(etaf-data-load data))
|
||||
|
||||
(defun wb-theme (dark)
|
||||
"Return the workbench palette for DARK or light mode."
|
||||
(if dark
|
||||
'(:ui-fg "#E5EAF3" :ui-bg "#111827" :ui-border "#38465B"
|
||||
:ui-muted-fg "#A1AEC1" :ui-success-fg "#70D6B4"
|
||||
:ui-panel-fg "#E5EAF3" :ui-panel-bg "#1B2535"
|
||||
:ui-panel-border "#38465B"
|
||||
:ui-button-primary-fg "#FFFFFF" :ui-button-primary-bg "#4869D8"
|
||||
:ui-button-primary-border "#4869D8"
|
||||
:ui-button-secondary-fg "#DCE5FF" :ui-button-secondary-bg "#2C3C60"
|
||||
:ui-button-secondary-border "#2C3C60"
|
||||
:ui-button-ghost-fg "#B8C5DA" :ui-button-ghost-bg "#1B2535"
|
||||
:ui-button-ghost-border "#38465B"
|
||||
:ui-checkbox-enabled-fg "#D6E0F1" :ui-checkbox-enabled-bg "#263449"
|
||||
:ui-checkbox-enabled-border "#465872"
|
||||
:ui-disabled-fg "#8390A5" :ui-disabled-bg "#253044"
|
||||
:ui-disabled-border "#334157"
|
||||
:ui-table-border "#38465B" :ui-table-selected-fg "#E4ECFF"
|
||||
:ui-table-selected-bg "#2C3C60" :ui-pagination-muted-fg "#A1AEC1")
|
||||
'(:ui-fg "#172033" :ui-bg "#F3F5F8" :ui-border "#D8DFE8"
|
||||
:ui-muted-fg "#647084" :ui-success-fg "#24745C"
|
||||
:ui-panel-fg "#172033" :ui-panel-bg "#FFFFFF"
|
||||
:ui-panel-border "#D8DFE8"
|
||||
:ui-button-primary-fg "#FFFFFF" :ui-button-primary-bg "#3657D6"
|
||||
:ui-button-primary-border "#3657D6"
|
||||
:ui-button-secondary-fg "#263C78" :ui-button-secondary-bg "#E8EDF8"
|
||||
:ui-button-secondary-border "#E8EDF8"
|
||||
:ui-button-ghost-fg "#526174" :ui-button-ghost-bg "#FFFFFF"
|
||||
:ui-button-ghost-border "#D8DFE8"
|
||||
:ui-checkbox-enabled-fg "#33425C" :ui-checkbox-enabled-bg "#F0F3F9"
|
||||
:ui-checkbox-enabled-border "#CDD6E4"
|
||||
:ui-disabled-fg "#8290A3" :ui-disabled-bg "#F0F2F6"
|
||||
:ui-disabled-border "#E0E5ED"
|
||||
:ui-table-border "#E2E7EF" :ui-table-selected-fg "#263C78"
|
||||
:ui-table-selected-bg "#E8EDF8" :ui-pagination-muted-fg "#647084")))
|
||||
|
||||
;;; Action: one named business operation reused by add/update/delete
|
||||
|
||||
(etaf-action-define wb-mutate (runtime data operation payload)
|
||||
(ignore runtime)
|
||||
(etaf-data-set-page data 1)
|
||||
(etaf-data-mutate data operation payload))
|
||||
|
||||
(etaf-action-define wb-focus (runtime target)
|
||||
(etaf-focus runtime target))
|
||||
|
||||
;;; Behavior: stable callbacks, additive to the Button's business action
|
||||
|
||||
(defun wb-trace-press ()
|
||||
"Report a completed control action."
|
||||
(message "动作已执行"))
|
||||
(defun wb-trace-cleanup ()
|
||||
"Report disposal of a control's reusable behavior."
|
||||
(message "按钮行为已释放"))
|
||||
(defun wb-trace-install ()
|
||||
"Return the cleanup callback for a control's reusable behavior."
|
||||
#'wb-trace-cleanup)
|
||||
|
||||
(etaf-define-behavior wb-trace ()
|
||||
(etaf-behavior-create 'wb-trace
|
||||
:on-press #'wb-trace-press
|
||||
:install #'wb-trace-install))
|
||||
|
||||
(etaf-define-component wb-button (&key label on-press disabled variant)
|
||||
:view
|
||||
(etaf-button :label label :on-press on-press :disabled disabled
|
||||
:variant variant :padding '(0 2)
|
||||
:use (list (wb-trace))))
|
||||
|
||||
;;; Stateless layout: props, default slot, named slots, scoped styles
|
||||
|
||||
(etaf-define-component wb-shell (&key title)
|
||||
:view
|
||||
(column :width '(viewport) :height '(viewport-height) :overflow 'scroll
|
||||
:item-gap 1
|
||||
:color (etaf-theme-token :ui-fg)
|
||||
:bgcolor (etaf-theme-token :ui-bg)
|
||||
(flex :width 'stretch :flex-wrap 'wrap :gap '(1 (16))
|
||||
:align-items 'center :justify-content 'space-between
|
||||
(column :flex-grow 1 :min-width 0
|
||||
(text :class "title" (expr title))
|
||||
(etaf-label :variant 'muted :text "个人任务 · 本地工作空间"))
|
||||
(flex :width 'max-content :flex-wrap 'wrap :gap '(1 (10))
|
||||
:align-items 'center
|
||||
(slot :name 'toolbar)))
|
||||
(flex :width 'stretch :flex-wrap 'wrap :gap '(1 (16))
|
||||
:align-items 'stretch
|
||||
(slot))
|
||||
(slot :name 'footer (text "准备就绪")))
|
||||
:styles
|
||||
(styles
|
||||
("&" :padding (1 3))
|
||||
(".title" :font-weight bold)
|
||||
(".etaf-table-body" :item-gap 1)
|
||||
(".etaf-table-header" :padding (0 1))))
|
||||
|
||||
;;; Reusable cell: Context dependency + controlled Checkbox + disabled Button
|
||||
|
||||
(etaf-define-component wb-task-controls (&key task)
|
||||
:setup
|
||||
(etaf-inject 'wb-data nil t)
|
||||
:render
|
||||
(let ((data (etaf-state))
|
||||
(item task)) ; Capture this render's ordinary prop.
|
||||
(etaf-view
|
||||
(row :item-gap 10
|
||||
(etaf-checkbox
|
||||
:label "完成" :checked (plist-get item :done)
|
||||
:on-press #'wb-trace-press ; Additive; does not replace on-change.
|
||||
:on-change
|
||||
(lambda (next)
|
||||
(etaf-dispatch 'wb-mutate data 'update
|
||||
(plist-put (copy-sequence item) :done next))))
|
||||
(wb-button
|
||||
:label "删除" :variant 'ghost :disabled (not (plist-get item :done))
|
||||
:on-press
|
||||
(lambda ()
|
||||
(etaf-dispatch 'wb-mutate data 'delete (wb-task-id item))))))))
|
||||
|
||||
(defun wb-controls-cell (row)
|
||||
"Return reusable task controls for ROW at the consuming cell."
|
||||
(etaf-view (wb-task-controls :task row)))
|
||||
|
||||
(defconst wb-columns
|
||||
'((:key :title :label "任务" :width (fr 1))
|
||||
(:key :actions :label "操作" :width 22 :cell wb-controls-cell))
|
||||
"Task columns with stable identities and an ordinary View factory.")
|
||||
|
||||
;;; Dynamic composition: expr returns an ordinary Component
|
||||
|
||||
(etaf-define-component wb-task-info (&key task)
|
||||
:view
|
||||
(column
|
||||
(text :font-weight 'bold (expr (plist-get task :title)))
|
||||
(text (expr (if (plist-get task :done) "已完成" "进行中")))))
|
||||
|
||||
(etaf-define-component wb-detail ()
|
||||
:setup
|
||||
(list :data (etaf-inject 'wb-data nil t) :expanded (etaf-ref t))
|
||||
:render
|
||||
(let* ((state (etaf-state))
|
||||
(data (plist-get state :data))
|
||||
(expanded (plist-get state :expanded)))
|
||||
(etaf-view
|
||||
(etaf-panel :title "详情" :item-gap 1
|
||||
(expr
|
||||
(if-let* ((task (etaf-data-selected-item data)))
|
||||
(etaf-view (wb-task-info :task task))
|
||||
(etaf-view (text "点击任务行查看详情"))))
|
||||
(etaf-checkbox
|
||||
:label "显示说明" :checked (etaf-value expanded)
|
||||
:on-change (lambda (next) (setf (etaf-value expanded) next)))
|
||||
(box :if (etaf-value expanded) :height 3 :overflow 'scroll
|
||||
(column
|
||||
(text :for (tip '("点击行：选择任务"
|
||||
"勾选：修改完成状态"
|
||||
"完成后可以删除"
|
||||
"TAB：移动焦点"
|
||||
"RET：激活控件"))
|
||||
:key tip
|
||||
(expr tip))))))))
|
||||
|
||||
;;; Resource: explicit status/error/retry, scoped result cleanup
|
||||
;;; This is a synchronous demo loader, not a simulated asynchronous API.
|
||||
|
||||
(defun wb-service-cleanup ()
|
||||
"Report disposal of a previously loaded service result."
|
||||
(message "旧服务结果已释放"))
|
||||
|
||||
(etaf-define-component wb-service ()
|
||||
:setup
|
||||
(let* ((fail-next (etaf-ref nil))
|
||||
(resource
|
||||
(etaf-resource
|
||||
(lambda ()
|
||||
(when (etaf-value fail-next)
|
||||
(setf (etaf-value fail-next) nil)
|
||||
(error "模拟加载失败"))
|
||||
(etaf-resource-result "服务正常"
|
||||
:cleanup #'wb-service-cleanup))
|
||||
:immediate nil)))
|
||||
(etaf-on-mounted (lambda () (etaf-resource-load resource)))
|
||||
(list :resource resource :fail-next fail-next))
|
||||
:render
|
||||
(let* ((state (etaf-state))
|
||||
(resource (plist-get state :resource))
|
||||
(fail-next (plist-get state :fail-next)))
|
||||
(etaf-view
|
||||
(etaf-panel :title "服务状态" :item-gap 1
|
||||
(text
|
||||
(expr
|
||||
(pcase (etaf-resource-status resource)
|
||||
('success (etaf-resource-value resource))
|
||||
('error (error-message-string (etaf-resource-error resource)))
|
||||
(_ "加载中…"))))
|
||||
(row :item-gap 10
|
||||
(wb-button :label "刷新 / 重试" :variant 'secondary
|
||||
:on-press (lambda () (etaf-resource-load resource)))
|
||||
(wb-button :label "模拟失败" :variant 'ghost
|
||||
:on-press
|
||||
(lambda ()
|
||||
(setf (etaf-value fail-next) t)
|
||||
(etaf-resource-load resource))))))))
|
||||
|
||||
;;; App owner: Data, refs, computed, watch, Context, Theme, lifecycle
|
||||
|
||||
(etaf-define-component wb-app ()
|
||||
:setup
|
||||
(let* ((data (etaf-data-controller
|
||||
(etaf-data-memory-source (copy-tree wb-tasks) :id-key :id)
|
||||
:page-size 10 :auto-load nil))
|
||||
(dark (etaf-ref nil))
|
||||
(next-id (etaf-ref (1+ (apply #'max (mapcar #'wb-task-id wb-tasks)))))
|
||||
(summary
|
||||
(etaf-computed
|
||||
(lambda ()
|
||||
(format "共 %d 条 · 当前页 %d 条"
|
||||
(etaf-value (etaf-data-total data))
|
||||
(length (etaf-value (etaf-data-items data))))))))
|
||||
(etaf-provide 'wb-data data)
|
||||
(etaf-theme-provide
|
||||
(etaf-computed (lambda () (wb-theme (etaf-value dark)))))
|
||||
(etaf-watch dark
|
||||
(lambda (new _old)
|
||||
(message "切换到%s主题" (if new "深色" "浅色"))))
|
||||
(etaf-on-mounted (lambda () (etaf-data-load data)))
|
||||
(etaf-on-updated (lambda () (message "工作台已更新")))
|
||||
(etaf-on-unmounted (lambda () (message "工作台已卸载")))
|
||||
;; Data, computed, watch and nested Resource scopes dispose automatically.
|
||||
(list :data data :dark dark :next-id next-id :summary summary
|
||||
:add-ref (make-symbol "wb-add")))
|
||||
:render
|
||||
(let* ((state (etaf-state))
|
||||
(data (plist-get state :data))
|
||||
(dark (plist-get state :dark))
|
||||
(next-id (plist-get state :next-id))
|
||||
(summary (plist-get state :summary))
|
||||
(add-ref (plist-get state :add-ref)))
|
||||
(etaf-view
|
||||
(wb-shell :title "任务工作台"
|
||||
(slot :name 'toolbar
|
||||
(wb-button
|
||||
:ref add-ref :label "新增任务"
|
||||
:on-press
|
||||
(lambda ()
|
||||
(let ((title (string-trim (read-string "任务名称："))))
|
||||
(unless (string-empty-p title)
|
||||
(let ((id (etaf-value next-id)))
|
||||
(cl-incf (etaf-value next-id))
|
||||
(etaf-dispatch 'wb-mutate data 'insert
|
||||
(list :id id :title title :done nil)))))))
|
||||
(etaf-checkbox :label "深色" :checked (etaf-value dark)
|
||||
:on-change (lambda (next) (setf (etaf-value dark) next)))
|
||||
(wb-button :label "定位新增按钮" :variant 'ghost
|
||||
:on-press (lambda () (etaf-dispatch 'wb-focus add-ref))))
|
||||
|
||||
;; Parent owns each panel's participation in this Flex layout.
|
||||
(etaf-panel :title "筛选" :flex-basis 18 :flex-grow 1 :flex-shrink 0 :item-gap 1
|
||||
(flex :flex-wrap 'wrap :gap '(1 (10)) :align-items 'stretch
|
||||
(wb-button :label "全部" :width 'stretch :flex-basis 16 :flex-grow 1
|
||||
:variant (if (null (etaf-value (etaf-data-query data)))
|
||||
'secondary 'ghost)
|
||||
:on-press (lambda () (wb-query data nil)))
|
||||
(wb-button :label "未完成" :width 'stretch :flex-basis 16 :flex-grow 1
|
||||
:variant (if (equal (etaf-value (etaf-data-query data)) '(:done nil))
|
||||
'secondary 'ghost)
|
||||
:on-press (lambda () (wb-query data '(:done nil))))
|
||||
(wb-button :label "已完成" :width 'stretch :flex-basis 16 :flex-grow 1
|
||||
:variant (if (equal (etaf-value (etaf-data-query data)) '(:done t))
|
||||
'secondary 'ghost)
|
||||
:on-press (lambda () (wb-query data '(:done t))))
|
||||
(wb-button :label "搜索" :variant 'secondary :width 'stretch
|
||||
:flex-basis 16 :flex-grow 1
|
||||
:on-press (lambda () (wb-query data (read-string "搜索："))))))
|
||||
|
||||
(etaf-panel :title "任务" :flex-grow 4 :flex-basis 64 :min-width 0
|
||||
:item-gap 1
|
||||
(etaf-data-grid
|
||||
:controller data :columns wb-columns :row-key #'wb-task-id
|
||||
:on-row-press (lambda (row) (etaf-data-select-one data (wb-task-id row)))
|
||||
:loading-label "读取任务…" :error-label "读取失败，请重新筛选"
|
||||
:empty-label "没有匹配的任务"
|
||||
(slot :name 'footer
|
||||
(etaf-pagination :controller data
|
||||
:previous-label "‹ 上一页" :next-label "下一页 ›")))
|
||||
(etaf-number-input
|
||||
:label "每页条数" :value (etaf-value (etaf-data-page-size data))
|
||||
:min 1 :max 20
|
||||
:on-change
|
||||
(lambda (next)
|
||||
(etaf-data-set-page-size data next)
|
||||
(etaf-data-set-page data 1)
|
||||
(etaf-data-load data))))
|
||||
|
||||
(flex :flex-wrap 'wrap :flex-basis 36 :flex-grow 1 :min-width 0
|
||||
:align-content 'space-between :align-items 'stretch :gap '(1 (16))
|
||||
(wb-detail :flex-basis 28 :flex-grow 1)
|
||||
(wb-service :flex-basis 28 :flex-grow 1))
|
||||
|
||||
(slot :name 'footer
|
||||
(grid :width 'stretch :grid-template-columns '((fr 1) (fr 1)) :gap 1
|
||||
(etaf-label :variant 'muted :text (etaf-value summary))
|
||||
(etaf-label :variant 'muted
|
||||
:text "数据仅保存在当前工作台内存中")))))))
|
||||
|
||||
;;; Open / close. Each buffer gets independent App state and local refs.
|
||||
|
||||
(defun wb-open (&optional buffer-name)
|
||||
"Open an independent workbench in BUFFER-NAME or the default buffer."
|
||||
(interactive)
|
||||
(switch-to-buffer
|
||||
(etaf-mount (or buffer-name "*任务工作台*") (etaf-view (wb-app)))))
|
||||
|
||||
(defun wb-close (&optional buffer-name)
|
||||
"Dispose the workbench in BUFFER-NAME and close its buffer."
|
||||
(interactive)
|
||||
(let ((name (or buffer-name "*任务工作台*")))
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer name)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((buffer (get-buffer name)))
|
||||
(kill-buffer buffer))))
|
||||
|
||||
;; Usage:
|
||||
;; (wb-open)
|
||||
;; (wb-open "*另一个独立工作台*")
|
||||
;; (wb-close)
|
||||
|
||||
(provide 'task-workbench)
|
||||
;;; task-workbench.el ends here
|
||||
@ -61,10 +61,26 @@
|
||||
(defun etaf-playground-gui-scenarios--begin-viewport-change
|
||||
(context fullscreen &optional width height)
|
||||
"Record CONTEXT state before targeting FULLSCREEN, WIDTH, and HEIGHT."
|
||||
(let ((report (etaf-playground-gui-scenarios--report context)))
|
||||
(when (tp-transaction-active-p)
|
||||
(error "Cannot observe committed viewport geometry inside a TP transaction"))
|
||||
(let* ((buffer (etaf-gui-verifier-context-target-buffer context))
|
||||
(revision (ebox-surface-buffer-revision buffer))
|
||||
(unchanged (and (eq (frame-parameter nil 'fullscreen) fullscreen)
|
||||
(or (not (numberp width)) (= (frame-text-width) width))
|
||||
(or (not (numberp height)) (= (frame-text-height) height)))))
|
||||
(etaf-gui-verifier-context-put
|
||||
context 'viewport-revision-before
|
||||
(plist-get report :runtime-revision))
|
||||
;; A frame already at the requested geometry has no resize to publish.
|
||||
;; Real geometry changes still require a new committed revision.
|
||||
(unless unchanged revision))
|
||||
(etaf-gui-verifier-context-put
|
||||
context 'viewport-noop-before
|
||||
(when unchanged
|
||||
(list :window (selected-window)
|
||||
:width (ebox-viewport-window-width (selected-window))
|
||||
:height (window-body-height (selected-window))
|
||||
:frame-width (frame-text-width) :frame-height (frame-text-height)
|
||||
:revision revision)))
|
||||
(etaf-gui-verifier-context-put context 'target-fullscreen fullscreen)
|
||||
(etaf-gui-verifier-context-put context 'target-frame-width width)
|
||||
(etaf-gui-verifier-context-put context 'target-frame-height height)))
|
||||
@ -79,33 +95,67 @@
|
||||
(or (not (numberp width)) (= (frame-text-width) width))
|
||||
(or (not (numberp height)) (= (frame-text-height) height)))))
|
||||
|
||||
(defun etaf-playground-gui-scenarios--viewport-unchanged-p (context before)
|
||||
"Prove CONTEXT's window geometry and committed revision match BEFORE.
|
||||
This proves an unchanged action, not a new viewport publication."
|
||||
(let ((buffer (etaf-gui-verifier-context-target-buffer context)))
|
||||
(and (not (tp-transaction-active-p))
|
||||
(buffer-live-p buffer)
|
||||
(ebox-surface-buffer-mounted-p buffer)
|
||||
(eq (selected-window) (plist-get before :window))
|
||||
(numberp (plist-get before :width))
|
||||
(equal (ebox-viewport-window-width (selected-window))
|
||||
(plist-get before :width))
|
||||
(equal (window-body-height (selected-window)) (plist-get before :height))
|
||||
(equal (frame-text-width) (plist-get before :frame-width))
|
||||
(equal (frame-text-height) (plist-get before :frame-height))
|
||||
(numberp (plist-get before :revision))
|
||||
(> (plist-get before :revision) 0)
|
||||
(= (ebox-surface-buffer-revision buffer) (plist-get before :revision)))))
|
||||
|
||||
(defun etaf-playground-gui-scenarios--viewport-settled-p (context)
|
||||
"Return non-nil when CONTEXT published the selected window's viewport."
|
||||
(let* ((report (etaf-playground-gui-scenarios--report context))
|
||||
"Return non-nil when CONTEXT's resize published or its no-op stayed unchanged."
|
||||
(let* ((before (etaf-gui-verifier-context-get context 'viewport-noop-before))
|
||||
(report (unless before (etaf-playground-gui-scenarios--report context)))
|
||||
(buffer (etaf-gui-verifier-context-target-buffer context))
|
||||
(actual (ebox-viewport-window-width (selected-window)))
|
||||
(published (or (plist-get report :target-viewport-width)
|
||||
(plist-get report :viewport-width)))
|
||||
(revision (plist-get report :runtime-revision))
|
||||
(published-height (plist-get report :target-viewport-height))
|
||||
;; The public buffer revision is TP's committed surface revision.
|
||||
;; Ebox's runtime revision is a different, possibly lagging counter.
|
||||
(revision (plist-get report :surface-revision))
|
||||
(previous
|
||||
(etaf-gui-verifier-context-get
|
||||
context 'viewport-revision-before)))
|
||||
(and (numberp actual)
|
||||
(numberp published)
|
||||
(= actual published)
|
||||
(numberp revision)
|
||||
(or (not (numberp previous)) (> revision previous))
|
||||
(plist-get report :runtime-published)
|
||||
(not (plist-get report :tp-scope-fallback))
|
||||
(and (if before
|
||||
(etaf-playground-gui-scenarios--viewport-unchanged-p context before)
|
||||
(and (not (tp-transaction-active-p))
|
||||
(buffer-live-p buffer)
|
||||
(ebox-surface-buffer-mounted-p buffer)
|
||||
(numberp actual)
|
||||
(numberp published)
|
||||
(= actual published)
|
||||
(numberp published-height)
|
||||
(= (window-body-height (selected-window)) published-height)
|
||||
(integerp revision)
|
||||
(integerp previous)
|
||||
(> revision previous)
|
||||
(= revision (ebox-surface-buffer-revision buffer))
|
||||
(plist-get report :runtime-published)
|
||||
(not (plist-get report :tp-scope-fallback))))
|
||||
(etaf-playground-gui-scenarios--frame-target-settled-p context)
|
||||
(etaf-playground-gui-scenarios--visible-window-content-p context))))
|
||||
|
||||
(defun etaf-playground-gui-scenarios--invariants (context)
|
||||
"Return shared Ebox/ETAF publication invariants for CONTEXT."
|
||||
(cl-defun etaf-playground-gui-scenarios--invariants
|
||||
(context &optional (preview-p t))
|
||||
"Return shared Ebox/ETAF publication invariants for CONTEXT.
|
||||
PREVIEW-P additionally requires the display settings owned by Playground."
|
||||
(let* ((buffer (etaf-gui-verifier-context-target-buffer context))
|
||||
(mounted (and (buffer-live-p buffer)
|
||||
(ebox-surface-buffer-mounted-p buffer)))
|
||||
(canvas-settings
|
||||
(and mounted
|
||||
(and mounted preview-p
|
||||
(with-current-buffer buffer
|
||||
(list truncate-lines fringe-indicator-alist))))
|
||||
(text (and mounted
|
||||
@ -113,25 +163,30 @@
|
||||
(buffer-substring-no-properties
|
||||
(point-min) (point-max))))))
|
||||
(when (etaf-gui-verifier-context-get context 'expects-mounted)
|
||||
(list
|
||||
(append
|
||||
(list
|
||||
(etaf-gui-verifier-assert "surface-mounted" mounted)
|
||||
(etaf-gui-verifier-assert
|
||||
"rendered-output-nonempty" (and text (> (length text) 0)))
|
||||
(etaf-gui-verifier-assert
|
||||
"visible-output-nonempty"
|
||||
(etaf-playground-gui-scenarios--visible-window-content-p context))
|
||||
(etaf-gui-verifier-assert
|
||||
"generated-canvas-truncates-editor-lines" (car canvas-settings))
|
||||
(etaf-gui-verifier-assert
|
||||
"generated-canvas-hides-editor-edge-indicators"
|
||||
(and (not (assq 'truncation (cadr canvas-settings)))
|
||||
(not (assq 'continuation (cadr canvas-settings)))))
|
||||
(etaf-gui-verifier-assert
|
||||
"no-render-error"
|
||||
(and text
|
||||
(not (string-match-p
|
||||
"could not render\\|runtime error\\|Wrong type argument"
|
||||
text))))))))
|
||||
text)))))
|
||||
;; Preview chrome is owned by Playground's preview mode. A standalone
|
||||
;; App mounted with `etaf-mount' has no preview-mode contract.
|
||||
(when preview-p
|
||||
(list
|
||||
(etaf-gui-verifier-assert
|
||||
"generated-canvas-truncates-editor-lines" (car canvas-settings))
|
||||
(etaf-gui-verifier-assert
|
||||
"generated-canvas-hides-editor-edge-indicators"
|
||||
(and (not (assq 'truncation (cadr canvas-settings)))
|
||||
(not (assq 'continuation (cadr canvas-settings)))))))))))
|
||||
|
||||
(defun etaf-playground-gui-scenarios--adapter (context)
|
||||
"Return Playground-specific JSON data for CONTEXT."
|
||||
@ -179,19 +234,19 @@
|
||||
:assertions #'etaf-playground-gui-scenarios--resize-assertions))
|
||||
|
||||
(defun etaf-playground-gui-scenarios--resize-assertions (context)
|
||||
"Return exact accepted-viewport assertions for CONTEXT."
|
||||
(let* ((report (etaf-playground-gui-scenarios--report context))
|
||||
(actual (ebox-viewport-window-width (selected-window)))
|
||||
(published (or (plist-get report :target-viewport-width)
|
||||
(plist-get report :viewport-width))))
|
||||
(list
|
||||
(etaf-gui-verifier-assert
|
||||
"viewport-published"
|
||||
(and (numberp actual) (numberp published) (= actual published)
|
||||
(plist-get report :runtime-published)))
|
||||
(etaf-gui-verifier-assert
|
||||
"resize-not-scope-fallback"
|
||||
(not (plist-get report :tp-scope-fallback))))))
|
||||
"Return exact viewport publication or unchanged-action assertions for CONTEXT."
|
||||
(if (etaf-gui-verifier-context-get context 'viewport-noop-before)
|
||||
(list (etaf-gui-verifier-assert
|
||||
"viewport-unchanged"
|
||||
(etaf-playground-gui-scenarios--viewport-settled-p context)))
|
||||
(let ((report (etaf-playground-gui-scenarios--report context)))
|
||||
(list
|
||||
(etaf-gui-verifier-assert
|
||||
"viewport-published"
|
||||
(etaf-playground-gui-scenarios--viewport-settled-p context))
|
||||
(etaf-gui-verifier-assert
|
||||
"resize-not-scope-fallback"
|
||||
(not (plist-get report :tp-scope-fallback)))))))
|
||||
|
||||
(defun etaf-playground-gui-scenarios--resize-action (id width height)
|
||||
"Return resize action ID for pixel WIDTH and HEIGHT."
|
||||
|
||||
@ -8,13 +8,16 @@ REPOS_DIR=$(dirname "$PLAYGROUND_DIR")
|
||||
GENERIC_RUNNER="$REPOS_DIR/etaf/scripts/run-emacs-gui-verification.sh"
|
||||
SCENARIO_ADAPTER="$PLAYGROUND_SCRIPT_DIR/playground-gui-scenarios.el"
|
||||
SCENARIO_ENTRY=etaf-playground-gui-scenarios-run-from-environment
|
||||
SCENARIO_INITIALIZER=""
|
||||
|
||||
usage() {
|
||||
echo "Legacy isolated GUI runner: creates a separate daemon/frame." >&2
|
||||
echo "For the existing Emacs server, see README.md GUI verification." >&2
|
||||
echo "usage:" >&2
|
||||
echo " $0 doctor" >&2
|
||||
echo " $0 review RUN_DIR" >&2
|
||||
echo " $0 all [--run-dir DIRECTORY]" >&2
|
||||
echo " $0 research-shelf|flex-reference|grid-reference [--run-dir DIRECTORY]" >&2
|
||||
echo " $0 task-workbench|research-shelf|flex-reference|grid-reference [--run-dir DIRECTORY]" >&2
|
||||
exit 2
|
||||
}
|
||||
|
||||
@ -52,6 +55,12 @@ parse_run_dir() {
|
||||
|
||||
prepare_fixture() {
|
||||
case $SCENARIO_NAME in
|
||||
task-workbench)
|
||||
SCENARIO_FIXTURE=""
|
||||
SCENARIO_ADAPTER="$PLAYGROUND_SCRIPT_DIR/task-workbench-gui-scenarios.el"
|
||||
SCENARIO_ENTRY=task-workbench-gui-run-from-environment
|
||||
SCENARIO_INITIALIZER=task-workbench-gui-prepare
|
||||
;;
|
||||
research-shelf)
|
||||
SCENARIO_FIXTURE=""
|
||||
;;
|
||||
@ -63,11 +72,17 @@ prepare_fixture() {
|
||||
}
|
||||
|
||||
run_scenario() {
|
||||
doctor >/dev/null
|
||||
echo "Legacy isolated GUI run: a separate test Emacs will be created (see README.md)." >&2
|
||||
prepare_fixture
|
||||
doctor >/dev/null
|
||||
export ETAF_GUI_SCENARIO="$SCENARIO_NAME"
|
||||
export ETAF_GUI_FIXTURE="$SCENARIO_FIXTURE"
|
||||
set --
|
||||
if [ -n "$SCENARIO_INITIALIZER" ]; then
|
||||
set -- --initialize-function "$SCENARIO_INITIALIZER"
|
||||
fi
|
||||
"$GENERIC_RUNNER" run "$SCENARIO_ADAPTER" "$SCENARIO_ENTRY" \
|
||||
"$@" \
|
||||
--run-dir "$SCENARIO_RUN_DIR" \
|
||||
--load-path "$REPOS_DIR/tp" \
|
||||
--load-path "$REPOS_DIR/ecss" \
|
||||
@ -98,12 +113,12 @@ case $COMMAND in
|
||||
all)
|
||||
parse_run_dir "$@"
|
||||
ALL_RUN_ROOT=$SCENARIO_RUN_DIR
|
||||
for SCENARIO_ITEM in research-shelf flex-reference grid-reference; do
|
||||
for SCENARIO_ITEM in task-workbench research-shelf flex-reference grid-reference; do
|
||||
"$0" "$SCENARIO_ITEM" --run-dir "$ALL_RUN_ROOT/$SCENARIO_ITEM"
|
||||
done
|
||||
echo "PLAYGROUND-GUI ALL CAPTURED root=$ALL_RUN_ROOT"
|
||||
;;
|
||||
research-shelf|flex-reference|grid-reference)
|
||||
task-workbench|research-shelf|flex-reference|grid-reference)
|
||||
SCENARIO_NAME=$COMMAND
|
||||
parse_run_dir "$@"
|
||||
run_scenario
|
||||
|
||||
582
scripts/task-workbench-gui-scenarios.el
Normal file
582
scripts/task-workbench-gui-scenarios.el
Normal file
@ -0,0 +1,582 @@
|
||||
;;; task-workbench-gui-scenarios.el --- Workbench GUI acceptance -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; A concrete adapter for the existing temporal GUI verifier. Keyboard
|
||||
;; actions traverse TAB and RET bindings; mouse actions use actual displayed
|
||||
;; positions; text entry goes through the real minibuffer. The caller connects
|
||||
;; to the existing GUI server and owns recording, screenshots, and visual review.
|
||||
;; This adapter records observations; it does not certify visual quality or
|
||||
;; turn action timings (which include user input) into performance benchmarks.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'playground-gui-scenarios)
|
||||
(require 'task-workbench
|
||||
(expand-file-name "../examples/task-workbench.el"
|
||||
(file-name-directory
|
||||
(or load-file-name
|
||||
(bound-and-true-p byte-compile-current-file)
|
||||
buffer-file-name))))
|
||||
|
||||
(defconst wb-gui--primary-name "*ETAF GUI Task Workbench*"
|
||||
"Dedicated primary buffer used throughout one Workbench verification run.")
|
||||
(defconst wb-gui--secondary-name "*ETAF GUI Independent Workbench*"
|
||||
"Dedicated buffer used to verify independent App state.")
|
||||
(defvar wb-gui--prepared-buffer nil
|
||||
"Fresh unmounted target prepared before the screen recorder starts.")
|
||||
|
||||
(defun wb-gui--configure-native ()
|
||||
"Preserve the current backend, or verify an explicitly requested module."
|
||||
(let* ((configured (getenv "EBOX_NATIVE_REFLOW_MODULE_PATH"))
|
||||
(path
|
||||
(when configured
|
||||
(when (string-empty-p configured)
|
||||
(error "EBOX_NATIVE_REFLOW_MODULE_PATH must not be empty"))
|
||||
(expand-file-name configured))))
|
||||
(when (and path (not (file-readable-p path)))
|
||||
(error "Prepared Ebox native module path is unreadable: %s" path))
|
||||
(when path
|
||||
(setq ebox-native-reflow-module-path path))
|
||||
(let* ((report (ebox-native-reflow-runtime-report))
|
||||
(loaded (plist-get report :loaded-module-path)))
|
||||
(when (and path (not (plist-get report :layout-ready-p)))
|
||||
(error "Ebox native module is unavailable at %s: %S"
|
||||
path (plist-get report :load-error)))
|
||||
(when (and path
|
||||
(not (and loaded
|
||||
(file-equal-p
|
||||
(if (file-directory-p path)
|
||||
(file-name-directory loaded) loaded)
|
||||
path))))
|
||||
(error "Loaded Ebox module differs from configured path: %s / %s"
|
||||
loaded path))
|
||||
(when loaded
|
||||
(message "Workbench GUI native module: %s (SHA256 %s)"
|
||||
loaded (plist-get report :loaded-module-hash)))
|
||||
report)))
|
||||
|
||||
(defun wb-gui--redisplay-for-geometry ()
|
||||
"Clear this adapter's native diagnostic and paint before measuring geometry."
|
||||
(when-let* ((diagnostic (current-message))
|
||||
((string-prefix-p "Workbench GUI native module: " diagnostic)))
|
||||
(message nil))
|
||||
(redisplay t))
|
||||
|
||||
;;;###autoload
|
||||
(defun task-workbench-gui-prepare (&optional foreground)
|
||||
"Prepare a fresh target in the existing frame before recording starts.
|
||||
Preserve application focus unless FOREGROUND is explicitly non-nil."
|
||||
(unless (display-graphic-p) (error "Workbench acceptance needs GUI Emacs"))
|
||||
(when (or (get-buffer wb-gui--primary-name)
|
||||
(get-buffer wb-gui--secondary-name))
|
||||
(error "Workbench verification requires fresh dedicated buffers"))
|
||||
(wb-gui--configure-native)
|
||||
(setq wb-gui--prepared-buffer (get-buffer-create wb-gui--primary-name))
|
||||
(with-current-buffer wb-gui--prepared-buffer
|
||||
(insert "任务工作台\n")
|
||||
(goto-char (point-min)))
|
||||
(switch-to-buffer wb-gui--prepared-buffer)
|
||||
(delete-other-windows)
|
||||
(when foreground (select-frame-set-input-focus (selected-frame)))
|
||||
(wb-gui--redisplay-for-geometry)
|
||||
wb-gui--prepared-buffer)
|
||||
|
||||
(defun wb-gui--runtime (context)
|
||||
"Return the Runtime mounted in CONTEXT's target buffer."
|
||||
(etaf-runtime-for-buffer (etaf-gui-verifier-context-target-buffer context)))
|
||||
|
||||
(defun wb-gui--data (context)
|
||||
"Inspect CONTEXT's app-owned Data controller for result assertions."
|
||||
(let ((instance
|
||||
(cl-find-if
|
||||
(lambda (instance)
|
||||
(eq 'wb-app (etaf--component-spec-name
|
||||
(etaf--component-instance-spec instance))))
|
||||
(hash-table-values (etaf-runtime-instances (wb-gui--runtime context))))))
|
||||
(plist-get (etaf--component-instance-state instance) :data)))
|
||||
|
||||
(defun wb-gui--ids (context)
|
||||
"Return the currently loaded task identities in CONTEXT."
|
||||
(mapcar #'wb-task-id (etaf-value (etaf-data-items (wb-gui--data context)))))
|
||||
|
||||
(defun wb-gui--selected-id (context)
|
||||
"Return CONTEXT's selected task identity, or nil."
|
||||
(when-let* ((item (etaf-data-selected-item (wb-gui--data context))))
|
||||
(wb-task-id item)))
|
||||
|
||||
(defun wb-gui--text-p (context text)
|
||||
"Return non-nil when CONTEXT's rendered output contains TEXT."
|
||||
(string-match-p (regexp-quote text)
|
||||
(etaf-playground-gui-scenarios--buffer-text context)))
|
||||
|
||||
(defun wb-gui--control (context label &optional row-id)
|
||||
"Find CONTEXT control by aria LABEL, optionally within ROW-ID."
|
||||
(let* ((runtime (wb-gui--runtime context))
|
||||
(entries (etaf-runtime-host-props-entries runtime))
|
||||
(row (and row-id
|
||||
(cl-find-if
|
||||
(lambda (entry)
|
||||
(and (equal (plist-get (cdr entry) :key) row-id)
|
||||
(member "etaf-table-row"
|
||||
(split-string
|
||||
(or (plist-get (cdr entry) :class) "")))))
|
||||
entries)))
|
||||
(matches (cl-remove-if-not
|
||||
(lambda (entry)
|
||||
(equal label (plist-get (cdr entry) :aria-label))) entries)))
|
||||
(when row-id
|
||||
(unless row (error "No task row %S" row-id))
|
||||
(let* ((ancestries (etaf-runtime-host-ancestries
|
||||
runtime (cons (car row) (mapcar #'car matches))))
|
||||
(parent (car (gethash (car row) ancestries))))
|
||||
(setq matches
|
||||
(cl-remove-if-not
|
||||
(lambda (entry) (memq parent (gethash (car entry) ancestries)))
|
||||
matches))))
|
||||
(unless (= (length matches) 1)
|
||||
(error "Expected one control %S in row %S, got %d"
|
||||
label row-id (length matches)))
|
||||
(caar matches)))
|
||||
|
||||
(defun wb-gui--layout-snapshot (context)
|
||||
"Observe painted control pixels and semantic row bounds in CONTEXT.
|
||||
The viewport and font are part of the comparison; character offsets alone
|
||||
cannot establish that Emacs painted a control on the same visual line."
|
||||
(let* ((runtime (wb-gui--runtime context))
|
||||
(window (selected-window))
|
||||
(frame (window-frame window))
|
||||
(entries (etaf-runtime-host-props-entries runtime))
|
||||
(targets
|
||||
(append
|
||||
(list (cons "title" (wb-gui--find-text "任务工作台")))
|
||||
(mapcar
|
||||
(lambda (target)
|
||||
(cons (format "%s%s" (car target) (or (cadr target) ""))
|
||||
(etaf-host-ref-position
|
||||
runtime (wb-gui--control context (car target) (cadr target)))))
|
||||
(append
|
||||
(mapcar #'list '("新增任务" "深色" "定位新增按钮" "全部" "未完成"
|
||||
"已完成" "搜索" "每页条数 10 ✎" "显示说明"
|
||||
"刷新 / 重试" "模拟失败"))
|
||||
(mapcar (lambda (id) (list "完成" id)) (number-sequence 1 10)))))))
|
||||
(unless (and (display-graphic-p frame)
|
||||
(eq (window-buffer window) (etaf-runtime-buffer runtime)))
|
||||
(error "Pixel geometry requires the displayed Workbench GUI target"))
|
||||
(list
|
||||
:viewport (list (window-inside-pixel-edges window)
|
||||
(window-start window) (window-hscroll window))
|
||||
:font (list (format "%s" (frame-parameter frame 'font))
|
||||
(frame-char-width frame) (frame-char-height frame))
|
||||
:controls
|
||||
(mapcar
|
||||
(lambda (target)
|
||||
(let* ((position (cdr target))
|
||||
(displayed (and position (pos-visible-in-window-p position window)))
|
||||
(posn (and displayed (posn-at-point position window)))
|
||||
(xy (and posn (posn-x-y posn))))
|
||||
(unless (and (numberp (car xy)) (numberp (cdr xy)))
|
||||
(error "Theme geometry target is not visibly painted: %s" (car target)))
|
||||
(list (car target) (car xy) (cdr xy))))
|
||||
targets)
|
||||
:rows
|
||||
(mapcar
|
||||
(lambda (identity)
|
||||
(let* ((entry
|
||||
(cl-find-if
|
||||
(lambda (entry)
|
||||
(and (equal identity (plist-get (cdr entry) :key))
|
||||
(member "etaf-table-row"
|
||||
(split-string (or (plist-get (cdr entry) :class) "")))))
|
||||
entries))
|
||||
(bounds (and entry (etaf-host-ref-bounds runtime (car entry)))))
|
||||
(unless bounds (error "Theme geometry row has no live bounds: %s" identity))
|
||||
(list identity (car bounds) (cdr bounds))))
|
||||
(number-sequence 1 10)))))
|
||||
|
||||
(defun wb-gui--capture-theme-baseline (context)
|
||||
"Capture CONTEXT's initial geometry once it survives another paint turn."
|
||||
(when (etaf-gui-verifier-context-get context 'light-layout)
|
||||
(error "Initial theme geometry must only be captured once"))
|
||||
(wb-gui--redisplay-for-geometry)
|
||||
(let ((previous (wb-gui--layout-snapshot context))
|
||||
(deadline (+ (float-time) 5.0))
|
||||
stable)
|
||||
(while (not stable)
|
||||
(when (>= (float-time) deadline)
|
||||
(error "Initial Workbench geometry did not settle before theme input"))
|
||||
(sit-for 0.05)
|
||||
(redisplay t)
|
||||
(let ((current (wb-gui--layout-snapshot context)))
|
||||
(setq stable (equal previous current)
|
||||
previous current)))
|
||||
(etaf-gui-verifier-context-put context 'light-layout previous)))
|
||||
|
||||
(defun wb-gui--theme-layout-preserved-p (context)
|
||||
"Compare CONTEXT's current painted geometry with its settled light theme."
|
||||
(let ((current (wb-gui--layout-snapshot context)))
|
||||
(etaf-gui-verifier-context-put context 'theme-layout-current current)
|
||||
(equal (etaf-gui-verifier-context-get context 'light-layout) current)))
|
||||
|
||||
(defun wb-gui--root-background-p (context color)
|
||||
"Check that CONTEXT's painted root uses COLOR in its buffer face remap."
|
||||
(with-current-buffer (etaf-gui-verifier-context-target-buffer context)
|
||||
(let* ((face (get-text-property (point-min) 'face))
|
||||
(mapping (and (symbolp face) (assq face face-remapping-alist))))
|
||||
(and mapping
|
||||
(cl-some (lambda (attrs)
|
||||
(and (listp attrs)
|
||||
(equal color (plist-get attrs :background))))
|
||||
(cdr mapping))))))
|
||||
|
||||
(defun wb-gui--tab-to (context ref)
|
||||
"Reach REF in CONTEXT by executing actual TAB key bindings."
|
||||
(let* ((runtime (wb-gui--runtime context))
|
||||
(limit (1+ (length (etaf-runtime-host-props-entries runtime))))
|
||||
(at-target
|
||||
(lambda ()
|
||||
(and (equal ref (etaf-focused-host-ref runtime))
|
||||
(equal (point) (etaf-host-ref-position runtime ref))))))
|
||||
(unless (eq (current-buffer) (etaf-runtime-buffer runtime))
|
||||
(error "Keyboard input target drifted from the Workbench buffer"))
|
||||
(while (and (> limit 0) (not (funcall at-target)))
|
||||
(execute-kbd-macro (kbd "TAB"))
|
||||
(cl-decf limit))
|
||||
(unless (funcall at-target)
|
||||
(error "TAB cannot reach the expected control"))))
|
||||
|
||||
(defun wb-gui--press (context label &optional row-id)
|
||||
"Use TAB and RET to activate LABEL within CONTEXT's optional ROW-ID."
|
||||
(wb-gui--tab-to context (wb-gui--control context label row-id))
|
||||
(execute-kbd-macro (kbd "RET")))
|
||||
|
||||
(defun wb-gui--visit-next-page (context)
|
||||
"Advance CONTEXT one page and retain the complete visited task sequence."
|
||||
(let ((visited (etaf-gui-verifier-context-get
|
||||
context 'visited-task-ids (wb-gui--ids context))))
|
||||
(wb-gui--press context "Next page")
|
||||
(setq visited (append visited (wb-gui--ids context)))
|
||||
(etaf-gui-verifier-context-put context 'visited-task-ids visited)
|
||||
(etaf-gui-verifier-context-put context 'visited-tasks (length visited))))
|
||||
|
||||
(defun wb-gui--enter (context label text)
|
||||
"Activate LABEL and type TEXT through the actual minibuffer in CONTEXT."
|
||||
(let (received)
|
||||
(let ((minibuffer-exit-hook
|
||||
(cons (lambda ()
|
||||
(setq received (minibuffer-contents-no-properties)))
|
||||
minibuffer-exit-hook)))
|
||||
(minibuffer-with-setup-hook
|
||||
(lambda ()
|
||||
;; The recursive input loop starts after setup hooks return.
|
||||
;; Queue real input events; RET during setup has no exit target.
|
||||
(setq unread-command-events
|
||||
(append (listify-key-sequence (vconcat text (kbd "RET")))
|
||||
unread-command-events)))
|
||||
(wb-gui--press context label)))
|
||||
(unless (equal received text)
|
||||
(error "Minibuffer did not receive the expected keyboard input"))))
|
||||
|
||||
(defun wb-gui--mouse-at (position)
|
||||
"Click the actual visible buffer POSITION using its displayed event data."
|
||||
(redisplay t)
|
||||
(let ((position-data (posn-at-point position (selected-window))))
|
||||
(unless (and position-data (pos-visible-in-window-p position))
|
||||
(error "Mouse target is not currently displayed: %S" position))
|
||||
(execute-kbd-macro (vector (list 'mouse-1 position-data)))))
|
||||
|
||||
(defun wb-gui--click (context label &optional row-id)
|
||||
"Click LABEL at its rendered position within CONTEXT's optional ROW-ID."
|
||||
(let* ((runtime (wb-gui--runtime context))
|
||||
(ref (wb-gui--control context label row-id))
|
||||
(position (etaf-host-ref-position runtime ref)))
|
||||
(unless position (error "Control %S has no live bounds" label))
|
||||
(wb-gui--mouse-at position)))
|
||||
|
||||
(defun wb-gui--find-text (text)
|
||||
"Return a buffer position inside visible TEXT or signal a missing target."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(unless (search-forward text nil t)
|
||||
(error "Rendered text target is absent: %S" text))
|
||||
(- (point) (length text))))
|
||||
|
||||
(defun wb-gui--action (id execute predicate)
|
||||
"Create action ID with EXECUTE and a persistent product PREDICATE."
|
||||
(etaf-gui-verifier-action-create
|
||||
:id id :execute execute :screenshot t
|
||||
:settled-p
|
||||
(lambda (context)
|
||||
(and (etaf-playground-gui-scenarios--mounted-settled-p context)
|
||||
(funcall predicate context)))
|
||||
:assertions
|
||||
(lambda (context)
|
||||
(list (etaf-gui-verifier-assert id (funcall predicate context))))))
|
||||
|
||||
(defun wb-gui--adapter (context)
|
||||
"Return primitive evidence for CONTEXT without copying private task text."
|
||||
(append
|
||||
(etaf-playground-gui-scenarios--adapter context)
|
||||
(let ((native (ebox-native-reflow-runtime-report)))
|
||||
(list (cons 'native_layout_ready (and (plist-get native :layout-ready-p) t))
|
||||
(cons 'native_module_path (or (plist-get native :loaded-module-path) ""))
|
||||
(cons 'native_module_hash (or (plist-get native :loaded-module-hash) ""))))
|
||||
(mapcar
|
||||
(lambda (entry)
|
||||
(cons (car entry)
|
||||
(vconcat
|
||||
(mapcar #'vconcat
|
||||
(plist-get (etaf-gui-verifier-context-get context (cdr entry))
|
||||
:controls)))))
|
||||
'((theme_pixels_before . light-layout)
|
||||
(theme_pixels_after . theme-layout-current)))
|
||||
(when (wb-gui--runtime context)
|
||||
(let ((data (wb-gui--data context)))
|
||||
(list (cons 'total (etaf-value (etaf-data-total data)))
|
||||
(cons 'page (etaf-value (etaf-data-page data)))
|
||||
(cons 'page_size (etaf-value (etaf-data-page-size data)))
|
||||
(cons 'visited_tasks
|
||||
(etaf-gui-verifier-context-get context 'visited-tasks 0))
|
||||
(cons 'visible_rows (length (wb-gui--ids context)))
|
||||
(cons 'selected_task (or (wb-gui--selected-id context) 0)))))))
|
||||
|
||||
(defun wb-gui--nested-scroll (context)
|
||||
"Scroll CONTEXT's help box and retain both inner and outer observations."
|
||||
(goto-char (wb-gui--find-text "点击行：选择任务"))
|
||||
(let* ((regions (cl-remove-if-not #'ebox-scroll-state
|
||||
(ebox--scroll-region-ids-at-point)))
|
||||
(inner (car regions)))
|
||||
(unless inner (error "Help text has no active scroll container"))
|
||||
(etaf-gui-verifier-context-put context 'inner-region inner)
|
||||
(etaf-gui-verifier-context-put
|
||||
context 'inner-offset (plist-get (ebox-scroll-state inner) :scroll-offset))
|
||||
(etaf-gui-verifier-context-put
|
||||
context 'outer-offsets
|
||||
(mapcar (lambda (id) (cons id (plist-get (ebox-scroll-state id) :scroll-offset)))
|
||||
(cdr regions)))
|
||||
(etaf-gui-verifier-context-put context 'outer-window-start (window-start))
|
||||
(ebox-scroll-down 1)))
|
||||
|
||||
(defun wb-gui--nested-scrolled-p (context)
|
||||
"Return non-nil when CONTEXT's inner help scrolled without its parent."
|
||||
(let ((inner (ebox-scroll-state
|
||||
(etaf-gui-verifier-context-get context 'inner-region))))
|
||||
(and (> (plist-get inner :scroll-offset)
|
||||
(etaf-gui-verifier-context-get context 'inner-offset))
|
||||
(= (window-start)
|
||||
(etaf-gui-verifier-context-get context 'outer-window-start))
|
||||
(cl-every
|
||||
(lambda (entry)
|
||||
(equal (cdr entry) (plist-get (ebox-scroll-state (car entry))
|
||||
:scroll-offset)))
|
||||
(etaf-gui-verifier-context-get context 'outer-offsets)))))
|
||||
|
||||
(defun wb-gui--reset-outer-scroll (_context)
|
||||
"Reset the outer Ebox viewport and its containing Emacs window."
|
||||
(goto-char (point-min))
|
||||
(condition-case nil (ebox-scroll-up 10000) (beginning-of-buffer nil))
|
||||
(goto-char (point-min))
|
||||
(set-window-start (selected-window) (point-min)))
|
||||
|
||||
(defun wb-gui--outer-reset-p (_context)
|
||||
"Return non-nil when both the outer Ebox viewport and window are at top."
|
||||
(and (= (window-start) (point-min))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(cl-every
|
||||
(lambda (id)
|
||||
(zerop (or (plist-get (ebox-scroll-state id) :scroll-offset) 0)))
|
||||
(ebox--scroll-region-ids-at-point)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun task-workbench-gui-scenario ()
|
||||
"Return the complete Workbench temporal GUI acceptance scenario."
|
||||
(let ((primary wb-gui--primary-name)
|
||||
(secondary wb-gui--secondary-name))
|
||||
(etaf-gui-verifier-scenario-create
|
||||
:name "task-workbench"
|
||||
:claim "Workbench layout and public input, CRUD, resources, and isolated lifecycle"
|
||||
:initialize
|
||||
(lambda (context)
|
||||
(unless (display-graphic-p) (error "Workbench acceptance needs GUI Emacs"))
|
||||
(let ((buffer (get-buffer primary)))
|
||||
(unless (and (buffer-live-p buffer)
|
||||
(eq buffer wb-gui--prepared-buffer)
|
||||
(not (etaf-runtime-for-buffer buffer))
|
||||
(not (get-buffer secondary)))
|
||||
(error "Workbench target is not the fresh prepared unmounted buffer"))
|
||||
(etaf-gui-verifier-context-select-buffer context buffer)
|
||||
(setq wb-gui--prepared-buffer nil)))
|
||||
:invariants
|
||||
(lambda (context)
|
||||
(etaf-playground-gui-scenarios--invariants context nil))
|
||||
:adapter #'wb-gui--adapter
|
||||
:actions
|
||||
(append
|
||||
(list
|
||||
(wb-gui--action
|
||||
"mount"
|
||||
(lambda (context)
|
||||
(etaf-gui-verifier-context-put
|
||||
context 'target-fullscreen (frame-parameter nil 'fullscreen))
|
||||
(wb-open primary)
|
||||
(etaf-gui-verifier-context-select-buffer context (get-buffer primary))
|
||||
(etaf-gui-verifier-context-put context 'expects-mounted t))
|
||||
(lambda (context)
|
||||
(and (equal (wb-gui--ids context) (number-sequence 1 10))
|
||||
(wb-gui--text-p context "共 100 条 · 当前页 10 条")
|
||||
(wb-gui--text-p context "服务正常"))))
|
||||
(wb-gui--action
|
||||
"keyboard-theme"
|
||||
(lambda (context)
|
||||
(wb-gui--capture-theme-baseline context)
|
||||
(wb-gui--press context "深色"))
|
||||
(lambda (context)
|
||||
(and (wb-gui--theme-layout-preserved-p context)
|
||||
(wb-gui--root-background-p context "#111827"))))
|
||||
(wb-gui--action
|
||||
"keyboard-focus-add"
|
||||
(lambda (context) (wb-gui--press context "定位新增按钮"))
|
||||
(lambda (context)
|
||||
(equal (etaf-focused-host-ref (wb-gui--runtime context))
|
||||
(wb-gui--control context "新增任务"))))
|
||||
(wb-gui--action
|
||||
"minibuffer-add"
|
||||
(lambda (context) (wb-gui--enter context "新增任务" "GUI 验收任务"))
|
||||
(lambda (context)
|
||||
(= (etaf-value (etaf-data-total (wb-gui--data context))) 101))))
|
||||
(cl-loop for page from 2 to 11
|
||||
collect
|
||||
(let ((target page))
|
||||
(wb-gui--action
|
||||
(format "page-next-%d" target) #'wb-gui--visit-next-page
|
||||
(lambda (c)
|
||||
(and (equal (wb-gui--ids c)
|
||||
(number-sequence (1+ (* 10 (1- target)))
|
||||
(min 101 (* 10 target))))
|
||||
(equal (etaf-gui-verifier-context-get c 'visited-task-ids)
|
||||
(number-sequence 1 (min 101 (* 10 target))))
|
||||
(or (< target 11)
|
||||
(and (wb-gui--text-p c "GUI 验收任务")
|
||||
(plist-get
|
||||
(etaf-runtime-host-props-for
|
||||
(wb-gui--runtime c) (wb-gui--control c "Next page"))
|
||||
:disabled))))))))
|
||||
(cl-loop for page from 10 downto 1
|
||||
collect
|
||||
(let ((target page))
|
||||
(wb-gui--action
|
||||
(format "page-previous-%d" target)
|
||||
(lambda (c) (wb-gui--press c "Previous page"))
|
||||
(lambda (c)
|
||||
(equal (wb-gui--ids c)
|
||||
(number-sequence (1+ (* 10 (1- target))) (* 10 target)))))))
|
||||
(list
|
||||
(wb-gui--action "disabled-cell-mouse" (lambda (c) (wb-gui--click c "删除" 1))
|
||||
(lambda (c) (and (not (wb-gui--selected-id c))
|
||||
(equal (wb-gui--ids c) (number-sequence 1 10)))))
|
||||
(wb-gui--action
|
||||
"row-mouse-select"
|
||||
(lambda (_context) (wb-gui--mouse-at (wb-gui--find-text "设计组件接口")))
|
||||
(lambda (c) (and (equal (wb-gui--selected-id c) 1)
|
||||
(wb-gui--text-p c "进行中"))))
|
||||
(wb-gui--action
|
||||
"cell-mouse-toggle" (lambda (c) (wb-gui--click c "完成" 1))
|
||||
(lambda (c) (and (plist-get (etaf-data-selected-item (wb-gui--data c)) :done)
|
||||
(equal (wb-gui--selected-id c) 1))))
|
||||
(wb-gui--action "cell-mouse-delete" (lambda (c) (wb-gui--click c "删除" 1))
|
||||
(lambda (c) (and (equal (wb-gui--ids c) (number-sequence 2 11))
|
||||
(= (etaf-value (etaf-data-total
|
||||
(wb-gui--data c))) 100)
|
||||
(not (wb-gui--selected-id c)))))
|
||||
(wb-gui--action "filter-open" (lambda (c) (wb-gui--press c "未完成"))
|
||||
(lambda (c)
|
||||
(and (equal (wb-gui--ids c) '(2 4 6 7 9 10 11 13 14 15))
|
||||
(= (etaf-value (etaf-data-total (wb-gui--data c))) 74))))
|
||||
(wb-gui--action "filter-done" (lambda (c) (wb-gui--press c "已完成"))
|
||||
(lambda (c)
|
||||
(and (equal (wb-gui--ids c) '(3 5 8 12 16 20 24 28 32 36))
|
||||
(= (etaf-value (etaf-data-total (wb-gui--data c))) 26))))
|
||||
(wb-gui--action "minibuffer-search"
|
||||
(lambda (c) (wb-gui--enter c "搜索" "键盘"))
|
||||
(lambda (c) (equal (wb-gui--ids c) '(4))))
|
||||
(wb-gui--action "filter-all" (lambda (c) (wb-gui--press c "全部"))
|
||||
(lambda (c) (equal (wb-gui--ids c) (number-sequence 2 11))))
|
||||
(wb-gui--action "minibuffer-page-size"
|
||||
(lambda (c) (wb-gui--enter c "每页条数 10 ✎" "2"))
|
||||
(lambda (c) (and (equal (wb-gui--ids c) '(2 3))
|
||||
(wb-gui--text-p c "Page 1 / 50"))))
|
||||
(wb-gui--action "hide-help" (lambda (c) (wb-gui--press c "显示说明"))
|
||||
(lambda (c) (not (wb-gui--text-p c "点击行：选择任务"))))
|
||||
(wb-gui--action "show-help" (lambda (c) (wb-gui--press c "显示说明"))
|
||||
(lambda (c) (wb-gui--text-p c "点击行：选择任务")))
|
||||
(wb-gui--action "resource-failure" (lambda (c) (wb-gui--press c "模拟失败"))
|
||||
(lambda (c) (wb-gui--text-p c "模拟加载失败")))
|
||||
(wb-gui--action "resource-retry" (lambda (c) (wb-gui--press c "刷新 / 重试"))
|
||||
(lambda (c) (and (wb-gui--text-p c "服务正常")
|
||||
(not (wb-gui--text-p c "模拟加载失败")))))
|
||||
(wb-gui--action "nested-scroll" #'wb-gui--nested-scroll
|
||||
#'wb-gui--nested-scrolled-p)
|
||||
(etaf-playground-gui-scenarios--windowed-action)
|
||||
(etaf-playground-gui-scenarios--resize-action "resize-compact" 700 500)
|
||||
(etaf-playground-gui-scenarios--scroll-action "outer-scroll" #'ebox-scroll-page-down)
|
||||
(wb-gui--action "reset-scroll" #'wb-gui--reset-outer-scroll
|
||||
#'wb-gui--outer-reset-p)
|
||||
(etaf-playground-gui-scenarios--resize-action "resize-wide" 1300 750)
|
||||
(wb-gui--action
|
||||
"second-independent-app"
|
||||
(lambda (context)
|
||||
(etaf-gui-verifier-context-put context 'primary-data (wb-gui--data context))
|
||||
(wb-open secondary)
|
||||
(etaf-gui-verifier-context-select-buffer context (get-buffer secondary)))
|
||||
(lambda (c)
|
||||
(and (equal (wb-gui--ids c) (number-sequence 1 10))
|
||||
(= (etaf-value (etaf-data-total (wb-gui--data c))) 100)
|
||||
(not (eq (wb-gui--data c)
|
||||
(etaf-gui-verifier-context-get c 'primary-data))))))
|
||||
(wb-gui--action
|
||||
"close-second-app"
|
||||
(lambda (context)
|
||||
(wb-close secondary)
|
||||
(etaf-gui-verifier-context-select-buffer context (get-buffer primary)))
|
||||
(lambda (c) (and (not (get-buffer secondary))
|
||||
(equal (wb-gui--ids c) '(2 3)))))
|
||||
(wb-gui--action
|
||||
"unmount-remount"
|
||||
(lambda (context)
|
||||
(let ((old (wb-gui--runtime context)))
|
||||
(etaf-gui-verifier-context-put context 'retired-runtime old)
|
||||
(etaf-unmount old)
|
||||
(wb-open primary)
|
||||
(etaf-gui-verifier-context-select-buffer context (get-buffer primary))))
|
||||
(lambda (c)
|
||||
(and (not (etaf-runtime-mounted-p
|
||||
(etaf-gui-verifier-context-get c 'retired-runtime)))
|
||||
(equal (wb-gui--ids c) (number-sequence 1 10))
|
||||
(= (etaf-value (etaf-data-total (wb-gui--data c))) 100))))))
|
||||
:completion
|
||||
(lambda (context)
|
||||
(and (= (etaf-gui-verifier-context-action-count context)
|
||||
(length (etaf-gui-verifier-scenario-actions
|
||||
(etaf-gui-verifier-context-scenario context))))
|
||||
(not (get-buffer secondary))
|
||||
(= (etaf-gui-verifier-context-get context 'visited-tasks 0) 101)
|
||||
(equal (wb-gui--ids context) (number-sequence 1 10)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun task-workbench-gui-run (run-directory)
|
||||
"Run Workbench GUI acceptance into prepared RUN-DIRECTORY."
|
||||
(unless (buffer-live-p wb-gui--prepared-buffer)
|
||||
(task-workbench-gui-prepare))
|
||||
(etaf-gui-verifier-run (task-workbench-gui-scenario) run-directory))
|
||||
|
||||
;;;###autoload
|
||||
(defun task-workbench-gui-run-from-environment ()
|
||||
"Run Workbench acceptance in the generic runner's evidence directory."
|
||||
(task-workbench-gui-run
|
||||
(or (getenv "ETAF_GUI_RUN_DIR")
|
||||
(error "ETAF_GUI_RUN_DIR is not configured"))))
|
||||
|
||||
(provide 'task-workbench-gui-scenarios)
|
||||
;;; task-workbench-gui-scenarios.el ends here
|
||||
@ -88,5 +88,161 @@
|
||||
(when (file-exists-p database)
|
||||
(delete-file database)))))
|
||||
|
||||
(ert-deftest etaf-playground-gui-viewport-noop-keeps-revision-contract ()
|
||||
"Unchanged geometry needs no new revision; an actual resize still does."
|
||||
(let ((context (etaf-gui-verifier--context-create)))
|
||||
(cl-letf (((symbol-function 'etaf-playground-gui-scenarios--report)
|
||||
(lambda (_context) '(:runtime-revision 7)))
|
||||
((symbol-function 'ebox-surface-buffer-revision) (lambda (_) 7))
|
||||
((symbol-function 'frame-parameter) (lambda (&rest _) nil))
|
||||
((symbol-function 'frame-text-width) (lambda (&rest _) 1000))
|
||||
((symbol-function 'frame-text-height) (lambda (&rest _) 700)))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context nil)
|
||||
(should-not (etaf-gui-verifier-context-get context 'viewport-revision-before))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context nil 1000 700)
|
||||
(should-not (etaf-gui-verifier-context-get context 'viewport-revision-before))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context nil 700 500)
|
||||
(should (= (etaf-gui-verifier-context-get context 'viewport-revision-before) 7))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context 'fullboth)
|
||||
(should (= (etaf-gui-verifier-context-get context 'viewport-revision-before) 7)))))
|
||||
|
||||
(ert-deftest etaf-playground-gui-viewport-noop-settles-after-scroll-report ()
|
||||
"A no-op proves unchanged geometry and revision without a viewport report."
|
||||
(with-temp-buffer
|
||||
(let ((context (etaf-gui-verifier--context-create
|
||||
:target-buffer (current-buffer)))
|
||||
(window (selected-window)) (revision 7)
|
||||
(width 1000) (height 40) (frame-width 1000) (frame-height 700))
|
||||
(cl-letf (((symbol-function 'etaf-playground-gui-scenarios--report)
|
||||
(lambda (_) '(:constraint-source scroll :runtime-revision 6)))
|
||||
((symbol-function 'ebox-surface-buffer-mounted-p) (lambda (_) t))
|
||||
((symbol-function 'ebox-surface-buffer-revision) (lambda (_) revision))
|
||||
((symbol-function 'selected-window) (lambda () window))
|
||||
((symbol-function 'ebox-viewport-window-width) (lambda (_) width))
|
||||
((symbol-function 'window-body-height) (lambda (&rest _) height))
|
||||
((symbol-function 'frame-parameter) (lambda (&rest _) nil))
|
||||
((symbol-function 'frame-text-width) (lambda (&rest _) frame-width))
|
||||
((symbol-function 'frame-text-height) (lambda (&rest _) frame-height))
|
||||
((symbol-function 'etaf-playground-gui-scenarios--visible-window-content-p)
|
||||
(lambda (_) t)))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context nil)
|
||||
(should (etaf-playground-gui-scenarios--viewport-settled-p context))
|
||||
(let ((assertions (etaf-playground-gui-scenarios--resize-assertions context)))
|
||||
(should (equal "viewport-unchanged" (alist-get 'name (car assertions))))
|
||||
(should (cl-every (lambda (entry) (alist-get 'passed entry)) assertions)))
|
||||
(dolist (change (list (lambda () (setq window 'different-window))
|
||||
(lambda () (cl-incf width))
|
||||
(lambda () (cl-incf height))
|
||||
(lambda () (cl-incf frame-width))
|
||||
(lambda () (cl-incf frame-height))
|
||||
(lambda () (cl-incf revision))))
|
||||
(let ((original-window window))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(funcall change)
|
||||
(should-not (etaf-playground-gui-scenarios--viewport-settled-p context)))
|
||||
(setq window original-window width 1000 height 40
|
||||
frame-width 1000 frame-height 700 revision 7)))
|
||||
(should (etaf-playground-gui-scenarios--viewport-settled-p context)))))))
|
||||
|
||||
(ert-deftest etaf-playground-gui-real-resize-requires-matching-publication ()
|
||||
"An actual resize cannot reuse a stale, absent, or mismatched report."
|
||||
(with-temp-buffer
|
||||
(let ((context (etaf-gui-verifier--context-create
|
||||
:target-buffer (current-buffer)))
|
||||
(frame-width 1000)
|
||||
(revision 37)
|
||||
(report '(:runtime-revision 36 :surface-revision 37)))
|
||||
(cl-letf (((symbol-function 'etaf-playground-gui-scenarios--report)
|
||||
(lambda (_) report))
|
||||
((symbol-function 'ebox-surface-buffer-mounted-p) (lambda (_) t))
|
||||
((symbol-function 'ebox-surface-buffer-revision) (lambda (_) revision))
|
||||
((symbol-function 'frame-parameter) (lambda (&rest _) nil))
|
||||
((symbol-function 'frame-text-width) (lambda (&rest _) frame-width))
|
||||
((symbol-function 'frame-text-height) (lambda (&rest _) 700))
|
||||
((symbol-function 'ebox-viewport-window-width) (lambda (_) 700))
|
||||
((symbol-function 'window-body-height) (lambda (&rest _) 40))
|
||||
((symbol-function 'etaf-playground-gui-scenarios--visible-window-content-p)
|
||||
(lambda (_) t)))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context nil 700 700)
|
||||
(setq frame-width 700 revision 38)
|
||||
(dolist (invalid '((:runtime-revision 37 :surface-revision 38 :runtime-published t)
|
||||
(:runtime-revision 37 :surface-revision 38
|
||||
:runtime-published t :viewport-width 800)
|
||||
(:runtime-revision 37 :surface-revision 38 :viewport-width 700)
|
||||
(:runtime-revision 37 :surface-revision 38 :runtime-published t
|
||||
:viewport-width 700 :tp-scope-fallback t)
|
||||
;; Neither a stale nor a future report belongs to
|
||||
;; the currently committed surface, regardless of
|
||||
;; its unrelated runtime revision or matching width.
|
||||
(:runtime-revision 99 :surface-revision 37
|
||||
:runtime-published t :viewport-width 700)
|
||||
(:runtime-revision 99 :surface-revision 39
|
||||
:runtime-published t :viewport-width 700)
|
||||
(:runtime-revision 99 :runtime-published t :viewport-width 700)))
|
||||
(setq report (append invalid '(:target-viewport-height 40)))
|
||||
(should-not (etaf-playground-gui-scenarios--viewport-settled-p context)))
|
||||
(setq report '(:runtime-revision 37 :surface-revision 38
|
||||
:runtime-published t :target-viewport-width 700
|
||||
:target-viewport-height 40))
|
||||
(should (etaf-playground-gui-scenarios--viewport-settled-p context))
|
||||
(setq revision 39)
|
||||
(should-not (etaf-playground-gui-scenarios--viewport-settled-p context))
|
||||
(should-not
|
||||
(alist-get 'passed
|
||||
(car (etaf-playground-gui-scenarios--resize-assertions context))))))))
|
||||
|
||||
(ert-deftest etaf-playground-gui-resize-compares-surface-revisions-only ()
|
||||
"GUI runtime37/surface38 succeeds against public before37/after38."
|
||||
(with-temp-buffer
|
||||
(let ((context (etaf-gui-verifier--context-create
|
||||
:target-buffer (current-buffer))))
|
||||
(etaf-gui-verifier-context-put context 'viewport-revision-before 37)
|
||||
(cl-letf (((symbol-function 'etaf-playground-gui-scenarios--report)
|
||||
(lambda (_) '(:runtime-revision 37 :surface-revision 38
|
||||
:runtime-published t :target-viewport-width 686
|
||||
:target-viewport-height 40)))
|
||||
((symbol-function 'ebox-surface-buffer-mounted-p) (lambda (_) t))
|
||||
((symbol-function 'ebox-surface-buffer-revision) (lambda (_) 38))
|
||||
((symbol-function 'ebox-viewport-window-width) (lambda (_) 686))
|
||||
((symbol-function 'window-body-height) (lambda (&rest _) 40))
|
||||
((symbol-function 'etaf-playground-gui-scenarios--frame-target-settled-p)
|
||||
(lambda (_) t))
|
||||
((symbol-function 'etaf-playground-gui-scenarios--visible-window-content-p)
|
||||
(lambda (_) t)))
|
||||
(should (etaf-playground-gui-scenarios--viewport-settled-p context))))))
|
||||
|
||||
(ert-deftest etaf-playground-gui-height-only-resize-requires-current-height ()
|
||||
"A 40-to-25-row resize rejects stale, missing, and nonnumeric target heights."
|
||||
(with-temp-buffer
|
||||
(let ((context (etaf-gui-verifier--context-create
|
||||
:target-buffer (current-buffer)))
|
||||
(height 40) (frame-height 700) (revision 37) report)
|
||||
(cl-letf (((symbol-function 'etaf-playground-gui-scenarios--report)
|
||||
(lambda (_) report))
|
||||
((symbol-function 'ebox-surface-buffer-mounted-p) (lambda (_) t))
|
||||
((symbol-function 'ebox-surface-buffer-revision) (lambda (_) revision))
|
||||
((symbol-function 'frame-parameter) (lambda (&rest _) nil))
|
||||
((symbol-function 'frame-text-width) (lambda (&rest _) 1000))
|
||||
((symbol-function 'frame-text-height) (lambda (&rest _) frame-height))
|
||||
((symbol-function 'ebox-viewport-window-width) (lambda (_) 1000))
|
||||
((symbol-function 'window-body-height) (lambda (&rest _) height))
|
||||
((symbol-function 'etaf-playground-gui-scenarios--visible-window-content-p)
|
||||
(lambda (_) t)))
|
||||
(etaf-playground-gui-scenarios--begin-viewport-change context nil 1000 500)
|
||||
(should (= 37 (etaf-gui-verifier-context-get context 'viewport-revision-before)))
|
||||
(should-not (etaf-gui-verifier-context-get context 'viewport-noop-before))
|
||||
(setq height 25 frame-height 500 revision 38
|
||||
report '(:runtime-published t :surface-revision 38
|
||||
:target-viewport-width 1000 :target-viewport-height 25))
|
||||
(should (etaf-playground-gui-scenarios--viewport-settled-p context))
|
||||
(dolist (height-report '((:target-viewport-height 40)
|
||||
nil (:target-viewport-height "25")
|
||||
(:viewport-height 25)))
|
||||
(setq report (append '(:runtime-published t :surface-revision 38
|
||||
:target-viewport-width 1000)
|
||||
height-report))
|
||||
(should-not (etaf-playground-gui-scenarios--viewport-settled-p context)))))))
|
||||
|
||||
(provide 'playground-gui-scenarios-tests)
|
||||
;;; playground-gui-scenarios-tests.el ends here
|
||||
|
||||
113
tests/task-workbench-gui-scenarios-tests.el
Normal file
113
tests/task-workbench-gui-scenarios-tests.el
Normal file
@ -0,0 +1,113 @@
|
||||
;;; task-workbench-gui-scenarios-tests.el --- Workbench measurement order -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Batch tests prove the adapter's message/paint/measurement ordering. Actual
|
||||
;; echo-area resizing and compositor geometry require the existing GUI run.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'ert)
|
||||
(add-to-list 'load-path (expand-file-name "../etaf/scripts" default-directory))
|
||||
(add-to-list 'load-path (expand-file-name "../ebox-playground" default-directory))
|
||||
(require 'task-workbench-gui-scenarios)
|
||||
|
||||
(ert-deftest wb-gui-preparation-preserves-focus-unless-requested ()
|
||||
"Preparation selects the target inside Emacs without activating the app."
|
||||
(let ((wb-gui--primary-name " *wb-gui-focus-fixture*")
|
||||
(wb-gui--secondary-name " *wb-gui-focus-secondary*")
|
||||
(wb-gui--prepared-buffer nil)
|
||||
(activations 0))
|
||||
(save-window-excursion
|
||||
(unwind-protect
|
||||
(cl-letf (((symbol-function 'display-graphic-p) (lambda (&rest _) t))
|
||||
((symbol-function 'wb-gui--configure-native) #'ignore)
|
||||
((symbol-function 'wb-gui--redisplay-for-geometry) #'ignore)
|
||||
((symbol-function 'select-frame-set-input-focus)
|
||||
(lambda (&rest _) (cl-incf activations))))
|
||||
(dolist (foreground '(nil t))
|
||||
(let ((buffer (task-workbench-gui-prepare foreground)))
|
||||
(should (eq buffer (window-buffer (selected-window))))
|
||||
(should (= activations (if foreground 1 0)))
|
||||
(kill-buffer buffer))))
|
||||
(when (buffer-live-p wb-gui--prepared-buffer)
|
||||
(kill-buffer wb-gui--prepared-buffer))))))
|
||||
|
||||
(ert-deftest wb-gui-default-keeps-current-backend ()
|
||||
"An existing GUI without a native module remains a valid acceptance target."
|
||||
(let ((process-environment (copy-sequence process-environment))
|
||||
(ebox-native-reflow-module-path "/existing/module/location"))
|
||||
(setenv "EBOX_NATIVE_REFLOW_MODULE_PATH" nil)
|
||||
(cl-letf (((symbol-function 'ebox-native-reflow-runtime-report)
|
||||
(lambda () '(:layout-ready-p nil :load-error module-not-found))))
|
||||
(should (equal (wb-gui--configure-native)
|
||||
'(:layout-ready-p nil :load-error module-not-found)))
|
||||
(should (equal ebox-native-reflow-module-path "/existing/module/location")))))
|
||||
|
||||
(ert-deftest wb-gui-explicit-native-request-remains-required ()
|
||||
"An explicit native request must not silently fall back or change modules."
|
||||
(let ((process-environment (copy-sequence process-environment))
|
||||
(ebox-native-reflow-module-path nil)
|
||||
(report '(:layout-ready-p nil :load-error module-not-found)))
|
||||
(setenv "EBOX_NATIVE_REFLOW_MODULE_PATH" "/requested/module")
|
||||
(cl-letf (((symbol-function 'file-readable-p) (lambda (_) t))
|
||||
((symbol-function 'file-directory-p) (lambda (_) nil))
|
||||
((symbol-function 'file-equal-p) #'equal)
|
||||
((symbol-function 'ebox-native-reflow-runtime-report)
|
||||
(lambda () report)))
|
||||
(should-error (wb-gui--configure-native))
|
||||
(setq report '(:layout-ready-p t :loaded-module-path "/different/module"))
|
||||
(should-error (wb-gui--configure-native))
|
||||
(setq report '(:layout-ready-p t :loaded-module-path "/requested/module"))
|
||||
(should (equal report (wb-gui--configure-native))))))
|
||||
|
||||
(ert-deftest wb-gui-empty-native-request-is-invalid ()
|
||||
"An empty configured path is an error, rather than the default backend."
|
||||
(let ((process-environment (copy-sequence process-environment)))
|
||||
(setenv "EBOX_NATIVE_REFLOW_MODULE_PATH" "")
|
||||
(should-error (wb-gui--configure-native))))
|
||||
|
||||
(ert-deftest wb-gui-theme-baseline-clears-owned-message-before-paint ()
|
||||
"The first baseline measurement follows clearing and painting our diagnostic."
|
||||
(let ((context (etaf-gui-verifier--context-create))
|
||||
(echo-message (concat "Workbench GUI native module: " (make-string 300 ?x)))
|
||||
(bottom 797)
|
||||
trace)
|
||||
(cl-letf (((symbol-function 'current-message) (lambda () echo-message))
|
||||
((symbol-function 'message)
|
||||
(lambda (format &rest _)
|
||||
(should-not format)
|
||||
(setq echo-message nil)
|
||||
(push 'clear trace)))
|
||||
((symbol-function 'redisplay)
|
||||
(lambda (&rest _)
|
||||
(setq bottom (if echo-message 797 813))
|
||||
(push 'paint trace)))
|
||||
((symbol-function 'sit-for) (lambda (&rest _) (push 'wait trace)))
|
||||
((symbol-function 'wb-gui--layout-snapshot)
|
||||
(lambda (_)
|
||||
(push 'measure trace)
|
||||
(list :viewport (list 0 0 991 bottom) :controls '((title 0 0))))))
|
||||
(wb-gui--capture-theme-baseline context)
|
||||
(should (equal '(clear paint measure wait paint measure) (nreverse trace)))
|
||||
(should (equal '(0 0 991 813)
|
||||
(plist-get (etaf-gui-verifier-context-get context 'light-layout)
|
||||
:viewport)))
|
||||
(should (wb-gui--theme-layout-preserved-p context))
|
||||
;; Later viewport differences remain a failure, even with identical controls.
|
||||
(setq bottom 797)
|
||||
(should-not (wb-gui--theme-layout-preserved-p context)))))
|
||||
|
||||
(ert-deftest wb-gui-geometry-paint-preserves-unowned-messages ()
|
||||
"Geometry preparation clears only this adapter's own diagnostic."
|
||||
(let ((paints 0))
|
||||
(cl-letf (((symbol-function 'current-message) (lambda () "A user message"))
|
||||
((symbol-function 'message)
|
||||
(lambda (&rest _) (ert-fail "Cleared an unrelated message")))
|
||||
((symbol-function 'redisplay) (lambda (&rest _) (cl-incf paints))))
|
||||
(wb-gui--redisplay-for-geometry)
|
||||
(should (= paints 1)))))
|
||||
|
||||
(provide 'task-workbench-gui-scenarios-tests)
|
||||
;;; task-workbench-gui-scenarios-tests.el ends here
|
||||
407
tests/task-workbench-tests.el
Normal file
407
tests/task-workbench-tests.el
Normal file
@ -0,0 +1,407 @@
|
||||
;;; task-workbench-tests.el --- Workbench acceptance preflight -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Exercise the complete example through mounted public event entry points.
|
||||
;; Minibuffer readers are stubbed only in this batch preflight. Real input,
|
||||
;; redisplay, layout, and screenshots belong to task-workbench-gui-scenarios.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'ert)
|
||||
(require 'task-workbench
|
||||
(expand-file-name "../examples/task-workbench.el"
|
||||
(file-name-directory
|
||||
(or load-file-name
|
||||
(bound-and-true-p byte-compile-current-file)
|
||||
buffer-file-name))))
|
||||
|
||||
(defun wb-test--instance (runtime name)
|
||||
"Return RUNTIME's sole component instance named NAME."
|
||||
(let ((instances
|
||||
(cl-remove-if-not
|
||||
(lambda (instance)
|
||||
(eq name (etaf--component-spec-name
|
||||
(etaf--component-instance-spec instance))))
|
||||
(hash-table-values (etaf-runtime-instances runtime)))))
|
||||
(should (= (length instances) 1))
|
||||
(car instances)))
|
||||
|
||||
(defun wb-test--data (runtime)
|
||||
"Read RUNTIME's example-owned controller for result assertions."
|
||||
(plist-get (etaf--component-instance-state
|
||||
(wb-test--instance runtime 'wb-app)) :data))
|
||||
|
||||
(defun wb-test--text (runtime)
|
||||
"Return RUNTIME's rendered plain text."
|
||||
(with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defun wb-test--row (runtime identity)
|
||||
"Return the semantic row reference for IDENTITY in RUNTIME."
|
||||
(let ((entry
|
||||
(cl-find-if
|
||||
(lambda (entry)
|
||||
(and (equal (plist-get (cdr entry) :key) identity)
|
||||
(member "etaf-table-row"
|
||||
(split-string (or (plist-get (cdr entry) :class) "")))))
|
||||
(etaf-runtime-host-props-entries runtime))))
|
||||
(should entry)
|
||||
(car entry)))
|
||||
|
||||
(defun wb-test--control (runtime label &optional parent)
|
||||
"Return RUNTIME control with aria LABEL, optionally inside PARENT."
|
||||
(let* ((entries
|
||||
(cl-remove-if-not
|
||||
(lambda (entry) (equal (plist-get (cdr entry) :aria-label) label))
|
||||
(etaf-runtime-host-props-entries runtime)))
|
||||
(ancestries (and parent
|
||||
(etaf-runtime-host-ancestries runtime
|
||||
(mapcar #'car entries))))
|
||||
(parent-id (and parent
|
||||
(car (gethash parent
|
||||
(etaf-runtime-host-ancestries
|
||||
runtime (list parent)))))))
|
||||
(when parent
|
||||
(setq entries
|
||||
(cl-remove-if-not
|
||||
(lambda (entry) (memq parent-id (gethash (car entry) ancestries)))
|
||||
entries)))
|
||||
(should (= (length entries) 1))
|
||||
(caar entries)))
|
||||
|
||||
(defun wb-test--press (runtime label &optional parent)
|
||||
"Press RUNTIME control with LABEL, optionally inside PARENT."
|
||||
(etaf-dispatch-event runtime (wb-test--control runtime label parent) 'press))
|
||||
|
||||
(defun wb-test--ids (data)
|
||||
"Return the currently loaded identities from DATA."
|
||||
(mapcar #'wb-task-id (etaf-value (etaf-data-items data))))
|
||||
|
||||
(defun wb-test--layout-bounds (runtime)
|
||||
"Snapshot public bounds across RUNTIME's toolbar, panels, and ten rows."
|
||||
(mapcar
|
||||
(lambda (entry)
|
||||
(let ((bounds (etaf-host-ref-bounds runtime (cdr entry))))
|
||||
(should bounds)
|
||||
(cons (car entry) (copy-tree bounds))))
|
||||
(append
|
||||
(mapcar (lambda (label) (cons label (wb-test--control runtime label)))
|
||||
'("新增任务" "深色" "定位新增按钮" "全部" "未完成" "已完成"
|
||||
"搜索" "每页条数 10 ✎" "显示说明" "刷新 / 重试" "模拟失败"))
|
||||
(mapcar (lambda (identity) (cons identity (wb-test--row runtime identity)))
|
||||
(number-sequence 1 10)))))
|
||||
|
||||
(defun wb-test--line-widths (runtime)
|
||||
"Return measured widths of RUNTIME's rendered lines, including display props."
|
||||
(with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(mapcar #'ebox-string-pixel-width (split-string (buffer-string) "\n" nil))))
|
||||
|
||||
(defun wb-test--desktop-header-inline-p (runtime)
|
||||
"Return non-nil when RUNTIME's desktop title and toolbar share a line."
|
||||
(with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(unless (search-forward "任务工作台" nil t) (error "Workbench title is absent"))
|
||||
(= (line-number-at-pos)
|
||||
(line-number-at-pos
|
||||
(etaf-host-ref-position runtime (wb-test--control runtime "新增任务")))))))
|
||||
|
||||
(cl-defmacro wb-test--with-app ((runtime data) &rest body)
|
||||
"Mount a fresh app bound as RUNTIME and DATA, then execute BODY."
|
||||
(declare (indent 1))
|
||||
`(with-temp-buffer
|
||||
(let (,runtime ,data)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount (current-buffer) (etaf-view (wb-app))
|
||||
'(:viewport-width 1600 :viewport-height 80))
|
||||
(setq ,runtime (etaf-runtime-for-buffer (current-buffer))
|
||||
,data (wb-test--data ,runtime))
|
||||
,@body)
|
||||
(when-let* ((mounted (etaf-runtime-for-buffer (current-buffer))))
|
||||
(etaf-unmount mounted))))))
|
||||
|
||||
(ert-deftest wb-workbench-mounts-composed-app ()
|
||||
"Slots, custom cells, resource, and summary all survive a full mount."
|
||||
(wb-test--with-app (runtime data)
|
||||
(should (etaf-runtime-mounted-p runtime))
|
||||
(should (equal (wb-test--ids data) (number-sequence 1 10)))
|
||||
(should (= (etaf-value (etaf-data-total data)) 100))
|
||||
(should (= (etaf-value (etaf-data-page-size data)) 10))
|
||||
(dolist (label '("任务工作台" "筛选" "设计组件接口" "检查状态隔离"
|
||||
"点击任务行查看详情" "服务正常" "共 100 条 · 当前页 10 条"))
|
||||
(should (string-match-p (regexp-quote label) (wb-test--text runtime))))
|
||||
(dolist (identity (number-sequence 1 10))
|
||||
(let ((row (wb-test--row runtime identity)))
|
||||
(should (wb-test--control runtime "完成" row))
|
||||
(should (wb-test--control runtime "删除" row))))
|
||||
(should (plist-get (etaf-runtime-host-props-for
|
||||
runtime (wb-test--control runtime "Previous page"))
|
||||
:disabled))))
|
||||
|
||||
(ert-deftest wb-workbench-filter-search-and-pagination ()
|
||||
"Filter and search reset paging; both pager directions update rows."
|
||||
(wb-test--with-app (runtime data)
|
||||
(wb-test--press runtime "Next page")
|
||||
(should (= (etaf-value (etaf-data-page data)) 2))
|
||||
(should (equal (wb-test--ids data) (number-sequence 11 20)))
|
||||
(wb-test--press runtime "Previous page")
|
||||
(should (equal (wb-test--ids data) (number-sequence 1 10)))
|
||||
(wb-test--press runtime "未完成")
|
||||
(should (equal (wb-test--ids data) '(1 2 4 6 7 9 10 11 13 14)))
|
||||
(should (= (etaf-value (etaf-data-total data)) 74))
|
||||
(wb-test--press runtime "已完成")
|
||||
(should (equal (wb-test--ids data) '(3 5 8 12 16 20 24 28 32 36)))
|
||||
(should (= (etaf-value (etaf-data-total data)) 26))
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "键盘")))
|
||||
(wb-test--press runtime "搜索"))
|
||||
(should (equal (wb-test--ids data) '(4)))
|
||||
(should (= (etaf-value (etaf-data-page data)) 1))
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "不存在的任务")))
|
||||
(wb-test--press runtime "搜索"))
|
||||
(should-not (wb-test--ids data))
|
||||
(should (string-match-p "没有匹配的任务" (wb-test--text runtime)))
|
||||
(wb-test--press runtime "全部")
|
||||
(should (equal (wb-test--ids data) (number-sequence 1 10)))
|
||||
(should (= (etaf-value (etaf-data-total data)) 100))))
|
||||
|
||||
(ert-deftest wb-workbench-page-size-validates-and-reloads ()
|
||||
"The NumberInput's public press callback applies valid input only."
|
||||
(wb-test--with-app (runtime data)
|
||||
(wb-test--press runtime "Next page")
|
||||
(cl-letf (((symbol-function 'read-number) (lambda (&rest _) 2)))
|
||||
(wb-test--press runtime "每页条数 10 ✎"))
|
||||
(should (= (etaf-value (etaf-data-page-size data)) 2))
|
||||
(should (= (etaf-value (etaf-data-page data)) 1))
|
||||
(should (equal (wb-test--ids data) '(1 2)))
|
||||
(should (string-match-p "Page 1 / 50" (wb-test--text runtime)))
|
||||
(cl-letf (((symbol-function 'read-number) (lambda (&rest _) 0)))
|
||||
(should-error (wb-test--press runtime "每页条数 2 ✎") :type 'user-error))
|
||||
(should (= (etaf-value (etaf-data-page-size data)) 2))
|
||||
(should (equal (wb-test--ids data) '(1 2)))))
|
||||
|
||||
(ert-deftest wb-workbench-cell-toggle-delete-and-detail ()
|
||||
"Cell actions retain the row and dynamic detail, and respect disabled."
|
||||
(let ((observed 0))
|
||||
(cl-letf (((symbol-function 'wb-trace-press) (lambda () (cl-incf observed))))
|
||||
(wb-test--with-app (runtime data)
|
||||
(let* ((row (wb-test--row runtime 1))
|
||||
(remove-ref (wb-test--control runtime "删除" row)))
|
||||
(should-error (etaf-dispatch-event runtime remove-ref 'press)
|
||||
:type 'etaf-event-error)
|
||||
(should-error (etaf-focus runtime remove-ref) :type 'etaf-event-error)
|
||||
(should-not (etaf-data-selected-item data))
|
||||
(etaf-dispatch-event runtime row 'press)
|
||||
(should (= (wb-task-id (etaf-data-selected-item data)) 1))
|
||||
(should (string-match-p "进行中" (wb-test--text runtime)))
|
||||
(let ((detail (wb-test--instance runtime 'wb-task-info)))
|
||||
(wb-test--press runtime "完成" row)
|
||||
(should (= observed 1))
|
||||
(should (plist-get (car (etaf-value (etaf-data-items data))) :done))
|
||||
(should (equal (plist-get (car (etaf-value (etaf-data-items data))) :title)
|
||||
"设计组件接口"))
|
||||
(should (eq detail (wb-test--instance runtime 'wb-task-info)))
|
||||
(should (equal row (wb-test--row runtime 1)))
|
||||
(should (equal remove-ref (wb-test--control runtime "删除" row)))
|
||||
(should-not (plist-get (etaf-runtime-host-props-for runtime remove-ref)
|
||||
:disabled))
|
||||
(etaf-dispatch-event runtime remove-ref 'press)
|
||||
(should (= observed 2))
|
||||
(should (= (etaf-value (etaf-data-total data)) 99))
|
||||
(should (equal (wb-test--ids data) (number-sequence 2 11)))
|
||||
(should-not (etaf-data-selected-item data))
|
||||
(should-not (etaf-effect-scope-active-p
|
||||
(etaf--component-instance-scope detail)))
|
||||
(should (string-match-p "点击任务行查看详情" (wb-test--text runtime)))))))))
|
||||
|
||||
(ert-deftest wb-workbench-add-trims-and-ignores-empty-input ()
|
||||
"Add creates a complete row once and leaves whitespace-only input alone."
|
||||
(wb-test--with-app (runtime data)
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) " 新增验收任务 ")))
|
||||
(wb-test--press runtime "新增任务"))
|
||||
(should (= (etaf-value (etaf-data-total data)) 101))
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) " ")))
|
||||
(wb-test--press runtime "新增任务"))
|
||||
(should (= (etaf-value (etaf-data-total data)) 101))
|
||||
(dotimes (_ 10) (wb-test--press runtime "Next page"))
|
||||
(should (= (etaf-value (etaf-data-page data)) 11))
|
||||
(should (equal (wb-test--ids data) '(101)))
|
||||
(should (equal (car (last (etaf-value (etaf-data-items data))))
|
||||
'(:id 101 :title "新增验收任务" :done nil)))
|
||||
(should (plist-get (etaf-runtime-host-props-for
|
||||
runtime (wb-test--control runtime "Next page")) :disabled))))
|
||||
|
||||
(ert-deftest wb-workbench-last-page-and-high-id-deletion ()
|
||||
"Task 100 is selectable and deletable, with a correct shorter last page."
|
||||
(wb-test--with-app (runtime data)
|
||||
(dotimes (_ 9) (wb-test--press runtime "Next page"))
|
||||
(should (= (etaf-value (etaf-data-page data)) 10))
|
||||
(should (equal (wb-test--ids data) (number-sequence 91 100)))
|
||||
(should (plist-get (etaf-runtime-host-props-for
|
||||
runtime (wb-test--control runtime "Next page")) :disabled))
|
||||
(let ((row (wb-test--row runtime 100)))
|
||||
(etaf-dispatch-event runtime row 'press)
|
||||
(should (= (wb-task-id (etaf-data-selected-item data)) 100))
|
||||
(should (plist-get (etaf-data-selected-item data) :done))
|
||||
(wb-test--press runtime "删除" row)
|
||||
(should (= (etaf-value (etaf-data-total data)) 99))
|
||||
(should (= (etaf-value (etaf-data-page data)) 1))
|
||||
(should (equal (wb-test--ids data) (number-sequence 1 10)))
|
||||
(should-not (etaf-data-selected-item data))
|
||||
(should-error (etaf-dispatch-event runtime row 'press) :type 'etaf-event-error))
|
||||
(dotimes (_ 9) (wb-test--press runtime "Next page"))
|
||||
(should (equal (wb-test--ids data) (number-sequence 91 99)))
|
||||
(should (string-match-p "91–99 of 99" (wb-test--text runtime)))))
|
||||
|
||||
(ert-deftest wb-workbench-theme-focus-and-conditional-slot-content ()
|
||||
"Theme changes paint without moving layout; local focus and details work."
|
||||
(wb-test--with-app (runtime data)
|
||||
(ignore data)
|
||||
(let ((before (with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(buffer-string)))
|
||||
(layout (wb-test--layout-bounds runtime))
|
||||
(widths (wb-test--line-widths runtime))
|
||||
(add (wb-test--control runtime "新增任务")))
|
||||
(should (wb-test--desktop-header-inline-p runtime))
|
||||
(wb-test--press runtime "深色")
|
||||
(should (etaf-value (plist-get (etaf--component-instance-state
|
||||
(wb-test--instance runtime 'wb-app)) :dark)))
|
||||
(should-not (equal-including-properties
|
||||
before (with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(buffer-string))))
|
||||
(should (equal layout (wb-test--layout-bounds runtime)))
|
||||
(should (equal widths (wb-test--line-widths runtime)))
|
||||
(should (wb-test--desktop-header-inline-p runtime))
|
||||
(should (equal add (wb-test--control runtime "新增任务")))
|
||||
(wb-test--press runtime "定位新增按钮")
|
||||
(should (eq add (etaf-focused-host-ref runtime)))
|
||||
(wb-test--press runtime "显示说明")
|
||||
(should-not (string-match-p "点击行：选择任务" (wb-test--text runtime)))
|
||||
(wb-test--press runtime "显示说明")
|
||||
(should (string-match-p "点击行：选择任务" (wb-test--text runtime)))
|
||||
(wb-test--press runtime "深色")
|
||||
(should-not (etaf-value (plist-get (etaf--component-instance-state
|
||||
(wb-test--instance runtime 'wb-app)) :dark)))
|
||||
(should (equal layout (wb-test--layout-bounds runtime)))
|
||||
(should (equal widths (wb-test--line-widths runtime)))
|
||||
(should (wb-test--desktop-header-inline-p runtime)))))
|
||||
|
||||
(ert-deftest wb-workbench-theme-render-failure-retains-published-handlers ()
|
||||
"A failed theme render keeps the published UI and usable old callbacks."
|
||||
(wb-test--with-app (runtime data)
|
||||
(let* ((theme (symbol-function 'wb-theme))
|
||||
(dark (plist-get (etaf--component-instance-state
|
||||
(wb-test--instance runtime 'wb-app)) :dark))
|
||||
(generation (etaf-runtime-current-generation runtime))
|
||||
(before (with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(buffer-string))))
|
||||
(cl-letf (((symbol-function 'wb-theme)
|
||||
(lambda (value)
|
||||
(if value (error "Rejected theme candidate")
|
||||
(funcall theme value)))))
|
||||
(should-error (wb-test--press runtime "深色")))
|
||||
(should (eq generation (etaf-runtime-current-generation runtime)))
|
||||
(should (equal-including-properties
|
||||
before (with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(buffer-string))))
|
||||
;; The App passes a checked value, so the published Checkbox keeps that
|
||||
;; snapshot. Its next press still requests true; UI rollback does not
|
||||
;; restore the separately owned business ref.
|
||||
(should (etaf-value dark))
|
||||
(wb-test--press runtime "深色")
|
||||
(should (etaf-value dark))
|
||||
(should (eq generation (etaf-runtime-current-generation runtime)))
|
||||
;; Restore the business value explicitly, then retry through the same
|
||||
;; public control after removing the injected render failure.
|
||||
(setf (etaf-value dark) nil)
|
||||
(should (equal (wb-test--ids data) (number-sequence 1 10)))
|
||||
(let ((retry-generation (etaf-runtime-current-generation runtime)))
|
||||
(wb-test--press runtime "深色")
|
||||
(should (etaf-value dark))
|
||||
(should-not (eq retry-generation
|
||||
(etaf-runtime-current-generation runtime)))
|
||||
(let ((bounds (etaf-host-ref-bounds
|
||||
runtime (wb-test--control runtime "深色"))))
|
||||
(should bounds)
|
||||
(should (string-match-p
|
||||
"☑" (with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(buffer-substring-no-properties
|
||||
(car bounds) (cdr bounds))))))))))
|
||||
|
||||
(ert-deftest wb-workbench-resource-failure-retry-and-cleanup ()
|
||||
"The resource reports failure, retries, and disposes its last value once."
|
||||
(let ((cleanups 0))
|
||||
(cl-letf (((symbol-function 'wb-service-cleanup) (lambda () (cl-incf cleanups))))
|
||||
(wb-test--with-app (runtime data)
|
||||
(ignore data)
|
||||
(let* ((instance (wb-test--instance runtime 'wb-service))
|
||||
(resource (plist-get (etaf--component-instance-state instance)
|
||||
:resource)))
|
||||
(should (eq (etaf-resource-status resource) 'success))
|
||||
(wb-test--press runtime "模拟失败")
|
||||
(should (eq (etaf-resource-status resource) 'error))
|
||||
(should (string-match-p "模拟加载失败" (wb-test--text runtime)))
|
||||
(wb-test--press runtime "刷新 / 重试")
|
||||
(should (eq (etaf-resource-status resource) 'success))
|
||||
(should (string-match-p "服务正常" (wb-test--text runtime)))
|
||||
(should-not (string-match-p "模拟加载失败" (wb-test--text runtime)))
|
||||
(should (= cleanups 1))
|
||||
(wb-test--press runtime "刷新 / 重试")
|
||||
(should (= cleanups 2))
|
||||
(etaf-unmount runtime)
|
||||
(should (= cleanups 3))
|
||||
(should-not (etaf-resource-active-p resource))
|
||||
(should-not (etaf-effect-scope-active-p
|
||||
(etaf--component-instance-scope instance))))))))
|
||||
|
||||
(ert-deftest wb-workbench-apps-isolate-state-and-remount-cleans-scopes ()
|
||||
"Two mounts isolate state; teardown releases all component-owned resources."
|
||||
(let ((installed 0) (cleaned 0)
|
||||
(one (generate-new-buffer " *wb-one*"))
|
||||
(two (generate-new-buffer " *wb-two*")))
|
||||
(cl-letf (((symbol-function 'wb-trace-install)
|
||||
(lambda () (cl-incf installed) (lambda () (cl-incf cleaned)))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(dolist (buffer (list one two))
|
||||
(etaf-mount buffer (etaf-view (wb-app))
|
||||
'(:viewport-width 1600 :viewport-height 80)))
|
||||
(let* ((r1 (etaf-runtime-for-buffer one))
|
||||
(r2 (etaf-runtime-for-buffer two))
|
||||
(d1 (wb-test--data r1))
|
||||
(d2 (wb-test--data r2))
|
||||
(scopes (mapcar #'etaf--component-instance-scope
|
||||
(hash-table-values (etaf-runtime-instances r1)))))
|
||||
(should-not (eq d1 d2))
|
||||
(should-not (eq (wb-test--control r1 "新增任务")
|
||||
(wb-test--control r2 "新增任务")))
|
||||
(wb-test--press r1 "完成" (wb-test--row r1 1))
|
||||
(should (plist-get (car (etaf-value (etaf-data-items d1))) :done))
|
||||
(should-not (plist-get (car (etaf-value (etaf-data-items d2))) :done))
|
||||
(wb-test--press r1 "深色")
|
||||
(should-not (etaf-value (plist-get (etaf--component-instance-state
|
||||
(wb-test--instance r2 'wb-app))
|
||||
:dark)))
|
||||
(etaf-unmount r1)
|
||||
(should-not (etaf-runtime-for-buffer one))
|
||||
(should (cl-every (lambda (scope)
|
||||
(not (etaf-effect-scope-active-p scope))) scopes))
|
||||
(should (etaf-runtime-mounted-p r2))
|
||||
(etaf-mount one (etaf-view (wb-app))
|
||||
'(:viewport-width 1600 :viewport-height 80))
|
||||
(let ((fresh (wb-test--data (etaf-runtime-for-buffer one))))
|
||||
(should-not (eq d1 fresh))
|
||||
(should (equal (wb-test--ids fresh) (number-sequence 1 10)))
|
||||
(should (= (etaf-value (etaf-data-total fresh)) 100))
|
||||
(should-not (plist-get (car (etaf-value (etaf-data-items fresh))) :done)))))
|
||||
(dolist (buffer (list one two))
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-unmount runtime))
|
||||
(when (buffer-live-p buffer) (kill-buffer buffer))))
|
||||
(should (> installed 0))
|
||||
(should (= installed cleaned)))))
|
||||
|
||||
(provide 'task-workbench-tests)
|
||||
;;; task-workbench-tests.el ends here
|
||||
Loading…
Reference in New Issue
Block a user