diff --git a/DESIGN.md b/DESIGN.md index 4f34064..acd4d53 100644 --- a/DESIGN.md +++ b/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. diff --git a/Makefile b/Makefile index 9f454dc..9cfd215 100644 --- a/Makefile +++ b/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 diff --git a/README.md b/README.md index 35c0177..ae48885 100644 --- a/README.md +++ b/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 diff --git a/README.zh-CN.md b/README.zh-CN.md index 8437441..73e14c7 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -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 条；测试或压测时可以绑定 diff --git a/examples/task-workbench.el b/examples/task-workbench.el new file mode 100644 index 0000000..0965e71 --- /dev/null +++ b/examples/task-workbench.el @@ -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 diff --git a/scripts/playground-gui-scenarios.el b/scripts/playground-gui-scenarios.el index 3b0483e..02de6d7 100644 --- a/scripts/playground-gui-scenarios.el +++ b/scripts/playground-gui-scenarios.el @@ -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." diff --git a/scripts/run-gui-verification.sh b/scripts/run-gui-verification.sh index 6c9b54e..c2dff80 100755 --- a/scripts/run-gui-verification.sh +++ b/scripts/run-gui-verification.sh @@ -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 diff --git a/scripts/task-workbench-gui-scenarios.el b/scripts/task-workbench-gui-scenarios.el new file mode 100644 index 0000000..8765bc6 --- /dev/null +++ b/scripts/task-workbench-gui-scenarios.el @@ -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 diff --git a/tests/playground-gui-scenarios-tests.el b/tests/playground-gui-scenarios-tests.el index ad17f42..5eb06f9 100644 --- a/tests/playground-gui-scenarios-tests.el +++ b/tests/playground-gui-scenarios-tests.el @@ -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 diff --git a/tests/task-workbench-gui-scenarios-tests.el b/tests/task-workbench-gui-scenarios-tests.el new file mode 100644 index 0000000..b4fd93d --- /dev/null +++ b/tests/task-workbench-gui-scenarios-tests.el @@ -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 diff --git a/tests/task-workbench-tests.el b/tests/task-workbench-tests.el new file mode 100644 index 0000000..a376b31 --- /dev/null +++ b/tests/task-workbench-tests.el @@ -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