feat: add draggable desktop window example
This commit is contained in:
Kinneyzhang
parent
ecc490d8c6
commit
b94e19ad7a
@ -23,3 +23,12 @@ Keep necessary business functions and variables in a same-basename `.el` file be
|
|||||||
For native help, pointer, hover-style, or keymap demonstration work, maintain `examples/interaction-reference.el` and `examples/interaction-reference.ebox`, then run `make interaction-tests` (with `EMACS` set to the intended executable). Extend `tests/ebox-playground-interaction-tests.el` for capability, command, replacement, and removal regressions. Use `ebox-help-create` and `ebox-keymap-create` for zero-argument business callbacks and native help/command buffer context, and use `ebox-region-update` with semantic IDs in that buffer. These reusable adapters belong to Ebox; moving local adapters into the companion is not a substitute. Raw native callbacks and keymaps remain supported and own their event-context handling. Extend the generic runner tests for companion reload behavior rather than adding an example-specific loading mechanism.
|
For native help, pointer, hover-style, or keymap demonstration work, maintain `examples/interaction-reference.el` and `examples/interaction-reference.ebox`, then run `make interaction-tests` (with `EMACS` set to the intended executable). Extend `tests/ebox-playground-interaction-tests.el` for capability, command, replacement, and removal regressions. Use `ebox-help-create` and `ebox-keymap-create` for zero-argument business callbacks and native help/command buffer context, and use `ebox-region-update` with semantic IDs in that buffer. These reusable adapters belong to Ebox; moving local adapters into the companion is not a substitute. Raw native callbacks and keymaps remain supported and own their event-context handling. Extend the generic runner tests for companion reload behavior rather than adding an example-specific loading mechanism.
|
||||||
|
|
||||||
For layer, overlap, positioning, or anchored-menu demonstrations, maintain `examples/layer-reference.ebox` and its same-basename companion, preserve `examples/layer-minimal.ebox` as the minimal fixture, and run `make layer-tests`. Extend `tests/ebox-playground-layer-tests.el` for actual native commands and committed-snapshot render parity instead of creating another demo runner or probe. Keep layout in the DSL, business state/actions in the companion, and one font size throughout positioned content. Use the shared interaction evaluator above for repeated layer-command timing. Each parent creates its local stacking group automatically; use `:layer root` on a nested absolute node when root projection is required, with semantic `:anchor` and `:placement` declarations for anchored menus.
|
For layer, overlap, positioning, or anchored-menu demonstrations, maintain `examples/layer-reference.ebox` and its same-basename companion, preserve `examples/layer-minimal.ebox` as the minimal fixture, and run `make layer-tests`. Extend `tests/ebox-playground-layer-tests.el` for actual native commands and committed-snapshot render parity instead of creating another demo runner or probe. Keep layout in the DSL, business state/actions in the companion, and one font size throughout positioned content. Use the shared interaction evaluator above for repeated layer-command timing. Each parent creates its local stacking group automatically; use `:layer root` on a nested absolute node when root projection is required, with semantic `:anchor` and `:placement` declarations for anchored menus.
|
||||||
|
|
||||||
|
For direct-manipulation desktop windows, click-to-front, and title-bar dragging,
|
||||||
|
maintain `examples/desktop-reference.ebox` with its companion and run
|
||||||
|
`make desktop-tests`. Reuse `tests/ebox-playground-desktop-tests.el` for native
|
||||||
|
press/motion/release streams, intermediate publication and fresh-render parity.
|
||||||
|
Use the shared interaction evaluator with the desktop's `"01 ST"` dock label
|
||||||
|
and `"M-<right>"` for repeated position publication timing. Keep native gesture
|
||||||
|
state in the companion, use public Ebox updates, and preserve the existing layer
|
||||||
|
reference instead of turning the generic runner into a window manager.
|
||||||
|
|||||||
37
DESIGN.md
37
DESIGN.md
@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
## Source of truth
|
## Source of truth
|
||||||
- Status: Active
|
- Status: Active
|
||||||
- Last refreshed: 2026-09-08
|
- Last refreshed: 2026-09-11
|
||||||
- Primary product surfaces: The `.ebox` files under `examples/`, the buffer opened by `ebox-playground-open`, and the generic file mode.
|
- Primary product surfaces: The `.ebox` files under `examples/`, the buffer opened by `ebox-playground-open`, and the generic file mode.
|
||||||
- Evidence reviewed: `ebox-playground.el`, the `.ebox` fixtures under `examples/`, `tests/ebox-playground-tests.el`, `README.md`, `README.zh-CN.md`, and rendered gallery/reference previews.
|
- Evidence reviewed: `ebox-playground.el`, the `.ebox` fixtures under `examples/`, `tests/ebox-playground-tests.el`, `README.md`, `README.zh-CN.md`, and rendered gallery/reference previews.
|
||||||
|
|
||||||
@ -13,7 +13,7 @@
|
|||||||
|
|
||||||
## Product goals
|
## Product goals
|
||||||
- Goals: Demonstrate Ebox Grid and composition in a polished standalone example; give the low-level package a visual quality bar consistent with the Flex reference.
|
- Goals: Demonstrate Ebox Grid and composition in a polished standalone example; give the low-level package a visual quality bar consistent with the Flex reference.
|
||||||
- Non-goals: ETAF Components, application state, browser imitation, or a second Playground framework.
|
- Non-goals: ETAF Components, a general application framework, or a second Playground runner. Interactive examples keep their own small state in a same-basename companion.
|
||||||
- Success signals: The first frame clearly communicates hierarchy and Grid behavior; every tinted block has readable text; no content crosses the visible viewport.
|
- Success signals: The first frame clearly communicates hierarchy and Grid behavior; every tinted block has readable text; no content crosses the visible viewport.
|
||||||
|
|
||||||
## Personas and jobs
|
## Personas and jobs
|
||||||
@ -82,3 +82,36 @@
|
|||||||
|
|
||||||
## Open questions
|
## Open questions
|
||||||
- [ ] Add more standalone `.ebox` fixtures only when each teaches a distinct public Ebox responsibility / maintainer / prevents fixture sprawl.
|
- [ ] Add more standalone `.ebox` fixtures only when each teaches a distinct public Ebox responsibility / maintainer / prevents fixture sprawl.
|
||||||
|
|
||||||
|
## Parallax desktop example
|
||||||
|
|
||||||
|
- Surface: `examples/desktop-reference.ebox` and its companion. This dedicated
|
||||||
|
direct-manipulation example complements the existing static/property-oriented
|
||||||
|
layer reference; it does not replace it.
|
||||||
|
- Job: move five overlapping text windows, reveal covered content, and bring any
|
||||||
|
window forward by clicking its exposed body/title or its persistent dock entry.
|
||||||
|
- Visual direction: midnight blue workspace, cool readable ink, violet Studio,
|
||||||
|
cyan Signal, amber Notes, mint Terminal and rose Palette accents. One configured
|
||||||
|
font size throughout. Use contrasting title bars and compact pane content,
|
||||||
|
rather than fake close controls, images or additional font packages.
|
||||||
|
- Structure: compact identity/utility bar, clipped desktop with five independent
|
||||||
|
sibling windows, then persistent dock and status. Keep the workspace dominant;
|
||||||
|
each pane contains a distinct editorial/code/task/signal composition.
|
||||||
|
- Interaction: raise on press, preserve grab offset, repaint changed positions
|
||||||
|
during native mouse tracking, apply the final release position, and retain the
|
||||||
|
last accepted position after interruption. No inertial or decorative animation.
|
||||||
|
The current Ebox layer contract uses pixel X and host-text-row Y coordinates.
|
||||||
|
- Keyboard: RET/SPC activates a pane or dock entry; title-bar Alt+arrows move it.
|
||||||
|
Reset restores the original arrangement. No changes to global Emacs bindings.
|
||||||
|
- Responsive behavior: use viewport-relative positions and bounded pane widths;
|
||||||
|
overflow is clipped at the desktop boundary. Dock entries remain available for
|
||||||
|
covered panes. Target at least 40 columns and 20 text rows; smaller workspaces
|
||||||
|
prioritize the dock, and reopening/resetting restores the initial arrangement.
|
||||||
|
- State and failure: one independent companion state per preview. Commit state
|
||||||
|
only after public Ebox publication succeeds. Mouse tracking owns no persistent
|
||||||
|
timer, advice or global map and releases its transient state on exit/error/quit.
|
||||||
|
- Verification: real commands retrieved from rendered native keymaps, synthetic
|
||||||
|
motion/release streams with intermediate-publication checks, stacking/covered
|
||||||
|
ownership and committed-input render parity, plus compact and wide renders.
|
||||||
|
The standing restriction on operating the user's GUI Emacs remains in force;
|
||||||
|
batch checks do not establish native redisplay latency or screenshot fidelity.
|
||||||
|
|||||||
@ -2,10 +2,28 @@
|
|||||||
|
|
||||||
## 真相来源
|
## 真相来源
|
||||||
- 状态：有效
|
- 状态：有效
|
||||||
- 最近更新：2026-09-08
|
- 最近更新：2026-09-11
|
||||||
- 主要产品界面：`examples/` 下的 `.ebox` 文件、`ebox-playground-open` 打开的缓冲区，以及通用文件模式。
|
- 主要产品界面：`examples/` 下的 `.ebox` 文件、`ebox-playground-open` 打开的缓冲区，以及通用文件模式。
|
||||||
- 已审阅证据：`ebox-playground.el`、`examples/` 下的 `.ebox` fixture、`tests/ebox-playground-tests.el`、`README.md`、`README.zh-CN.md` 以及画廊/参考文件的实际渲染。
|
- 已审阅证据：`ebox-playground.el`、`examples/` 下的 `.ebox` fixture、`tests/ebox-playground-tests.el`、`README.md`、`README.zh-CN.md` 以及画廊/参考文件的实际渲染。
|
||||||
|
|
||||||
|
## Parallax 桌面示例
|
||||||
|
|
||||||
|
`examples/desktop-reference.ebox` 与同名 companion 单独演示直接操作，保留原有图层参考页。
|
||||||
|
深蓝工作台中有五个窗口：紫色 Studio、纸色 Notes、青色 Signal、薄荷色 Terminal、玫瑰色
|
||||||
|
Palette。各窗口有独立内容和局部层叠，全部使用当前字体大小；标题栏与底部窗口栏标出
|
||||||
|
活动窗口，不添加假的关闭按钮或自动动画。
|
||||||
|
|
||||||
|
点击露出的标题、正文或底部窗口入口时整窗置顶；按住标题栏拖拽时即时发布位置，保留
|
||||||
|
鼠标抓取偏移，并应用松手的最终位置。横向按像素，纵向遵循文本行网格。中断保留最后
|
||||||
|
成功的位置，手势退出不留下 timer、advice 或全局键位。RET/SPC 激活，标题或窗口栏的
|
||||||
|
Alt+方向键移动窗口，RESET 恢复原始位置与次序。业务状态只在 Ebox 发布成功后提交，
|
||||||
|
每个预览独立。
|
||||||
|
|
||||||
|
结构为紧凑页头与工具栏、裁剪的主工作区、固定窗口栏和坐标状态；推荐至少 40 列、
|
||||||
|
20 行。较小尺寸保留窗口入口，RESET 可找回拖出边界的窗口。测试覆盖真实 keymap
|
||||||
|
命令、中间运动帧、松手、遮挡归属、失败回滚及独立渲染一致性。遵守不操作用户 GUI
|
||||||
|
Emacs 的现有限制，批处理验证不等同于原生重绘延迟或截图验收。
|
||||||
|
|
||||||
## 品牌
|
## 品牌
|
||||||
- 个性：精确、现代、克制、适合教学。
|
- 个性：精确、现代、克制、适合教学。
|
||||||
- 信任信号：像素对齐的分区、准确的 Grid 放置、明确的文字对比度、只使用公开 API，以及不依赖主题 face 也清晰的布局。
|
- 信任信号：像素对齐的分区、准确的 Grid 放置、明确的文字对比度、只使用公开 API，以及不依赖主题 face 也清晰的布局。
|
||||||
@ -13,7 +31,7 @@
|
|||||||
|
|
||||||
## 产品目标
|
## 产品目标
|
||||||
- 目标：用一个精致的独立示例演示 Ebox Grid 与组合能力，让底层包达到 Flex 参考示例的视觉质量标准。
|
- 目标：用一个精致的独立示例演示 Ebox Grid 与组合能力，让底层包达到 Flex 参考示例的视觉质量标准。
|
||||||
- 非目标：ETAF Component、应用状态、浏览器仿制品，或第二套 Playground 框架。
|
- 非目标：ETAF Component、通用应用框架，或第二套 Playground 运行器。交互示例通过同名 companion 维护自己的小型状态。
|
||||||
- 成功信号：第一屏能清楚表达层级和 Grid 行为；每个带色区块的文字都清晰可读；没有内容越过可见视口。
|
- 成功信号：第一屏能清楚表达层级和 Grid 行为；每个带色区块的文字都清晰可读；没有内容越过可见视口。
|
||||||
|
|
||||||
## 用户与任务
|
## 用户与任务
|
||||||
|
|||||||
9
Makefile
9
Makefile
@ -7,7 +7,7 @@ EBOX_NATIVE_RELEASE_DIR = $(shell $(EMACS) -Q --batch $(LOAD_PATH) \
|
|||||||
-l ../ebox/ebox-native-reflow.el \
|
-l ../ebox/ebox-native-reflow.el \
|
||||||
--eval '(princ (expand-file-name (format "../ebox/native/target/%s/release/" (ebox-native-reflow--rust-target))))')
|
--eval '(princ (expand-file-name (format "../ebox/native/target/%s/release/" (ebox-native-reflow--rust-target))))')
|
||||||
|
|
||||||
.PHONY: all compile test size-tests interaction-tests layer-tests check checkdoc load performance performance-prepare \
|
.PHONY: all compile test size-tests interaction-tests layer-tests desktop-tests check checkdoc load performance performance-prepare \
|
||||||
performance-evaluator clean
|
performance-evaluator clean
|
||||||
|
|
||||||
all: check
|
all: check
|
||||||
@ -26,8 +26,15 @@ test: compile
|
|||||||
--eval '(setq load-prefer-newer t native-comp-jit-compilation nil)' \
|
--eval '(setq load-prefer-newer t native-comp-jit-compilation nil)' \
|
||||||
-l tests/ebox-playground-tests.el -l tests/ebox-playground-size-tests.el \
|
-l tests/ebox-playground-tests.el -l tests/ebox-playground-size-tests.el \
|
||||||
-l tests/ebox-playground-interaction-tests.el -l tests/ebox-playground-layer-tests.el \
|
-l tests/ebox-playground-interaction-tests.el -l tests/ebox-playground-layer-tests.el \
|
||||||
|
-l tests/ebox-playground-desktop-tests.el \
|
||||||
-f ert-run-tests-batch-and-exit
|
-f ert-run-tests-batch-and-exit
|
||||||
|
|
||||||
|
desktop-tests: compile
|
||||||
|
$(EMACS) -Q --batch $(LOAD_PATH) \
|
||||||
|
--eval '(setq load-prefer-newer t native-comp-jit-compilation nil)' \
|
||||||
|
-l tests/ebox-playground-desktop-tests.el \
|
||||||
|
--eval '(ert-run-tests-batch-and-exit "^ebox-playground-desktop-")'
|
||||||
|
|
||||||
layer-tests: compile
|
layer-tests: compile
|
||||||
$(MAKE) -C ../ebox layer-tests EMACS="$(EMACS)" ECSS_DIR="$(ECSS_DIR)" TP_DIR="$(TP_DIR)"
|
$(MAKE) -C ../ebox layer-tests EMACS="$(EMACS)" ECSS_DIR="$(ECSS_DIR)" TP_DIR="$(TP_DIR)"
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) \
|
$(EMACS) -Q --batch $(LOAD_PATH) \
|
||||||
|
|||||||
40
README.md
40
README.md
@ -1,6 +1,6 @@
|
|||||||
# ebox-playground
|
# ebox-playground
|
||||||
|
|
||||||
`ebox-playground` is the independent, generic file runner for Ebox DSL examples. It uses only public Ebox APIs; concrete layouts live in readable `.ebox` fixtures under `examples/`. `flex-reference.ebox`, `grid-reference.ebox`, and `size-reference.ebox` demonstrate layout and sizing with a restrained terracotta, sage, blue, violet, ochre, and teal visual language. `interaction-reference.ebox` demonstrates native Ebox interaction and retained updates. `layer-reference.ebox` combines retained overlapping panels with a native anchored menu.
|
`ebox-playground` is the independent, generic file runner for Ebox DSL examples. It uses only public Ebox APIs; concrete layouts live in readable `.ebox` fixtures under `examples/`. `flex-reference.ebox`, `grid-reference.ebox`, and `size-reference.ebox` demonstrate layout and sizing with a restrained terracotta, sage, blue, violet, ochre, and teal visual language. `interaction-reference.ebox` demonstrates native Ebox interaction and retained updates. `layer-reference.ebox` combines retained overlapping panels with a native anchored menu. `desktop-reference.ebox` provides five directly draggable, overlapping text windows.
|
||||||
|
|
||||||
ECSS 0.1.0 and TP 1.0.1 are independent packages and may be installed in either order. Install both before Ebox 2.0.1, then install Ebox Playground 0.1.1. `ebox-playground` never reaches into those packages' private APIs.
|
ECSS 0.1.0 and TP 1.0.1 are independent packages and may be installed in either order. Install both before Ebox 2.0.1, then install Ebox Playground 0.1.1. `ebox-playground` never reaches into those packages' private APIs.
|
||||||
|
|
||||||
@ -31,6 +31,44 @@ the core size contracts and the actual example declarations, known arithmetic
|
|||||||
results, painted sizing differences, complete rendering, and retained viewport updates. `make check` also
|
results, painted sizing differences, complete rendering, and retained viewport updates. `make check` also
|
||||||
includes the example's regression tests.
|
includes the example's regression tests.
|
||||||
|
|
||||||
|
## PARALLAX draggable desktop
|
||||||
|
|
||||||
|
Open `examples/desktop-reference.ebox` and press `C-c C-c`, or use:
|
||||||
|
|
||||||
|
```elisp
|
||||||
|
(ebox-playground-open-file
|
||||||
|
(expand-file-name "examples/desktop-reference.ebox"
|
||||||
|
ebox-playground-directory))
|
||||||
|
```
|
||||||
|
|
||||||
|
Five independent panes share a midnight-blue desktop: violet Studio, paper
|
||||||
|
Notes, cyan Signal, mint Terminal, and rose Palette. Each contains its own
|
||||||
|
text and layered artwork. All text uses the configured font size.
|
||||||
|
|
||||||
|
- Click any exposed pane, including its blank body area, to bring the entire
|
||||||
|
window forward. Other windows keep their relative stacking order.
|
||||||
|
- Hold the primary button on a title bar and move it. Positions are published
|
||||||
|
while the button is held, preserving the initial grab offset; release applies
|
||||||
|
the final position. Windows can partially or fully cover one another.
|
||||||
|
- The five dock entries raise windows even when they are completely covered.
|
||||||
|
**CYCLE** brings the backmost window forward; **RESET** restores all initial
|
||||||
|
positions and the original stack, including panes clipped off the desktop.
|
||||||
|
- `RET`/`SPC` activates the control at point. `Alt+arrows` on a title or dock
|
||||||
|
entry moves its pane; point follows the same native control for key repeat.
|
||||||
|
`C-g` stops a drag and keeps the last accepted position.
|
||||||
|
|
||||||
|
Horizontal dragging uses pixel positions; vertical movement follows Ebox's
|
||||||
|
host text rows. This is live text-window composition, not sub-row raster motion.
|
||||||
|
Use at least 40 columns and 20 rows; larger previews leave more room to arrange
|
||||||
|
the five panes. Reopening the file creates an independent desktop state.
|
||||||
|
|
||||||
|
Run `make desktop-tests EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs` for
|
||||||
|
native command, intermediate motion, release, overlap, rollback, independent
|
||||||
|
preview and render-parity regressions. Normal `make check` includes this suite.
|
||||||
|
For repeated movement publication timing, use the shared interaction evaluator
|
||||||
|
with this file, dock label `"01 ST"` and key `"M-<right>"`; it measures the same
|
||||||
|
position publisher without OS event delivery or GUI redisplay.
|
||||||
|
|
||||||
## ORBIT spatial desktop and layer lab
|
## ORBIT spatial desktop and layer lab
|
||||||
|
|
||||||
`examples/layer-minimal.ebox` is the smallest static overlap example. The complete
|
`examples/layer-minimal.ebox` is the smallest static overlap example. The complete
|
||||||
|
|||||||
@ -24,6 +24,33 @@ ECSS 0.1.0 与 TP 1.0.1 是互相独立的包，安装顺序任意；两者都
|
|||||||
运行 `make size-tests EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`，可检查核心尺寸契约、
|
运行 `make size-tests EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`，可检查核心尺寸契约、
|
||||||
示例的实际属性覆盖、已知计算结果、背景所指示的尺寸差异、完整渲染及保留状态的视口更新。`make check` 也包含此示例的回归测试。
|
示例的实际属性覆盖、已知计算结果、背景所指示的尺寸差异、完整渲染及保留状态的视口更新。`make check` 也包含此示例的回归测试。
|
||||||
|
|
||||||
|
## PARALLAX 可拖拽桌面
|
||||||
|
|
||||||
|
打开 `examples/desktop-reference.ebox`，按 `C-c C-c`，或执行：
|
||||||
|
|
||||||
|
```elisp
|
||||||
|
(ebox-playground-open-file
|
||||||
|
(expand-file-name "examples/desktop-reference.ebox"
|
||||||
|
ebox-playground-directory))
|
||||||
|
```
|
||||||
|
|
||||||
|
深蓝工作台中放置五个内容各异的窗口：Studio、Notes、Signal、Terminal、Palette。
|
||||||
|
点击露出的标题、正文或空白区域，会将整窗置顶；按住标题栏拖动时持续更新位置，
|
||||||
|
保留抓取偏移，松手时应用最终位置。窗口可以部分或完全覆盖其他窗口，原有内容始终保留。
|
||||||
|
|
||||||
|
底部五个窗口入口可以找回被完全遮住的窗口；**CYCLE** 将最下面的窗口放到最上面，
|
||||||
|
**RESET** 恢复原始位置和次序，也能找回拖出桌面裁剪边界的窗口。RET/SPC 激活当前
|
||||||
|
控件，标题或窗口入口上的 Alt+方向键移动对应窗口并支持连续按键；C-g 结束拖拽，
|
||||||
|
保留最后成功发布的位置。每次打开的预览状态互相独立。
|
||||||
|
|
||||||
|
横向按像素移动，纵向遵循 Ebox 的文本行网格。推荐至少 40 列、20 行，更大的预览
|
||||||
|
有更多摆放空间。所有文本保持当前字体大小，不使用额外字体或图片依赖。
|
||||||
|
|
||||||
|
运行 `make desktop-tests EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs`
|
||||||
|
检查真实 keymap 命令、中间运动帧、松手、遮挡归属、失败回滚和渲染一致性；
|
||||||
|
`make check` 已包含该套件。重复位置发布的耗时使用共享 interaction evaluator，
|
||||||
|
传入该示例、窗口入口 `"01 ST"` 和按键 `"M-<right>"`，不将其冒充 GUI 重绘延迟。
|
||||||
|
|
||||||
## 滚动性能验证
|
## 滚动性能验证
|
||||||
|
|
||||||
使用共享 `scripts/ebox-playground-flex-resize-evaluator.el` 的入口：
|
使用共享 `scripts/ebox-playground-flex-resize-evaluator.el` 的入口：
|
||||||
|
|||||||
178
examples/desktop-reference.ebox
Normal file
178
examples/desktop-reference.ebox
Normal file
@ -0,0 +1,178 @@
|
|||||||
|
;; Layout and initial geometry live here; native gestures live in the companion.
|
||||||
|
(let* ((studio (desktop-demo-window-create
|
||||||
|
:id "desk-studio" :label "STUDIO" :accent "#BBA9FF" :ink "#241B40"
|
||||||
|
:left '(% 5) :top '(lh 1)))
|
||||||
|
(notes (desktop-demo-window-create
|
||||||
|
:id "desk-notes" :label "NOTES" :accent "#F6C879" :ink "#3B2917"
|
||||||
|
:left '(% 45) :top '(% 4)))
|
||||||
|
(signal (desktop-demo-window-create
|
||||||
|
:id "desk-signal" :label "SIGNAL" :accent "#8DE1E4" :ink "#15383D"
|
||||||
|
:left '(% 57) :top '(% 32)))
|
||||||
|
(terminal (desktop-demo-window-create
|
||||||
|
:id "desk-terminal" :label "TERMINAL" :accent "#A7E8BB" :ink "#1B3826"
|
||||||
|
:left '(% 8) :top '(% 46)))
|
||||||
|
(palette (desktop-demo-window-create
|
||||||
|
:id "desk-palette" :label "PALETTE" :accent "#F3A8C9" :ink "#402438"
|
||||||
|
:left '(% 43) :top '(% 65)))
|
||||||
|
(panes (list studio notes signal terminal palette))
|
||||||
|
(demo (desktop-demo-create :windows panes
|
||||||
|
:order (mapcar #'desktop-demo-window-id panes)
|
||||||
|
:active "desk-palette")))
|
||||||
|
`(column :width (vw 100) :height (vh 100) :overflow hidden
|
||||||
|
:background-color "#0B1020" :color "#CFD8EA"
|
||||||
|
(box :height (lh 3) :padding-inline (ch 1)
|
||||||
|
(row :height (lh 1)
|
||||||
|
(box :color "#BBA9FF" :font-weight bold "P A R A L L A X")
|
||||||
|
(box :padding-left (ch 2) :color "#657899" "DESKTOP / 05"))
|
||||||
|
(box :color "#F1F5FF" "A little space. A lot of possibilities.")
|
||||||
|
(box :color "#8F9FBD" "Click to focus. Drag a title bar to move."))
|
||||||
|
(flex :height (lh 1) :gap ((lh 0) (ch 1)) :padding-inline (ch 1)
|
||||||
|
(box :padding-inline (ch 1) :color "#D7E3F8" :background-color "#25324B"
|
||||||
|
:pointer hand :hover-style (:background-color "#354662")
|
||||||
|
:help-echo "Restore the five original positions and stacking order."
|
||||||
|
:keymap ,(desktop-demo-control demo 'reset) "RESET")
|
||||||
|
(box :padding-inline (ch 1) :color "#D7E3F8" :background-color "#25324B"
|
||||||
|
:pointer hand :hover-style (:background-color "#354662")
|
||||||
|
:help-echo "Bring the backmost window to the front."
|
||||||
|
:keymap ,(desktop-demo-control demo 'next) "CYCLE")
|
||||||
|
(box :color "#657899" "FIVE IDEAS / ONE SHARED SPACE"))
|
||||||
|
|
||||||
|
(box :id "desktop-canvas" :height (calc (- (vh 100) (lh 7)))
|
||||||
|
:overflow hidden :background-color "#111A2C"
|
||||||
|
(box :position absolute :left (ch 1) :top (lh 0)
|
||||||
|
:color "#3F5273" "WORKSPACE 01 + + + + +")
|
||||||
|
(box :position absolute :left (% 68) :top (% 78)
|
||||||
|
:width (% 30) :color "#334866"
|
||||||
|
"+ . + . +\n. + . + .\n+ . + . +\n. + . + .")
|
||||||
|
(box :position absolute :left (ch 2) :top (% 93)
|
||||||
|
:color "#5A6D8E" "MOVE THINGS AROUND. MAKE IT YOURS.")
|
||||||
|
|
||||||
|
(box :id "desk-studio" :position absolute :left ,(desktop-demo-window-left studio)
|
||||||
|
:top ,(desktop-demo-window-top studio) :width (min (ch 44) (% 55))
|
||||||
|
:height (lh 13) :z-index 1 :overflow hidden
|
||||||
|
:background-color "#26223B" :color "#D6CDEF" :pointer arrow
|
||||||
|
:help-echo "Studio. Click any exposed area to bring this whole window forward."
|
||||||
|
:keymap ,(desktop-demo-keymap demo "desk-studio")
|
||||||
|
(box :id "desk-studio-title" :height (lh 1) :padding-inline (ch 1)
|
||||||
|
:background-color "#25324B" :color "#C1CBE0" :font-weight bold
|
||||||
|
:pointer hand :keymap ,(desktop-demo-keymap demo "desk-studio" t)
|
||||||
|
:help-echo "Drag Studio. Alt+arrows moves it from the keyboard."
|
||||||
|
"STUDIO / 01 ::")
|
||||||
|
(box :padding ((lh 1) (ch 2))
|
||||||
|
(box :font-weight bold :color "#F5F0FF" "Make space for the unexpected.")
|
||||||
|
(box :padding-top (lh 1) :color "#A999C8" "EXPERIMENT 024 / SOFT STRUCTURES")
|
||||||
|
(box :height (lh 5) :padding-top (lh 1)
|
||||||
|
(box :position absolute :left (ch 0) :top (lh 1)
|
||||||
|
:width (ch 13) :height (lh 3) :background-color "#7561AC"
|
||||||
|
:color "#EAE1FF" :text-align center "\nFORM / 01")
|
||||||
|
(box :position absolute :left (ch 9) :top (lh 0)
|
||||||
|
:width (ch 13) :height (lh 3) :z-index 1
|
||||||
|
:background-color "#BBA9FF" :color "#302449"
|
||||||
|
:text-align center "\nSPACE / 02")
|
||||||
|
(box :position absolute :left (ch 18) :top (lh 2)
|
||||||
|
:width (ch 12) :height (lh 3) :z-index 2
|
||||||
|
:background-color "#D8EAAB" :color "#303D22"
|
||||||
|
:text-align center "\nPLAY / 03"))
|
||||||
|
(box :color "#B8A9D0" "Fragments become a composition.")
|
||||||
|
(box :padding-top (lh 1) :color "#85799F" "COLLECTION / UNFINISHED POSSIBILITIES")))
|
||||||
|
|
||||||
|
(box :id "desk-notes" :position absolute :left ,(desktop-demo-window-left notes)
|
||||||
|
:top ,(desktop-demo-window-top notes) :width (min (ch 34) (% 43))
|
||||||
|
:height (lh 11) :z-index 2 :overflow hidden
|
||||||
|
:background-color "#EEE3CB" :color "#514430" :pointer arrow
|
||||||
|
:help-echo "Notes. The content remains here even when another window covers it."
|
||||||
|
:keymap ,(desktop-demo-keymap demo "desk-notes")
|
||||||
|
(box :id "desk-notes-title" :height (lh 1) :padding-inline (ch 1)
|
||||||
|
:background-color "#25324B" :color "#C1CBE0" :font-weight bold
|
||||||
|
:pointer hand :keymap ,(desktop-demo-keymap demo "desk-notes" t)
|
||||||
|
:help-echo "Drag Notes. Alt+arrows moves it from the keyboard."
|
||||||
|
"NOTES / 02 ::")
|
||||||
|
(box :padding ((lh 1) (ch 1))
|
||||||
|
(box :font-weight bold "A quieter kind of focus.")
|
||||||
|
(box :padding-top (lh 1) :color "#8C744E" "TODAY / THINGS WORTH MAKING")
|
||||||
|
(box :padding-top (lh 1)
|
||||||
|
"[x] Collect the small ideas\n[ ] Give the good ones room\n[ ] Leave something unfinished")
|
||||||
|
(box :padding-top (lh 1) :color "#887651" "Less noise. More intention.")
|
||||||
|
(box :color "#A18B61" "------------------------------")
|
||||||
|
(box :color "#746345" "03 NOTES / SAVED IN THE MOMENT")))
|
||||||
|
|
||||||
|
(box :id "desk-signal" :position absolute :left ,(desktop-demo-window-left signal)
|
||||||
|
:top ,(desktop-demo-window-top signal) :width (min (ch 32) (% 39))
|
||||||
|
:height (lh 10) :z-index 3 :overflow hidden
|
||||||
|
:background-color "#17343E" :color "#BFE5E9" :pointer arrow
|
||||||
|
:help-echo "Signal. Raise the entire player, including its overlapping waveform."
|
||||||
|
:keymap ,(desktop-demo-keymap demo "desk-signal")
|
||||||
|
(box :id "desk-signal-title" :height (lh 1) :padding-inline (ch 1)
|
||||||
|
:background-color "#25324B" :color "#C1CBE0" :font-weight bold
|
||||||
|
:pointer hand :keymap ,(desktop-demo-keymap demo "desk-signal" t)
|
||||||
|
:help-echo "Drag Signal. Alt+arrows moves it from the keyboard."
|
||||||
|
"SIGNAL / 03 ::")
|
||||||
|
(box :padding ((lh 1) (ch 2))
|
||||||
|
(box :font-weight bold :color "#E4FBF9" "AFTER HOURS")
|
||||||
|
(box :color "#7BAEB9" "A soundtrack for the in-between.")
|
||||||
|
(flex :height (lh 3) :gap ((lh 0) (ch 1)) :padding-top (lh 1)
|
||||||
|
(box :width (ch 2) :height (lh 1) :background-color "#518F9D")
|
||||||
|
(box :width (ch 2) :height (lh 2) :background-color "#8DE1E4")
|
||||||
|
(box :width (ch 2) :height (lh 1) :background-color "#518F9D")
|
||||||
|
(box :width (ch 2) :height (lh 2) :background-color "#BBA9FF")
|
||||||
|
(box :width (ch 2) :height (lh 1) :background-color "#8DE1E4")
|
||||||
|
(box :width (ch 2) :height (lh 2) :background-color "#BBA9FF")
|
||||||
|
(box :width (ch 2) :height (lh 1) :background-color "#518F9D"))
|
||||||
|
(box :color "#8DE1E4" "========------------ 03:42")
|
||||||
|
(box :padding-top (lh 1) :color "#699CA9" "SIDE B / SLOWER ORBITS")))
|
||||||
|
|
||||||
|
(box :id "desk-terminal" :position absolute :left ,(desktop-demo-window-left terminal)
|
||||||
|
:top ,(desktop-demo-window-top terminal) :width (min (ch 48) (% 60))
|
||||||
|
:height (lh 11) :z-index 4 :overflow hidden
|
||||||
|
:background-color "#101F22" :color "#B6D7CC" :pointer arrow
|
||||||
|
:help-echo "Terminal. This sample transcript is part of the movable text window."
|
||||||
|
:keymap ,(desktop-demo-keymap demo "desk-terminal")
|
||||||
|
(box :id "desk-terminal-title" :height (lh 1) :padding-inline (ch 1)
|
||||||
|
:background-color "#25324B" :color "#C1CBE0" :font-weight bold
|
||||||
|
:pointer hand :keymap ,(desktop-demo-keymap demo "desk-terminal" t)
|
||||||
|
:help-echo "Drag Terminal. Alt+arrows moves it from the keyboard."
|
||||||
|
"TERMINAL / 04 ::")
|
||||||
|
(box :padding ((lh 1) (ch 2))
|
||||||
|
(box :color "#A7E8BB" "$ build something good")
|
||||||
|
(box :padding-top (lh 1) :color "#608C7F" " session: creative / local\n workspace: parallax")
|
||||||
|
(box :padding-top (lh 1) " + ideas connected\n + room for experiments\n + all five windows ready")
|
||||||
|
(box :padding-top (lh 1) :color "#A7E8BB" " READY / follow your curiosity")))
|
||||||
|
|
||||||
|
(box :id "desk-palette" :position absolute :left ,(desktop-demo-window-left palette)
|
||||||
|
:top ,(desktop-demo-window-top palette) :width (min (ch 29) (% 36))
|
||||||
|
:height (lh 9) :z-index 5 :overflow hidden
|
||||||
|
:background-color "#39283D" :color "#EBCBDE" :pointer arrow
|
||||||
|
:help-echo "Palette starts in front. Click a window underneath to change the stack."
|
||||||
|
:keymap ,(desktop-demo-keymap demo "desk-palette")
|
||||||
|
(box :id "desk-palette-title" :height (lh 1) :padding-inline (ch 1)
|
||||||
|
:background-color "#F3A8C9" :color "#402438" :font-weight bold
|
||||||
|
:pointer hand :keymap ,(desktop-demo-keymap demo "desk-palette" t)
|
||||||
|
:help-echo "Drag Palette. Alt+arrows moves it from the keyboard."
|
||||||
|
"PALETTE / 05 ::")
|
||||||
|
(box :padding ((lh 1) (ch 1))
|
||||||
|
(box :font-weight bold "Objects in conversation.")
|
||||||
|
(box :padding-top (lh 1) :color "#AF8DA9" "FIVE TONES / ONE ATMOSPHERE")
|
||||||
|
(flex :height (lh 2) :padding-top (lh 1) :gap ((lh 0) (ch 1))
|
||||||
|
(box :width (ch 4) :height (lh 1) :background-color "#BBA9FF")
|
||||||
|
(box :width (ch 4) :height (lh 1) :background-color "#F6C879")
|
||||||
|
(box :width (ch 4) :height (lh 1) :background-color "#8DE1E4")
|
||||||
|
(box :width (ch 4) :height (lh 1) :background-color "#A7E8BB")
|
||||||
|
(box :width (ch 4) :height (lh 1) :background-color "#F3A8C9"))
|
||||||
|
(box :padding-top (lh 1) :color "#F3A8C9" "MIDNIGHT / SOFT ELECTRIC"))))
|
||||||
|
|
||||||
|
(flex :height (lh 2) :gap ((lh 0) (ch 1)) :padding-top (lh 1)
|
||||||
|
,@(cl-loop for pane in panes for index from 1
|
||||||
|
for short in '("ST" "NT" "SG" "TM" "PL")
|
||||||
|
for active = (equal (desktop-demo-window-id pane) (desktop-demo-active demo))
|
||||||
|
collect
|
||||||
|
`(box :id ,(concat (desktop-demo-window-id pane) "-dock")
|
||||||
|
:padding-inline (ch 1)
|
||||||
|
:background-color ,(if active (desktop-demo-window-accent pane) "#25324B")
|
||||||
|
:color ,(if active (desktop-demo-window-ink pane) "#C1CBE0")
|
||||||
|
:font-weight bold :pointer hand
|
||||||
|
:help-echo ,(format "Bring %s to front, even when covered. Alt+arrows moves it."
|
||||||
|
(desktop-demo-window-label pane))
|
||||||
|
:keymap ,(desktop-demo-keymap demo (desktop-demo-window-id pane))
|
||||||
|
,(format "%02d %s" index short))))
|
||||||
|
(box :id "desktop-status" :height (lh 1) :color "#8F9FBD"
|
||||||
|
,(desktop-demo-status demo))))
|
||||||
242
examples/desktop-reference.el
Normal file
242
examples/desktop-reference.el
Normal file
@ -0,0 +1,242 @@
|
|||||||
|
;;; desktop-reference.el --- Direct manipulation for the desktop example -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;; The matching .ebox file declares the five windows and their initial layout.
|
||||||
|
;; Native mouse tracking publishes positions while the button is held. All
|
||||||
|
;; document changes use public Ebox region updates; each preview owns its state.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'ebox)
|
||||||
|
|
||||||
|
(cl-defstruct (desktop-demo-window (:constructor desktop-demo-window-create))
|
||||||
|
"A desktop pane's identity, palette, initial offsets and pixel displacement."
|
||||||
|
id label accent ink left top (x 0) (y 0))
|
||||||
|
|
||||||
|
(cl-defstruct (desktop-demo (:constructor desktop-demo-create))
|
||||||
|
"Independent state captured by the native commands of one desktop preview."
|
||||||
|
windows order active (serial 5) dragging)
|
||||||
|
|
||||||
|
(defun desktop-demo--window (demo id)
|
||||||
|
"Return DEMO's pane with semantic ID."
|
||||||
|
(or (cl-find id (desktop-demo-windows demo)
|
||||||
|
:key #'desktop-demo-window-id :test #'equal)
|
||||||
|
(error "Unknown desktop window: %s" id)))
|
||||||
|
|
||||||
|
(defun desktop-demo-status (demo)
|
||||||
|
"Describe DEMO's frontmost pane and its displacement."
|
||||||
|
(let ((pane (desktop-demo--window demo (desktop-demo-active demo))))
|
||||||
|
(format " %s / FRONT X %+d Y %+d | DRAG A TITLE BAR"
|
||||||
|
(desktop-demo-window-label pane)
|
||||||
|
(desktop-demo-window-x pane) (desktop-demo-window-y pane))))
|
||||||
|
|
||||||
|
(defun desktop-demo--chrome (pane active)
|
||||||
|
"Return title and dock updates for PANE, highlighted when ACTIVE."
|
||||||
|
(let ((background (if active (desktop-demo-window-accent pane) "#25324B"))
|
||||||
|
(foreground (if active (desktop-demo-window-ink pane) "#C1CBE0")))
|
||||||
|
(mapcar (lambda (suffix)
|
||||||
|
(list (concat (desktop-demo-window-id pane) suffix)
|
||||||
|
:background-color background :color foreground))
|
||||||
|
'("-title" "-dock"))))
|
||||||
|
|
||||||
|
(defun desktop-demo--keyboard-anchor ()
|
||||||
|
"Capture the native control at point for keyboard repeat, if applicable."
|
||||||
|
(unless (mouse-event-p last-input-event)
|
||||||
|
(let* ((map (get-text-property (point) 'keymap))
|
||||||
|
(command (and (keymapp map) (lookup-key map [mouse-1]))))
|
||||||
|
(when (commandp command)
|
||||||
|
(list command
|
||||||
|
(- (point) (previous-single-property-change
|
||||||
|
(1+ (point)) 'keymap nil (point-min))))))))
|
||||||
|
|
||||||
|
(defun desktop-demo--restore-keyboard-anchor (anchor)
|
||||||
|
"Restore point within ANCHOR's surviving native control after publication."
|
||||||
|
(when anchor
|
||||||
|
(let ((position (point-min)))
|
||||||
|
(catch 'restored
|
||||||
|
(while (< position (point-max))
|
||||||
|
(let ((map (get-text-property position 'keymap))
|
||||||
|
(end (next-single-property-change position 'keymap nil (point-max))))
|
||||||
|
(when (and (keymapp map) (eq (lookup-key map [mouse-1]) (car anchor)))
|
||||||
|
(goto-char (+ position (min (cadr anchor) (1- (- end position)))))
|
||||||
|
(throw 'restored t))
|
||||||
|
(setq position end)))))))
|
||||||
|
|
||||||
|
(defun desktop-demo--publish (demo candidate updates)
|
||||||
|
"Publish UPDATES and CANDIDATE's status, then advance DEMO's state.
|
||||||
|
Failed Ebox publication leaves the business state on its accepted generation."
|
||||||
|
(let ((anchor (desktop-demo--keyboard-anchor)))
|
||||||
|
(ebox-call-with-update-batch
|
||||||
|
(lambda ()
|
||||||
|
(dolist (update updates)
|
||||||
|
(apply #'ebox-region-update update))
|
||||||
|
(ebox-region-update "desktop-status" :content (desktop-demo-status candidate))))
|
||||||
|
(setf (desktop-demo-windows demo) (desktop-demo-windows candidate)
|
||||||
|
(desktop-demo-order demo) (desktop-demo-order candidate)
|
||||||
|
(desktop-demo-active demo) (desktop-demo-active candidate)
|
||||||
|
(desktop-demo-serial demo) (desktop-demo-serial candidate)
|
||||||
|
(desktop-demo-dragging demo) (desktop-demo-dragging candidate))
|
||||||
|
(desktop-demo--restore-keyboard-anchor anchor)))
|
||||||
|
|
||||||
|
(defun desktop-demo-activate (demo id &optional dragging)
|
||||||
|
"Bring DEMO's pane ID forward; DRAGGING begins a transient mouse gesture."
|
||||||
|
(let ((pane (desktop-demo--window demo id)))
|
||||||
|
(unless (equal id (desktop-demo-active demo))
|
||||||
|
(let ((candidate (copy-desktop-demo demo)))
|
||||||
|
(setf (desktop-demo-active candidate) id
|
||||||
|
(desktop-demo-order candidate)
|
||||||
|
(append (remove id (desktop-demo-order demo)) (list id))
|
||||||
|
(desktop-demo-serial candidate) (1+ (desktop-demo-serial demo)))
|
||||||
|
(desktop-demo--publish
|
||||||
|
demo candidate
|
||||||
|
(append (list (list id :z-index (desktop-demo-serial candidate)))
|
||||||
|
(desktop-demo--chrome
|
||||||
|
(desktop-demo--window demo (desktop-demo-active demo)) nil)
|
||||||
|
(desktop-demo--chrome pane t)))))
|
||||||
|
(when dragging (setf (desktop-demo-dragging demo) id))))
|
||||||
|
|
||||||
|
(defun desktop-demo-move (demo id x y &optional row-height)
|
||||||
|
"Move DEMO's pane ID to pixel displacement X, Y from its initial offsets.
|
||||||
|
ROW-HEIGHT is the drag frame's host row size, defaulting to the selected frame.
|
||||||
|
Return non-nil only after a changed position has been published."
|
||||||
|
(let ((pane (desktop-demo--window demo id)))
|
||||||
|
(unless (and (= x (desktop-demo-window-x pane))
|
||||||
|
(= y (desktop-demo-window-y pane)))
|
||||||
|
(let ((candidate (copy-desktop-demo demo))
|
||||||
|
(moved (copy-desktop-demo-window pane))
|
||||||
|
(rows (/ y (float (max 1 (or row-height (frame-char-height)))))))
|
||||||
|
(setf (desktop-demo-window-x moved) x
|
||||||
|
(desktop-demo-window-y moved) y
|
||||||
|
(desktop-demo-windows candidate)
|
||||||
|
(mapcar (lambda (item) (if (eq item pane) moved item))
|
||||||
|
(desktop-demo-windows demo)))
|
||||||
|
(desktop-demo--publish
|
||||||
|
demo candidate
|
||||||
|
(list (list id :left `(calc (+ ,(desktop-demo-window-left pane) (px ,x)))
|
||||||
|
:top `(calc (+ ,(desktop-demo-window-top pane) (lh ,rows))))))
|
||||||
|
t))))
|
||||||
|
|
||||||
|
(defun desktop-demo--frame-point (position frame)
|
||||||
|
"Convert a supported mouse POSITION to pixels in FRAME, or return nil.
|
||||||
|
Text-window positions and same-frame outside-window positions are supported;
|
||||||
|
fringe, scrollbar and other area-specific coordinate systems are skipped."
|
||||||
|
(let ((where (posn-window position)) (xy (posn-x-y position)))
|
||||||
|
(when (and (consp xy) (numberp (car xy)) (numberp (cdr xy)))
|
||||||
|
(cond
|
||||||
|
((eq where frame) xy)
|
||||||
|
((and (window-live-p where) (eq (window-frame where) frame)
|
||||||
|
(null (posn-area position)))
|
||||||
|
(let ((edges (window-inside-pixel-edges where)))
|
||||||
|
(cons (+ (car edges) (car xy)) (+ (cadr edges) (cdr xy)))))))))
|
||||||
|
|
||||||
|
(defun desktop-demo-drag (demo id event)
|
||||||
|
"Raise DEMO's pane ID and track its title-bar press EVENT until release.
|
||||||
|
Publish each changed position before reading the next event. Preserve the
|
||||||
|
grab offset, consume the release endpoint and retain unrelated input. Quit
|
||||||
|
or failure releases gesture state and keeps the last accepted geometry."
|
||||||
|
(let* ((position (event-start event))
|
||||||
|
(window (posn-window position)))
|
||||||
|
(unless (and (window-live-p window) (null (posn-area position)))
|
||||||
|
(user-error "Drag a desktop title bar in a live text window"))
|
||||||
|
(let* ((buffer (window-buffer window))
|
||||||
|
(frame (window-frame window))
|
||||||
|
(start (desktop-demo--frame-point position frame))
|
||||||
|
(pane (desktop-demo--window demo id))
|
||||||
|
(origin-x (desktop-demo-window-x pane))
|
||||||
|
(origin-y (desktop-demo-window-y pane))
|
||||||
|
(row-height (max 1 (frame-char-height frame)))
|
||||||
|
(button (event-basic-type event))
|
||||||
|
(mouse-fine-grained-tracking t))
|
||||||
|
(unless start (user-error "The drag event has no text coordinates"))
|
||||||
|
(unwind-protect
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(desktop-demo-activate demo id t)
|
||||||
|
(redisplay t)
|
||||||
|
(track-mouse
|
||||||
|
(let ((track-mouse 'dragging) done)
|
||||||
|
(while (and (not done) (window-live-p window)
|
||||||
|
(buffer-live-p buffer) (eq (window-buffer window) buffer)
|
||||||
|
(ebox-surface-buffer-mounted-p buffer))
|
||||||
|
(let* ((next (read-event))
|
||||||
|
(release
|
||||||
|
(and (eq (event-basic-type next) button)
|
||||||
|
(or (memq 'click (event-modifiers next))
|
||||||
|
(memq 'drag (event-modifiers next)))))
|
||||||
|
(point (when (or release (mouse-movement-p next))
|
||||||
|
(desktop-demo--frame-point
|
||||||
|
(if release (event-end next) (event-start next)) frame))))
|
||||||
|
(when (and point (window-live-p window) (buffer-live-p buffer)
|
||||||
|
(eq (window-buffer window) buffer)
|
||||||
|
(ebox-surface-buffer-mounted-p buffer))
|
||||||
|
(let* ((edges (window-inside-pixel-edges window))
|
||||||
|
;; Keep the grab point in the original text window.
|
||||||
|
(x (max (nth 0 edges) (min (1- (nth 2 edges)) (car point))))
|
||||||
|
(y (max (nth 1 edges) (min (1- (nth 3 edges)) (cdr point)))))
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(when (desktop-demo-move
|
||||||
|
demo id (+ origin-x (round (- x (car start))))
|
||||||
|
(+ origin-y (* row-height
|
||||||
|
(round (/ (- y (cdr start))
|
||||||
|
(float row-height)))))
|
||||||
|
row-height)
|
||||||
|
(redisplay t)))))
|
||||||
|
(cond
|
||||||
|
(release (setq done t))
|
||||||
|
((mouse-movement-p next) nil)
|
||||||
|
(t (push next unread-command-events) (setq done t))))))))
|
||||||
|
(setf (desktop-demo-dragging demo) nil)))))
|
||||||
|
|
||||||
|
(defun desktop-demo--nudge (demo id dx dy)
|
||||||
|
"Activate DEMO's pane ID and move it DX columns and DY host rows."
|
||||||
|
(desktop-demo-activate demo id)
|
||||||
|
(let ((pane (desktop-demo--window demo id)))
|
||||||
|
(desktop-demo-move demo id
|
||||||
|
(+ (desktop-demo-window-x pane) (* dx (frame-char-width)))
|
||||||
|
(+ (desktop-demo-window-y pane) (* dy (frame-char-height))))))
|
||||||
|
|
||||||
|
(defun desktop-demo-keymap (demo id &optional title)
|
||||||
|
"Create DEMO's pane ID keymap; TITLE enables native live dragging."
|
||||||
|
(let ((press (if title (lambda () (desktop-demo-drag demo id last-input-event))
|
||||||
|
(lambda () (desktop-demo-activate demo id)))))
|
||||||
|
(ebox-keymap-create
|
||||||
|
:activate (lambda () (desktop-demo-activate demo id))
|
||||||
|
:bindings
|
||||||
|
(append
|
||||||
|
(mapcar (lambda (event) (cons event press))
|
||||||
|
'([down-mouse-1] [double-down-mouse-1] [triple-down-mouse-1]))
|
||||||
|
(list (cons "M-<left>" (lambda () (desktop-demo--nudge demo id -1 0)))
|
||||||
|
(cons "M-<right>" (lambda () (desktop-demo--nudge demo id 1 0)))
|
||||||
|
(cons "M-<up>" (lambda () (desktop-demo--nudge demo id 0 -1)))
|
||||||
|
(cons "M-<down>" (lambda () (desktop-demo--nudge demo id 0 1))))))))
|
||||||
|
|
||||||
|
(defun desktop-demo-reset (demo)
|
||||||
|
"Restore DEMO's original positions and document-order stack in one update."
|
||||||
|
(let* ((candidate (copy-desktop-demo demo))
|
||||||
|
(panes (mapcar #'copy-desktop-demo-window (desktop-demo-windows demo)))
|
||||||
|
(ids (mapcar #'desktop-demo-window-id panes))
|
||||||
|
(active (car (last ids))) updates)
|
||||||
|
(cl-loop for pane in panes for depth from 1 do
|
||||||
|
(setf (desktop-demo-window-x pane) 0 (desktop-demo-window-y pane) 0)
|
||||||
|
(push (list (desktop-demo-window-id pane)
|
||||||
|
:left (desktop-demo-window-left pane)
|
||||||
|
:top (desktop-demo-window-top pane) :z-index depth) updates)
|
||||||
|
(setq updates
|
||||||
|
(append updates (desktop-demo--chrome
|
||||||
|
pane (equal active (desktop-demo-window-id pane))))))
|
||||||
|
(setf (desktop-demo-windows candidate) panes (desktop-demo-order candidate) ids
|
||||||
|
(desktop-demo-active candidate) active (desktop-demo-serial candidate) (length ids))
|
||||||
|
(desktop-demo--publish demo candidate updates)))
|
||||||
|
|
||||||
|
(defun desktop-demo-control (demo action)
|
||||||
|
"Create a native toolbar command for DEMO's ACTION."
|
||||||
|
(ebox-keymap-create
|
||||||
|
:activate
|
||||||
|
(lambda ()
|
||||||
|
(pcase action
|
||||||
|
('reset (desktop-demo-reset demo))
|
||||||
|
('next (desktop-demo-activate demo (car (desktop-demo-order demo))))
|
||||||
|
(_ (error "Unknown desktop action: %s" action))))))
|
||||||
|
|
||||||
|
(provide 'desktop-demo-reference)
|
||||||
|
;;; desktop-reference.el ends here
|
||||||
410
tests/ebox-playground-desktop-tests.el
Normal file
410
tests/ebox-playground-desktop-tests.el
Normal file
@ -0,0 +1,410 @@
|
|||||||
|
;;; ebox-playground-desktop-tests.el --- Desktop interaction regressions -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;; Drive the real example through rendered native commands. Drag streams are
|
||||||
|
;; deterministic Emacs events; every visible intermediate position is checked
|
||||||
|
;; with the existing committed-snapshot render oracle.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'ebox-playground)
|
||||||
|
(require 'ebox-playground-layer-tests
|
||||||
|
(expand-file-name "tests/ebox-playground-layer-tests.el"
|
||||||
|
ebox-playground-directory))
|
||||||
|
|
||||||
|
(defconst ebox-playground-desktop-test--file
|
||||||
|
(expand-file-name "examples/desktop-reference.ebox" ebox-playground-directory)
|
||||||
|
"Desktop example exercised through the ordinary file runner.")
|
||||||
|
|
||||||
|
(defvar ebox-playground-desktop-test--demo nil
|
||||||
|
"Business state captured from this test's real preview construction.")
|
||||||
|
|
||||||
|
(defvar ebox-playground-desktop-test--redisplays 0
|
||||||
|
"Redisplay requests issued during the current synthetic drag.")
|
||||||
|
|
||||||
|
(cl-defmacro ebox-playground-desktop-test--with-preview
|
||||||
|
((buffer &optional (width 120) (height 36)) &rest body)
|
||||||
|
"Evaluate BODY in an independent BUFFER preview of WIDTH and HEIGHT pixels."
|
||||||
|
(declare (indent 1) (debug ((symbolp &optional form form) body)))
|
||||||
|
`(let* ((,buffer (generate-new-buffer " *ebox-desktop-test*"))
|
||||||
|
(ebox-viewport-width ,width) (ebox-viewport-height ,height)
|
||||||
|
(ebox-runtime-idle-prewarm nil)
|
||||||
|
(ebox-runtime-idle-reflow-cache-prewarm nil)
|
||||||
|
(ebox-playground-desktop-test--demo nil)
|
||||||
|
(capture (lambda (demo)
|
||||||
|
(setq ebox-playground-desktop-test--demo demo))))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(advice-add 'desktop-demo-create :filter-return capture)
|
||||||
|
(ebox-playground-open-file
|
||||||
|
ebox-playground-desktop-test--file (buffer-name ,buffer))
|
||||||
|
(with-current-buffer ,buffer
|
||||||
|
(should ebox-playground-desktop-test--demo)
|
||||||
|
,@body))
|
||||||
|
(advice-remove 'desktop-demo-create capture)
|
||||||
|
(when (buffer-live-p ,buffer)
|
||||||
|
(ebox-playground-close (buffer-name ,buffer))))))
|
||||||
|
|
||||||
|
(defun ebox-playground-desktop-test--window (id)
|
||||||
|
"Return the captured business window identified by ID."
|
||||||
|
(cl-find id (desktop-demo-windows ebox-playground-desktop-test--demo)
|
||||||
|
:key #'desktop-demo-window-id :test #'equal))
|
||||||
|
|
||||||
|
(defun ebox-playground-desktop-test--offset (id)
|
||||||
|
"Return ID's committed pixel displacement."
|
||||||
|
(let ((window (ebox-playground-desktop-test--window id)))
|
||||||
|
(cons (desktop-demo-window-x window) (desktop-demo-window-y window))))
|
||||||
|
|
||||||
|
(defun ebox-playground-desktop-test--revision ()
|
||||||
|
"Return the current preview's committed publication revision."
|
||||||
|
(plist-get (ebox-surface-buffer-snapshot (current-buffer)) :revision))
|
||||||
|
|
||||||
|
(defun ebox-playground-desktop-test--state ()
|
||||||
|
"Copy the business values which must advance only after publication."
|
||||||
|
(let ((demo ebox-playground-desktop-test--demo))
|
||||||
|
(list (copy-sequence (desktop-demo-order demo))
|
||||||
|
(desktop-demo-active demo) (desktop-demo-serial demo)
|
||||||
|
(desktop-demo-dragging demo)
|
||||||
|
(mapcar (lambda (window)
|
||||||
|
(list (desktop-demo-window-id window)
|
||||||
|
(desktop-demo-window-x window)
|
||||||
|
(desktop-demo-window-y window)))
|
||||||
|
(desktop-demo-windows demo)))))
|
||||||
|
|
||||||
|
(defun ebox-playground-desktop-test--event (type window position xy &optional end)
|
||||||
|
"Create native TYPE at WINDOW POSITION XY, optionally ending at END."
|
||||||
|
(let ((start (list window position xy 0)))
|
||||||
|
(if end (list type start (list window position end 1))
|
||||||
|
(list type start))))
|
||||||
|
|
||||||
|
(defun ebox-playground-desktop-test--drag (label start events &optional type)
|
||||||
|
"Drag LABEL from START, reading EVENTS produced for its window and position.
|
||||||
|
EVENTS is called with the window and position. Each returned item is an event
|
||||||
|
or a function run before reading the next event, to inspect live publication.
|
||||||
|
TYPE defaults to `down-mouse-1'; repeated presses use their native event type."
|
||||||
|
(let* ((buffer (current-buffer))
|
||||||
|
(position (ebox-playground-layer-test--position label))
|
||||||
|
(map (get-text-property position 'keymap)))
|
||||||
|
(save-window-excursion
|
||||||
|
(set-window-buffer (selected-window) buffer)
|
||||||
|
(let* ((window (selected-window))
|
||||||
|
(down (ebox-playground-desktop-test--event
|
||||||
|
(or type 'down-mouse-1) window position start))
|
||||||
|
(queue (funcall events window position))
|
||||||
|
(command (key-binding (vector down) nil nil position))
|
||||||
|
(last-input-event down)
|
||||||
|
(ebox-playground-desktop-test--redisplays 0)
|
||||||
|
(unread-command-events nil))
|
||||||
|
(should (commandp command))
|
||||||
|
(should (eq command (lookup-key map (vector (or type 'down-mouse-1)))))
|
||||||
|
(cl-letf (((symbol-function 'read-event)
|
||||||
|
(lambda (&rest _)
|
||||||
|
(while (functionp (car queue)) (funcall (pop queue)))
|
||||||
|
(unless queue (ert-fail "Drag read beyond its terminal event"))
|
||||||
|
(pop queue)))
|
||||||
|
((symbol-function 'redisplay)
|
||||||
|
(lambda (&rest _) (cl-incf ebox-playground-desktop-test--redisplays))))
|
||||||
|
(call-interactively command nil (vector down)))
|
||||||
|
(should-not queue)
|
||||||
|
(should-not (desktop-demo-dragging ebox-playground-desktop-test--demo))
|
||||||
|
(ebox-playground-layer-test--parity)
|
||||||
|
unread-command-events))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-renders-five-independent-window-owners ()
|
||||||
|
"The example retains five window owners and visible dock controls at two widths."
|
||||||
|
(dolist (width '(80 120))
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer width)
|
||||||
|
(should (= (length (desktop-demo-windows ebox-playground-desktop-test--demo)) 5))
|
||||||
|
(dolist (id '("desk-studio" "desk-notes" "desk-signal" "desk-terminal" "desk-palette"))
|
||||||
|
(should (ebox-region-resolve buffer id)))
|
||||||
|
(dolist (label '("01 ST" "02 NT" "03 SG" "04 TM" "05 PL" "RESET" "CYCLE"))
|
||||||
|
(should (keymapp (get-text-property
|
||||||
|
(ebox-playground-layer-test--position label) 'keymap))))
|
||||||
|
(dolist (line (ebox-string-lines (buffer-string)))
|
||||||
|
(should (<= (ebox-string-pixel-width line) width)))
|
||||||
|
(ebox-playground-layer-test--parity))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-compact-viewport-keeps-all-dock-commands ()
|
||||||
|
"Every dock control remains visible and usable in a 40 by 20 viewport."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer 40 20)
|
||||||
|
(dolist (entry '(("01 ST" . "desk-studio") ("02 NT" . "desk-notes")
|
||||||
|
("03 SG" . "desk-signal") ("04 TM" . "desk-terminal")
|
||||||
|
("05 PL" . "desk-palette")))
|
||||||
|
(ebox-playground-layer-test--click (car entry))
|
||||||
|
(should (equal (desktop-demo-active ebox-playground-desktop-test--demo)
|
||||||
|
(cdr entry))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-repeated-keyboard-nudges-retain-dock-binding ()
|
||||||
|
"Repeated arrow commands keep their native dock binding without repositioning."
|
||||||
|
(dolist (key '("M-<right>" "M-<left>" "M-<up>" "M-<down>"))
|
||||||
|
(let ((report (ebox-playground-interaction-evaluator-run
|
||||||
|
ebox-playground-desktop-test--file "01 ST" key 3 104 36)))
|
||||||
|
(should (= (plist-get report :steps) 3))
|
||||||
|
(should (>= (plist-get report :publications) 3))
|
||||||
|
(should (plist-get report :fresh-parity)))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-repeated-title-presses-still-drag ()
|
||||||
|
"Double and triple title presses track movement using their native bindings."
|
||||||
|
(dolist (types '((double-down-mouse-1 . double-drag-mouse-1)
|
||||||
|
(triple-down-mouse-1 . triple-drag-mouse-1)))
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'mouse-movement window position '(12 . 9))
|
||||||
|
(ebox-playground-desktop-test--event
|
||||||
|
(cdr types) window position '(10 . 8) '(13 . 10))))
|
||||||
|
(car types))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(3 . 2))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-native-dock-raises-every-window ()
|
||||||
|
"Every dock command raises its entire window including its nested content."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(dolist (entry '(("01 ST" "desk-studio" "Make space for the unexpected.")
|
||||||
|
("02 NT" "desk-notes" "A quieter kind of focus.")
|
||||||
|
("03 SG" "desk-signal" "AFTER HOURS")
|
||||||
|
("04 TM" "desk-terminal" "$ build something good")
|
||||||
|
("05 PL" "desk-palette" "Objects in conversation.")))
|
||||||
|
(ebox-playground-layer-test--click (car entry))
|
||||||
|
(should (equal (desktop-demo-active ebox-playground-desktop-test--demo)
|
||||||
|
(cadr entry)))
|
||||||
|
(should (integerp (ebox-playground-layer-test--position (caddr entry)))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-front-window-click-does-not-publish ()
|
||||||
|
"Repeated activation of the front window is a publication no-op."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(let ((revision (ebox-playground-desktop-test--revision))
|
||||||
|
(state (ebox-playground-desktop-test--state)))
|
||||||
|
(ebox-playground-layer-test--click "Make space for the unexpected.")
|
||||||
|
(should (= revision (ebox-playground-desktop-test--revision)))
|
||||||
|
(should (equal state (ebox-playground-desktop-test--state))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-exposed-body-raises-covered-nested-content ()
|
||||||
|
"Clicking an exposed lower body restores its nested artwork above an overlapping pane."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer 80)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'drag-mouse-1 window position '(10 . 8) '(28 . 11)))))
|
||||||
|
(let ((artwork (ebox-playground-layer-test--coordinates "PLAY / 03")))
|
||||||
|
(ebox-playground-layer-test--activate "03 SG")
|
||||||
|
(should-not (string-match-p "PLAY / 03" (buffer-string)))
|
||||||
|
(ebox-playground-layer-test--click "Make space for the unexpected.")
|
||||||
|
(should (equal (desktop-demo-active ebox-playground-desktop-test--demo) "desk-studio"))
|
||||||
|
(should (equal artwork (ebox-playground-layer-test--coordinates "PLAY / 03")))
|
||||||
|
(ebox-playground-layer-test--activate "02 NT")
|
||||||
|
(ebox-playground-layer-test--click "PLAY / 03")
|
||||||
|
(should (equal (desktop-demo-active ebox-playground-desktop-test--demo) "desk-studio")))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-drag-publishes-each-motion-before-release ()
|
||||||
|
"Motion publishes immediately and release uses its endpoint, preserving grab offset."
|
||||||
|
(dolist (width '(80 120))
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer width)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list
|
||||||
|
(ebox-playground-desktop-test--event 'mouse-movement window position '(15 . 10))
|
||||||
|
(lambda ()
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(5 . 2)))
|
||||||
|
(should (desktop-demo-dragging ebox-playground-desktop-test--demo))
|
||||||
|
(should (>= ebox-playground-desktop-test--redisplays 2))
|
||||||
|
(ebox-playground-layer-test--parity))
|
||||||
|
(ebox-playground-desktop-test--event 'mouse-movement window position '(12 . 9))
|
||||||
|
(lambda ()
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(2 . 1)))
|
||||||
|
(should (>= ebox-playground-desktop-test--redisplays 3))
|
||||||
|
(ebox-playground-layer-test--parity))
|
||||||
|
(ebox-playground-desktop-test--event 'drag-mouse-1 window position '(10 . 8) '(16 . 11)))))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(6 . 3))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-repeated-motion-does-not-republish ()
|
||||||
|
"Identical pointer positions and a matching release produce only one publication."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(let ((revision (ebox-playground-desktop-test--revision)))
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event 'mouse-movement window position '(12 . 9))
|
||||||
|
(ebox-playground-desktop-test--event 'mouse-movement window position '(12 . 9))
|
||||||
|
(ebox-playground-desktop-test--event 'drag-mouse-1 window position '(10 . 8) '(12 . 9)))))
|
||||||
|
(should (= (1+ revision) (ebox-playground-desktop-test--revision))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-second-drag-starts-at-current-displacement ()
|
||||||
|
"A second grab adds its delta to the previously published window position."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(dolist (start '((10 . 8) (25 . 16)))
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" start
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'drag-mouse-1 window position start
|
||||||
|
(cons (+ (car start) 3) (1+ (cdr start))))))))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(6 . 2)))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-each-title-drags-its-own-window ()
|
||||||
|
"Each title's native drag binding moves its associated semantic owner."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(dolist (entry '(("01 ST" "STUDIO / 01" "desk-studio")
|
||||||
|
("02 NT" "NOTES / 02" "desk-notes")
|
||||||
|
("03 SG" "SIGNAL / 03" "desk-signal")
|
||||||
|
("04 TM" "TERMINAL / 04" "desk-terminal")
|
||||||
|
("05 PL" "PALETTE / 05" "desk-palette")))
|
||||||
|
(ebox-playground-layer-test--activate (car entry))
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
(cadr entry) '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'drag-mouse-1 window position '(10 . 8) '(11 . 9)))))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset (caddr entry)) '(1 . 1))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-reverse-drag-restores-original-paint ()
|
||||||
|
"Moving away and back restores original coordinates and committed render parity."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(let ((home (ebox-playground-layer-test--coordinates "STUDIO / 01")))
|
||||||
|
(dolist (end '((17 . 11) (3 . 5)))
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'drag-mouse-1 window position '(10 . 8) end)))))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(0 . 0)))
|
||||||
|
(should (equal home (ebox-playground-layer-test--coordinates "STUDIO / 01"))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-unrelated-event-stops-and-is-requeued ()
|
||||||
|
"Typing during a drag ends tracking and preserves the input for the command loop."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(should (equal (ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8) (lambda (_window _position) (list ?x)))
|
||||||
|
'(120)))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-quit-clears-dragging ()
|
||||||
|
"A quit signal exits tracking without leaving the demo in its dragging state."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(let ((caught nil))
|
||||||
|
(condition-case nil
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (_window _position) (list (lambda () (signal 'quit nil)))))
|
||||||
|
(quit (setq caught t)))
|
||||||
|
(should caught)
|
||||||
|
(should-not (desktop-demo-dragging ebox-playground-desktop-test--demo))
|
||||||
|
(ebox-playground-layer-test--parity))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-failed-activation-preserves-business-state ()
|
||||||
|
"A rejected publication leaves focus, ordering and all window positions unchanged."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "05 PL")
|
||||||
|
(let ((state (ebox-playground-desktop-test--state))
|
||||||
|
(revision (ebox-playground-desktop-test--revision)))
|
||||||
|
(dolist (failure-step '(text client-state))
|
||||||
|
(let* ((failed nil)
|
||||||
|
(tp--surface-publication-step-function
|
||||||
|
(lambda (step _surface)
|
||||||
|
(when (eq step failure-step)
|
||||||
|
(setq failed t)
|
||||||
|
(error "Injected desktop publication failure: %s" step)))))
|
||||||
|
(should-error (ebox-playground-layer-test--activate "01 ST"))
|
||||||
|
(should failed)))
|
||||||
|
(should (equal state (ebox-playground-desktop-test--state)))
|
||||||
|
(should (= revision (ebox-playground-desktop-test--revision)))
|
||||||
|
(ebox-playground-layer-test--parity))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-failed-motion-keeps-last-accepted-position ()
|
||||||
|
"A rejected live drag publication keeps geometry and clears transient tracking."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(let* ((revision (ebox-playground-desktop-test--revision))
|
||||||
|
(failed nil)
|
||||||
|
(tp--surface-publication-step-function
|
||||||
|
(lambda (step _surface)
|
||||||
|
(when (eq step 'client-state)
|
||||||
|
(setq failed t)
|
||||||
|
(error "Reject drag position")))))
|
||||||
|
(should-error
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'mouse-movement window position '(15 . 10))))))
|
||||||
|
(should failed)
|
||||||
|
(should-not (desktop-demo-dragging ebox-playground-desktop-test--demo))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(0 . 0)))
|
||||||
|
(should (= revision (ebox-playground-desktop-test--revision))))
|
||||||
|
(ebox-playground-layer-test--parity)))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-outside-release-ends-tracking ()
|
||||||
|
"Release over another window or frame area consumes the event and ends tracking."
|
||||||
|
(dolist (target '(window frame area))
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(let ((other (generate-new-buffer " *ebox-desktop-outside*")))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(with-current-buffer other (insert "Untouched other window"))
|
||||||
|
(should-not
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(let* ((other-window (split-window-right))
|
||||||
|
(where (if (eq target 'frame) (selected-frame) other-window)))
|
||||||
|
(set-window-buffer other-window other)
|
||||||
|
(list (list 'drag-mouse-1
|
||||||
|
(list window position '(10 . 8) 0)
|
||||||
|
(list where (if (eq target 'area) 'mode-line 1)
|
||||||
|
'(500 . 500) 1)))))))
|
||||||
|
(with-current-buffer other
|
||||||
|
(should (equal (buffer-string) "Untouched other window"))))
|
||||||
|
(kill-buffer other))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-reset-restores-all-window-positions ()
|
||||||
|
"Reset returns dragged windows to their original position and focus order."
|
||||||
|
(ebox-playground-desktop-test--with-preview (buffer)
|
||||||
|
(let ((initial-order (copy-sequence (desktop-demo-order ebox-playground-desktop-test--demo)))
|
||||||
|
(initial-active (desktop-demo-active ebox-playground-desktop-test--demo)))
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'drag-mouse-1 window position '(10 . 8) '(16 . 10)))))
|
||||||
|
(ebox-playground-layer-test--activate "RESET")
|
||||||
|
(dolist (window (desktop-demo-windows ebox-playground-desktop-test--demo))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset (desktop-demo-window-id window))
|
||||||
|
'(0 . 0))))
|
||||||
|
(should (equal initial-order (desktop-demo-order ebox-playground-desktop-test--demo)))
|
||||||
|
(should (equal initial-active (desktop-demo-active ebox-playground-desktop-test--demo))))))
|
||||||
|
|
||||||
|
(ert-deftest ebox-playground-desktop-previews-keep-independent-focus-and-position ()
|
||||||
|
"A second preview starts fresh while the first retains its focus and displacement."
|
||||||
|
(ebox-playground-desktop-test--with-preview (first 80)
|
||||||
|
(ebox-playground-layer-test--activate "01 ST")
|
||||||
|
(ebox-playground-desktop-test--drag
|
||||||
|
"STUDIO / 01" '(10 . 8)
|
||||||
|
(lambda (window position)
|
||||||
|
(list (ebox-playground-desktop-test--event
|
||||||
|
'drag-mouse-1 window position '(10 . 8) '(14 . 10)))))
|
||||||
|
(let ((first-demo ebox-playground-desktop-test--demo)
|
||||||
|
(state (ebox-playground-desktop-test--state)))
|
||||||
|
(ebox-playground-desktop-test--with-preview (second 120)
|
||||||
|
(should-not (eq first-demo ebox-playground-desktop-test--demo))
|
||||||
|
(should (equal (ebox-playground-desktop-test--offset "desk-studio") '(0 . 0)))
|
||||||
|
(ebox-playground-layer-test--activate "CYCLE")
|
||||||
|
(with-current-buffer first
|
||||||
|
(let ((ebox-playground-desktop-test--demo first-demo))
|
||||||
|
(should (equal state (ebox-playground-desktop-test--state)))
|
||||||
|
(ebox-playground-layer-test--parity)))))))
|
||||||
|
|
||||||
|
(provide 'ebox-playground-desktop-tests)
|
||||||
|
;;; ebox-playground-desktop-tests.el ends here
|
||||||
Loading…
Reference in New Issue
Block a user