geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

Add reactive system optimizations: batch updates, value transforms, debug mode

Browse Source 
- Add tp-with-batch-updates macro for deferring reactive updates
- Add :transform option for tp-text value transformation
- Add tp-debug-mode for tracing reactive updates
- Remove widget tests (moved to twidget repository)
- Remove widget documentation
- Add optimization documentation (CN/EN)
- Fix deep merge for reactive property updates

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-29 16:53:09 +00:00
parent 455721bbc1
commit 0b49e8202b
5 changed files with 770 additions and 887 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

212
docs/reactive-optimization-en.md Normal file
View File

@ -0,0 +1,212 @@
# tp.el Reactive System Optimization Documentation
This document describes the optimizations and enhancements made to the tp.el reactive system based on practical experience from the [twidget](https://github.com/Kinneyzhang/twidget.git) project.
## Optimization Suggestions Evaluation
The following evaluates and documents the implementation status of six optimization suggestions for the tp.el reactive system:
### 1. Granular Reactive Updates
**Suggestion**: Support partial updates within a region - only updating the reactive portion while preserving surrounding text properties.
**Evaluation**: Already implemented. tp.el uses `tp-intervals-map` and interval-based update mechanisms to support fine-grained property updates. Updates only affect regions with specific `tp-name` properties.
### 2. Reactive Symbol Cleanup ✅ Already Implemented
**Suggestion**: Add a mechanism to unregister reactive symbols when widgets are destroyed.
**Evaluation**: Already implemented. The `tp--unregister-reactive-deps` function handles cleanup:
- Called automatically when a layer is redefined
- Called automatically when a layer is undefined (`tp-undefine-layer`)
- Cleans up variable watchers, computed properties, and data variables
**Key functions**:
- `tp--unregister-reactive-deps`
- `tp--unregister-layer-watchers`
- `tp--unregister-layer-computed`
- `tp--unregister-layer-data`
### 3. Scoped Reactivity ✅ Already Implemented
**Suggestion**: Add instance/context scoping for reactive variables.
**Evaluation**: Already implemented. The `where` parameter supports buffer-local updates in:
- `tp--update-layer-regions`
- `tp--update-reactive-text`
When using `setq-local`, updates only affect the specific buffer.
### 4. Batched Updates 🆕 New Feature
**Suggestion**: When multiple reactive values change simultaneously, batch updates to avoid redundant buffer modifications.
**Implementation**: Added `tp-with-batch-updates` macro:
```elisp
;; Using batch updates
(tp-with-batch-updates
(setq my-color "red")
(setq my-size 14)
(setq my-text "Hello"))
;; All updates applied to buffer once at the end
```
**Key functions and variables**:
- `tp-with-batch-updates` - Batch update macro
- `tp--batch-update-active` - Flag indicating batch mode
- `tp--batch-update-pending` - List of pending updates
- `tp--flush-batch-updates` - Apply all pending updates
### 5. Value Transformation 🆕 New Feature
**Suggestion**: Allow registering transformation functions that run when tp-text updates.
**Implementation**: Added `:transform` option:
```elisp
;; Define a layer with transformation
(tp-define-layer 'currency-display
:props '(face bold tp-text $amount)
:data '((amount . "100"))
:transform (lambda (text)
(format "$%s.00" text)))
;; After application, 100 displays as $100.00
```
**Key functions and variables**:
- `tp-layer-transforms` - Stores layer transform functions
- Transforms applied in `tp--handle-tp-text-property` and `tp--update-reactive-text`
### 6. Debug Mode 🆕 New Feature
**Suggestion**: Add a debug mode to trace reactive updates.
**Implementation**: Added debug functionality:
```elisp
;; Enable debug mode
(setq tp-debug-mode t)
;; Also show debug info in minibuffer
(setq tp-debug-echo t)
;; View debug log
(tp-debug-show)
;; Clear debug log
(tp-debug-clear)
```
**Key functions and variables**:
- `tp-debug-mode` - Enable/disable debug mode
- `tp-debug-echo` - Whether to echo debug info to minibuffer
- `tp-debug-log` - Log debug information
- `tp-debug-show` - Show debug buffer
- `tp-debug-clear` - Clear debug log
Debug log includes:
- Variable change notifications (old → new value)
- Layer update tracking
- Batch update start/end
- Transform application info
## New Features in Detail
### Batch Updates (tp-with-batch-updates)
When modifying multiple reactive variables simultaneously, use batch updates to avoid multiple buffer updates:
```elisp
(tp-define-layer 'themed-text
:props '(face (:foreground $fg-color :background $bg-color))
:data '((fg-color . "white") (bg-color . "black")))
(with-temp-buffer
(insert "Hello World")
(tp-set 1 12 'themed-text)
;; Without batching: each setq triggers a buffer update
(setq fg-color "yellow") ; First update
(setq bg-color "navy") ; Second update
;; With batching: all changes applied once at the end
(tp-with-batch-updates
(setq fg-color "red")
(setq bg-color "blue"))) ; Only one update
```
### Value Transformation (:transform)
Transform functions allow processing tp-text values before display:
```elisp
;; Number formatting
(tp-define-layer 'price-display
:props '(tp-text $price)
:data '((price . "99.9"))
:transform (lambda (text)
(format "$%.2f" (string-to-number text))))
;; Date formatting
(tp-define-layer 'date-display
:props '(tp-text $timestamp)
:data '((timestamp . "1703865600"))
:transform (lambda (text)
(format-time-string "%Y-%m-%d"
(seconds-to-time (string-to-number text)))))
;; Uppercase conversion
(tp-define-layer 'uppercase-text
:props '(tp-text $content)
:data '((content . "hello"))
:transform #'upcase)
```
### Debug Mode
Debug mode helps developers understand the reactive update flow:
```elisp
;; Enable full debugging
(setq tp-debug-mode t)
(setq tp-debug-echo t)
;; Define and use a reactive layer
(tp-define-layer 'test-layer
:props '(face (:foreground $my-color))
:data '((my-color . "red")))
(with-temp-buffer
(insert "Test")
(tp-set 1 5 'test-layer)
(setq my-color "blue"))
;; Example debug output:
;; [12:34:56.789] Variable my-color changed: "red" -> "blue" (where: global)
;; [12:34:56.790] Updating layer test-layer (tp-text affected: no)
```
## Architecture Notes
These optimizations follow tp.el's layered architecture principles:
1. **Debug Mode** - Basic utility layer functionality
2. **Batch Updates** - Implemented in the reactive system layer
3. **Value Transformation** - Implemented in layer definition and reactive text handling
All new features integrate seamlessly with the existing reactive system without breaking existing APIs.
## Function Reference
| Function/Variable | Description |
|------------------|-------------|
| `tp-debug-mode` | Enable debug mode |
| `tp-debug-echo` | Enable minibuffer debug output |
| `tp-debug-log` | Log debug information |
| `tp-debug-show` | Show debug buffer |
| `tp-debug-clear` | Clear debug log |
| `tp-with-batch-updates` | Batch update macro |
| `tp-layer-transforms` | Layer transform function storage |
| `:transform` | Transform option in layer definition |

212
docs/reactive-optimization.md Normal file
View File

@ -0,0 +1,212 @@
# tp.el 响应式系统优化文档
本文档基于 [twidget](https://github.com/Kinneyzhang/twidget.git) 项目的实践经验，对 tp.el 的响应式系统进行了优化和增强。
## 优化建议评估
以下是针对 tp.el 响应式系统的六项优化建议的评估和实现情况：
### 1. 细粒度响应式更新（Granular Reactive Updates）
**建议**：支持区域内的部分更新，只更新响应式部分，保留周围文本属性。
**评估**：已经实现。tp.el 通过 `tp-intervals-map` 和基于区间的更新机制，已经支持细粒度的属性更新。更新只影响具有特定 `tp-name` 的区域。
### 2. 响应式符号清理（Reactive Symbol Cleanup）✅ 已实现
**建议**：当 widget 销毁时，添加注销响应式符号的机制。
**评估**：已经实现。`tp--unregister-reactive-deps` 函数负责清理：
- 当层被重新定义时自动调用
- 当层被取消定义（`tp-undefine-layer`）时自动调用
- 清理变量监听器、计算属性和数据变量
**关键函数**：
- `tp--unregister-reactive-deps`
- `tp--unregister-layer-watchers`
- `tp--unregister-layer-computed`
- `tp--unregister-layer-data`
### 3. 作用域响应式（Scoped Reactivity）✅ 已实现
**建议**：为响应式变量添加实例/上下文作用域。
**评估**：已经实现。`where` 参数在以下函数中支持缓冲区局部更新：
- `tp--update-layer-regions`
- `tp--update-reactive-text`
当使用 `setq-local` 时，更新只影响特定缓冲区。
### 4. 批量更新（Batched Updates）🆕 新增
**建议**：当多个响应式值同时变化时，批量处理更新以避免冗余的缓冲区修改。
**实现**：新增 `tp-with-batch-updates` 宏：
```elisp
;; 使用批量更新
(tp-with-batch-updates
(setq my-color "red")
(setq my-size 14)
(setq my-text "Hello"))
;; 所有更新在批量结束后一次性应用到缓冲区
```
**关键函数和变量**：
- `tp-with-batch-updates` - 批量更新宏
- `tp--batch-update-active` - 标记是否在批量更新中
- `tp--batch-update-pending` - 待处理的更新列表
- `tp--flush-batch-updates` - 应用所有待处理更新
### 5. 值转换（Value Transformation）🆕 新增
**建议**：允许注册转换函数，在 tp-text 更新时运行。
**实现**：新增 `:transform` 选项：
```elisp
;; 定义带转换的层
(tp-define-layer 'currency-display
:props '(face bold tp-text $amount)
:data '((amount . "100"))
:transform (lambda (text)
(format "$%s.00" text)))
;; 使用后，100 会显示为 $100.00
```
**关键函数和变量**：
- `tp-layer-transforms` - 存储层转换函数
- 转换在 `tp--handle-tp-text-property` 和 `tp--update-reactive-text` 中应用
### 6. 调试模式（Debug Mode）🆕 新增
**建议**：添加调试模式以追踪响应式更新。
**实现**：新增调试功能：
```elisp
;; 启用调试模式
(setq tp-debug-mode t)
;; 同时在 minibuffer 显示调试信息
(setq tp-debug-echo t)
;; 查看调试日志
(tp-debug-show)
;; 清除调试日志
(tp-debug-clear)
```
**关键函数和变量**：
- `tp-debug-mode` - 启用/禁用调试模式
- `tp-debug-echo` - 是否在 minibuffer 显示调试信息
- `tp-debug-log` - 记录调试信息
- `tp-debug-show` - 显示调试缓冲区
- `tp-debug-clear` - 清除调试日志
调试日志包含：
- 变量变化通知（旧值 → 新值）
- 层更新追踪
- 批量更新开始/结束
- 转换应用信息
## 新增功能详解
### 批量更新 (tp-with-batch-updates)
当需要同时修改多个响应式变量时，使用批量更新可以避免多次缓冲区更新：
```elisp
(tp-define-layer 'themed-text
:props '(face (:foreground $fg-color :background $bg-color))
:data '((fg-color . "white") (bg-color . "black")))
(with-temp-buffer
(insert "Hello World")
(tp-set 1 12 'themed-text)
;; 不使用批量更新：每个 setq 都会触发一次缓冲区更新
(setq fg-color "yellow") ; 第一次更新
(setq bg-color "navy") ; 第二次更新
;; 使用批量更新：所有变化在结束时一次性应用
(tp-with-batch-updates
(setq fg-color "red")
(setq bg-color "blue"))) ; 只更新一次
```
### 值转换 (:transform)
转换函数允许在显示前处理 tp-text 的值：
```elisp
;; 数字格式化
(tp-define-layer 'price-display
:props '(tp-text $price)
:data '((price . "99.9"))
:transform (lambda (text)
(format "$%.2f" (string-to-number text))))
;; 日期格式化
(tp-define-layer 'date-display
:props '(tp-text $timestamp)
:data '((timestamp . "1703865600"))
:transform (lambda (text)
(format-time-string "%Y-%m-%d"
(seconds-to-time (string-to-number text)))))
;; 大写转换
(tp-define-layer 'uppercase-text
:props '(tp-text $content)
:data '((content . "hello"))
:transform #'upcase)
```
### 调试模式
调试模式帮助开发者理解响应式更新流程：
```elisp
;; 启用完整调试
(setq tp-debug-mode t)
(setq tp-debug-echo t)
;; 定义和使用响应式层
(tp-define-layer 'test-layer
:props '(face (:foreground $my-color))
:data '((my-color . "red")))
(with-temp-buffer
(insert "Test")
(tp-set 1 5 'test-layer)
(setq my-color "blue"))
;; 调试输出示例：
;; [12:34:56.789] Variable my-color changed: "red" -> "blue" (where: global)
;; [12:34:56.790] Updating layer test-layer (tp-text affected: no)
```
## 架构说明
这些优化遵循 tp.el 的分层架构原则：
1. **调试模式** - 作为基础工具层功能
2. **批量更新** - 在响应式系统层实现
3. **值转换** - 在层定义和响应式文本处理中实现
所有新功能都与现有的响应式系统无缝集成，不破坏现有 API。
## 相关函数一览
| 函数/变量 | 描述 |
|----------|------|
| `tp-debug-mode` | 启用调试模式 |
| `tp-debug-echo` | 启用 minibuffer 调试输出 |
| `tp-debug-log` | 记录调试信息 |
| `tp-debug-show` | 显示调试缓冲区 |
| `tp-debug-clear` | 清除调试日志 |
| `tp-with-batch-updates` | 批量更新宏 |
| `tp-layer-transforms` | 层转换函数存储 |
| `:transform` | 层定义中的转换选项 |

426
docs/widget-optimization-proposals.md
View File

@ -1,426 +0,0 @@
# 组件优化提案文档（Widget Optimization Proposals）
本文档基于当前 `tp-define-widget` 的实现，参考 Vue3 组合式 API 的设计理念，提出一系列优化和扩展方案。
## 当前实现
### 现有特性
- `:props` - 支持属性定义，包含默认值 `(prop . default)`
- `:slot` - 布尔值，`t` 表示支持 slot，`nil` 表示不支持
- `:render` - 渲染函数 `(lambda (props slot) ...)`
- 支持多个 slot 值（字符串和嵌套组件）
---
## 优化提案
### 1. 生命周期钩子（Lifecycle Hooks）
**参考**: Vue3 的 `onMounted`, `onBeforeUpdate`, `onUpdated` 等
**功能描述**:
```elisp
(tp-define-widget my-widget
:props '(value)
:slot t
:on-render (lambda (props slot) ...) ; 渲染前
:on-rendered (lambda (result) ...) ; 渲染后
:render (lambda (props slot) ...))
```
**作用**:
- 在渲染前后执行特定逻辑（如日志记录、性能监控）
- 支持渲染结果的后处理
**是否必要**: ⭐⭐ 低优先级
- 目前可通过在 render 函数中处理
- 如果组件变得复杂且需要统一的渲染管道处理，则有价值
---
### 2. 命名插槽（Named Slots） ✅ 已实现
**参考**: Vue3 的 `<slot name="header">`, `v-slot:header`
**功能描述**:
```elisp
(tp-define-widget card
:props '(title)
:slots '(header content footer) ; 定义多个命名插槽
:render (lambda (props slots)
(concat (plist-get slots :header)
"\n"
(plist-get slots :content)
"\n"
(plist-get slots :footer))))
;; 使用 - 通过 (slot-<name> content...) sexp 格式传递内容
(tp-widget-parse
'(card :title "My Card"
(slot-header "Header Content")
(slot-content "Main Content")
(slot-footer "Footer")))
;; 命名插槽也支持嵌套组件
(tp-widget-parse
'(layout (slot-left (emphasis "Bold Text"))
(slot-right "Plain Text")))
```
**作用**:
- 支持更灵活的内容分发
- 组件可以有多个内容区域
**状态**: ✅ 已实现
---
### 3. 作用域插槽（Scoped Slots）
**参考**: Vue3 的作用域插槽，允许父组件访问子组件数据
**功能描述**:
```elisp
(tp-define-widget list-item
:props '(items)
:slot t ; slot 可以是函数
:render (lambda (props slot-fn)
(mapconcat
(lambda (item)
;; slot-fn 可以访问当前 item
(funcall slot-fn item))
(plist-get props :items)
"\n")))
;; 使用
(tp-widget-parse
'(list-item :items ("apple" "banana" "orange")
(lambda (item)
(tp-set item 'face 'bold))))
```
**作用**:
- 父组件可以访问子组件的内部数据
- 更灵活的渲染控制
**是否必要**: ⭐⭐ 低优先级
- 增加复杂度
- Emacs Lisp 的闭包可以部分实现此功能
---
### 4. 组件继承/组合（Component Inheritance/Composition） ✅ 已实现
**参考**: Vue3 的 `mixins`, `extends`
**功能描述**:
```elisp
(tp-define-widget base-button
:props '((type . "default"))
:slot t
:render (lambda (props slot)
(tp-set slot 'face 'button)))
(tp-define-widget primary-button
:extends 'base-button
:props '((type . "primary")) ; 覆盖默认值
:render (lambda (props slot parent-render)
(let ((result (funcall parent-render props slot)))
(tp-add result 'face '(:foreground "blue")))))
;; 支持多级继承链
(tp-define-widget grandparent
:slot t
:render (lambda (_props slot) (concat "[GP:" slot "]")))
(tp-define-widget parent
:extends 'grandparent
:render (lambda (_props slot parent-render)
(funcall parent-render nil (concat "P:" slot))))
(tp-define-widget child
:extends 'parent
:render (lambda (_props slot parent-render)
(funcall parent-render nil (concat "C:" slot))))
;; (tp-widget-parse '(child "text")) => "[GP:P:C:text]"
```
**特性**:
- `:extends` 指定父组件
- 子组件继承父组件的 `:props` 和 `:slot`
- 子组件的 `:props` 覆盖父组件的默认值
- 渲染函数接收 `parent-render` 参数，可调用父组件的渲染逻辑
- 支持多级继承链
**作用**:
- 代码复用
- 创建组件变体
**状态**: ✅ 已实现
---
### 5. 响应式状态（Reactive State）
**参考**: Vue3 的 `ref`, `reactive`
**功能描述**:
```elisp
(tp-define-widget counter
:state '((count . 0)) ; 组件内部状态
:slot t
:render (lambda (props state slot)
(let ((count (plist-get state :count)))
(format "Count: %d %s" count slot))))
;; 状态更新时自动重新渲染
(tp-widget-update 'counter :count 5)
```
**作用**:
- 组件拥有自己的内部状态
- 与现有的响应式系统（`$variable`）集成
**是否必要**: ⭐⭐⭐⭐ 高优先级
- 对于交互式组件非常重要
- 可以利用现有的 tp reactive 系统
---
### 6. 事件系统（Event System）
**参考**: Vue3 的 `$emit`, `v-on`
**功能描述**:
```elisp
(tp-define-widget button
:props '(label)
:emits '(click hover) ; 声明可触发的事件
:slot t
:render (lambda (props slot emit)
(tp-add slot
'mouse-1 (lambda () (funcall emit :click))
'pointer 'hand)))
;; 使用
(tp-widget-parse
'(button :label "Click Me"
:on-click (lambda () (message "Clicked!"))
"Submit"))
```
**作用**:
- 组件间通信
- 事件驱动的交互
**是否必要**: ⭐⭐⭐⭐ 高优先级
- 对于交互式 UI 必要
- 支持按钮、链接等组件的回调
---
### 7. 依赖注入（Provide/Inject）
**参考**: Vue3 的 `provide`, `inject`
**功能描述**:
```elisp
(tp-define-widget theme-provider
:provide '(theme) ; 向下提供
:props '((theme . "dark"))
:slot t
:render (lambda (props slot) slot))
(tp-define-widget themed-text
:inject '(theme) ; 从上层获取
:slot t
:render (lambda (props slot injected)
(let ((theme (plist-get injected :theme)))
(tp-set slot 'face
(if (equal theme "dark")
'(:foreground "white" :background "black")
'(:foreground "black" :background "white"))))))
```
**作用**:
- 跨层级的数据传递
- 主题、配置等全局状态的共享
**是否必要**: ⭐⭐ 低优先级
- Emacs 可以使用动态绑定实现
- 如果组件树很深，可能有价值
---
### 8. 条件渲染辅助（Conditional Rendering Helpers）
**参考**: Vue3 的 `v-if`, `v-show`, `v-for`
**功能描述**:
```elisp
;; 辅助函数
(defun tp-if (condition then &optional else)
"条件渲染"
(if condition then (or else "")))
(defun tp-for (items template)
"列表渲染"
(mapconcat template items ""))
;; 使用
(tp-define-widget user-list
:props '(users show-email)
:render (lambda (props _slot)
(tp-for (plist-get props :users)
(lambda (user)
(concat (plist-get user :name)
(tp-if (plist-get props :show-email)
(format " <%s>" (plist-get user :email))))))))
```
**作用**:
- 简化常见的渲染模式
- 提高代码可读性
**是否必要**: ⭐⭐⭐ 中等优先级
- 作为辅助函数很有用
- 可以独立于核心组件系统实现
---
### 9. 插槽类型验证（Slot Type Validation）
**功能描述**:
```elisp
(tp-define-widget container
:slot 'string ; 只接受字符串
;; 或
:slot '(string widget) ; 接受字符串和组件
;; 或
:slot '(widget button text) ; 只接受特定组件
:render ...)
```
**作用**:
- 类型安全
- 更好的错误提示
**是否必要**: ⭐⭐ 低优先级
- 开发时有用
- 可能影响性能
---
### 10. 异步组件（Async Components）
**参考**: Vue3 的 `defineAsyncComponent`
**功能描述**:
```elisp
(tp-define-async-widget remote-content
:props '(url)
:loading "Loading..."
:error "Failed to load"
:render (lambda (props slot)
(url-retrieve-synchronously (plist-get props :url))
...))
```
**作用**:
- 支持异步数据加载
- 加载和错误状态处理
**是否必要**: ⭐ 最低优先级
- Emacs 的异步模型与 Web 不同
- 可能需要使用 `url-retrieve` 和回调
---
## 优先级总结
| 优化项 | 优先级 | 复杂度 | 价值 | 状态 |
|-------|-------|-------|-----|------|
| 响应式状态 | ⭐⭐⭐⭐ | 中 | 高 | 待实现 |
| 事件系统 | ⭐⭐⭐⭐ | 中 | 高 | 待实现 |
| 命名插槽 | ⭐⭐⭐ | 低 | 中 | ✅ 已实现 |
| 组件继承 | ⭐⭐⭐ | 中 | 中 | ✅ 已实现 |
| 条件渲染辅助 | ⭐⭐⭐ | 低 | 中 | 待实现 |
| 生命周期钩子 | ⭐⭐ | 低 | 低 | 待实现 |
| 作用域插槽 | ⭐⭐ | 高 | 中 | 待实现 |
| 依赖注入 | ⭐⭐ | 中 | 低 | 待实现 |
| 类型验证 | ⭐⭐ | 低 | 低 | 待实现 |
| 异步组件 | ⭐ | 高 | 低 | 待实现 |
---
## 建议实施顺序
1. **第一阶段**: 事件系统 + 响应式状态集成
- 这两个特性对交互式组件最重要
- 可以利用现有的 tp reactive 系统
2. **第二阶段**: ~~命名插槽~~ ✅ + 条件渲染辅助
- ~~提升组件的灵活性和开发体验~~
- 命名插槽已实现
3. **第三阶段**: ~~组件继承~~ ✅ + 生命周期钩子
- ~~对于构建组件库有价值~~
- 组件继承已实现
4. **第四阶段**: 其他高级特性
- 根据实际需求决定
---
## 示例：完整的组件定义（理想状态）
```elisp
(tp-define-widget button
;; 属性定义
:props '(action
(type . "default")
(size . "medium")
(disabled . nil))
;; 状态（响应式）
:state '((loading . nil)
(focused . nil))
;; 支持插槽
:slot t
;; 可触发的事件
:emits '(click focus blur)
;; 生命周期
:on-render (lambda (props)
(unless (plist-get props :disabled)
(message "Button rendering...")))
;; 渲染函数
:render (lambda (props state slot emit)
(let* ((type (plist-get props :type))
(size (plist-get props :size))
(disabled (plist-get props :disabled))
(loading (plist-get state :loading))
(content (if loading "Loading..." slot))
(face (cond
(disabled '(:foreground "gray"))
((equal type "primary") '(:foreground "white" :background "blue"))
((equal type "danger") '(:foreground "white" :background "red"))
(t '(:foreground "black" :background "#eee")))))
(tp-add content
'face face
'mouse-1 (unless disabled
(lambda ()
(funcall emit :click)
(funcall (plist-get props :action))))
'pointer (unless disabled 'hand)))))
```
---
## 结论
当前的组件系统已经具备基本功能。上述优化提案可以根据实际使用场景和需求逐步实施。建议从**事件系统**和**响应式状态集成**开始，因为这两个特性对于构建交互式 UI 组件最为重要。

521
tp-tests.el
View File

@ -3430,426 +3430,149 @@ When using tp-set (direct property setting), tp-name is NOT added."
(should (get-text-property 0 'face result)))))
;;; ============================================================
;;; Twidget (Text Widget) Tests
;;; Batched Updates Tests
;;; ============================================================
(ert-deftest tp-test-define-twidget-basic ()
"Test basic twidget definition."
(ert-deftest tp-test-batch-updates-basic ()
"Test that tp-with-batch-updates defers reactive updates."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget test-widget
:props '(name)
:slot t
:render (lambda (props slot)
(concat "Hello " (plist-get props :name) ": " slot)))
(should (assoc 'test-widget tp-widget-alist))
(let ((def (cdr (assoc 'test-widget tp-widget-alist))))
(should (equal (plist-get def :props) '(name)))
(should (equal (plist-get def :slot) t)))))
(unwind-protect
(progn
;; Define a reactive layer
(tp-define-layer 'test-batch-layer
:props '(face (:foreground $tp-test-batch-color))
:data '((tp-test-batch-color . "red")))
(insert "Hello World")
(tp-set 1 6 'test-batch-layer)
;; Initial color should be red
(should (equal (plist-get (tp-at 1 'face) :foreground) "red"))
;; Now use batch updates
(tp-with-batch-updates
(setq tp-test-batch-color "blue")
;; Inside batch, layer definition is updated but buffer may not be
;; (implementation note: the layer props are always updated immediately)
)
;; After batch ends, buffer should be updated
(should (equal (plist-get (tp-at 1 'face) :foreground) "blue")))
;; Cleanup
(ignore-errors (makunbound 'tp-test-batch-color)))))
(ert-deftest tp-test-widget-parse-basic ()
"Test basic widget parsing."
(ert-deftest tp-test-batch-updates-multiple-vars ()
"Test that tp-with-batch-updates consolidates multiple variable changes."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget greeting
:props '(name)
:slot t
:render (lambda (props slot)
(concat "Hello " (plist-get props :name) "! " slot)))
(let ((result (tp-widget-parse '(greeting :name "World" "Nice to meet you"))))
(should (equal result "Hello World! Nice to meet you")))))
(ert-deftest tp-test-widget-parse-with-default ()
"Test widget parsing with default prop values."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget styled-text
:props '((color . "blue") message)
:slot t
:render (lambda (props slot)
(let ((color (plist-get props :color))
(msg (plist-get props :message)))
(format "[%s] %s: %s" color (or msg "default") slot))))
;; Test with default color
(let ((result (tp-widget-parse '(styled-text "content"))))
(should (equal result "[blue] default: content")))
;; Test with overridden color
(let ((result (tp-widget-parse '(styled-text :color "red" "content"))))
(should (equal result "[red] default: content")))
;; Test with both props
(let ((result (tp-widget-parse '(styled-text :color "green" :message "info" "content"))))
(should (equal result "[green] info: content")))))
(ert-deftest tp-test-widget-parse-with-text-properties ()
"Test widget parsing with text properties."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Define a simple widget that applies text properties
(tp-define-twidget bold-text
:props '((color . "black"))
:slot t
:render (lambda (props slot)
(let ((color (plist-get props :color)))
(tp-set slot 'face `(:foreground ,color :weight bold)))))
(let ((result (tp-widget-parse '(bold-text :color "red" "Hello"))))
(should (stringp result))
(should (equal (substring-no-properties result) "Hello"))
(let ((face (get-text-property 0 'face result)))
(should (equal (plist-get face :foreground) "red"))
(should (eq (plist-get face :weight) 'bold))))))
(ert-deftest tp-test-widget-parse-button-example ()
"Test the button widget example from the problem statement."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; First define the tp-space layer (from problem statement)
(define-tp tp-space (pixel)
`(display (space :width (,pixel))))
;; Define the button widget similar to the example
;; Note: Using tp-button as the property name to match problem statement
(tp-define-twidget button
:props '(action (bgcolor . "green"))
:slot t
:render (lambda (props slot)
(let ((action (plist-get props :action))
(bgcolor (plist-get props :bgcolor)))
(tp-add (format "%s%s%s"
(tp-set " " 'tp-space 2)
slot (tp-set " " 'tp-space 2))
'face `(:background ,bgcolor)
'tp-button `(:action ,action)))))
;; Parse the button widget
(let ((result (tp-widget-parse
'(button :action (lambda ()
(interactive)
(message "clicked!"))
"CLICK"))))
(should (stringp result))
;; Check that the face property is applied
(let ((face (get-text-property 2 'face result)))
(should (equal (plist-get face :background) "green")))
;; Check that the tp-button property is applied (matches problem statement)
(let ((action-prop (get-text-property 2 'tp-button result)))
(should (listp (plist-get action-prop :action)))))))
(ert-deftest tp-test-widget-reset ()
"Test widget reset clears all definitions."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget test-widget1
:props '(a)
:slot t
:render (lambda (p s) ""))
(tp-define-twidget test-widget2
:props '(c)
:slot t
:render (lambda (p s) ""))
(should (= (length tp-widget-alist) 2))
(tp-widget-reset)
(should (= (length tp-widget-alist) 0))))
(ert-deftest tp-test-widget-parse-error-undefined ()
"Test widget parse with undefined widget raises error."
(tp-test-with-temp-buffer
(tp-widget-reset)
(should-error (tp-widget-parse '(undefined-widget "content")))))
(ert-deftest tp-test-widget-multiple-props ()
"Test widget with multiple props including defaults."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget multi-prop
:props '(required (opt1 . "default1") (opt2 . "default2"))
:slot t
:render (lambda (props slot)
(format "%s|%s|%s|%s"
(plist-get props :required)
(plist-get props :opt1)
(plist-get props :opt2)
slot)))
;; All defaults
(let ((result (tp-widget-parse '(multi-prop :required "req" "slot"))))
(should (equal result "req|default1|default2|slot")))
;; Override one default
(let ((result (tp-widget-parse '(multi-prop :required "req" :opt1 "custom1" "slot"))))
(should (equal result "req|custom1|default2|slot")))
;; Override all
(let ((result (tp-widget-parse '(multi-prop :required "req" :opt1 "c1" :opt2 "c2" "slot"))))
(should (equal result "req|c1|c2|slot")))))
(ert-deftest tp-test-widget-multiple-slots ()
"Test widget with multiple slot values."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget container
:slot t
:render (lambda (_props slot) (format "[%s]" slot)))
(let ((result (tp-widget-parse '(container "hello " "world"))))
(should (equal result "[hello world]")))))
(ert-deftest tp-test-widget-nested-widgets ()
"Test widget with nested widget forms in slot."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Define parent container
(tp-define-twidget p
:slot t
:render (lambda (_props slot) slot))
;; Define text wrapper
(tp-define-twidget text
:slot t
:render (lambda (_props slot)
(tp-set slot 'face 'bold)))
;; Define button widget
(tp-define-twidget button
:props '(action (bgcolor . "orange"))
:slot t
:render (lambda (props slot)
(let ((bgcolor (plist-get props :bgcolor)))
(tp-add slot 'tp-button `(:bgcolor ,bgcolor)))))
;; Test nested widgets (example from problem statement)
(let ((result (tp-widget-parse
'(p "happy hacking "
(text "emacs")
(button :action (lambda () (message "clicked!"))
"click")))))
(should (stringp result))
(should (equal (substring-no-properties result) "happy hacking emacsclick"))
;; Check that "emacs" part has bold face
(should (eq (get-text-property 14 'face result) 'bold))
;; Check that "click" part has tp-button property
(should (get-text-property 19 'tp-button result)))))
(ert-deftest tp-test-widget-no-slot ()
"Test widget without slot support."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Widget without :slot defined (defaults to nil)
(tp-define-twidget static-widget
:props '((text . "default text"))
:render (lambda (props _slot)
(plist-get props :text)))
;; Slot values should be ignored
(let ((result (tp-widget-parse '(static-widget :text "hello" "ignored"))))
(should (equal result "hello")))))
(ert-deftest tp-test-widget-slot-boolean-false ()
"Test widget with :slot nil explicitly."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget no-slot-widget
:props '(value)
:slot nil
:render (lambda (props slot)
(format "%s (slot: %s)" (plist-get props :value) slot)))
;; Slot should be nil even if arguments are provided
(let ((result (tp-widget-parse '(no-slot-widget :value "test" "ignored slot"))))
(should (equal result "test (slot: nil)")))))
(unwind-protect
(progn
;; Define a reactive layer with multiple vars
(tp-define-layer 'test-multi-batch
:props '(face (:foreground $tp-test-fg :background $tp-test-bg))
:data '((tp-test-fg . "white") (tp-test-bg . "black")))
(insert "Hello World")
(tp-set 1 6 'test-multi-batch)
;; Use batch updates
(tp-with-batch-updates
(setq tp-test-fg "yellow")
(setq tp-test-bg "navy"))
;; Both should be updated
(should (equal (plist-get (tp-at 1 'face) :foreground) "yellow"))
(should (equal (plist-get (tp-at 1 'face) :background) "navy")))
;; Cleanup
(ignore-errors (makunbound 'tp-test-fg))
(ignore-errors (makunbound 'tp-test-bg)))))
;;; ============================================================
;;; Named Slots Tests
;;; Debug Mode Tests
;;; ============================================================
(ert-deftest tp-test-widget-named-slots-basic ()
"Test widget with named slots."
(ert-deftest tp-test-debug-mode-logs ()
"Test that debug mode logs to *tp-debug* buffer."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget card
:slots '(header content footer)
:render (lambda (_props slots)
(concat (or (plist-get slots :header) "")
"|"
(or (plist-get slots :content) "")
"|"
(or (plist-get slots :footer) ""))))
(let ((result (tp-widget-parse
'(card (slot-header "Title")
(slot-content "Body")
(slot-footer "End")))))
(should (equal result "Title|Body|End")))))
(let ((tp-debug-mode t)
(tp-debug-echo nil))
;; Clear any existing debug buffer
(tp-debug-clear)
;; Log a message
(tp-debug-log "Test message %d" 42)
;; Check the debug buffer
(with-current-buffer (get-buffer "*tp-debug*")
(should (string-match-p "Test message 42" (buffer-string)))))))
(ert-deftest tp-test-widget-named-slots-partial ()
"Test widget with partial named slots."
(ert-deftest tp-test-debug-mode-disabled ()
"Test that debug mode does not log when disabled."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget card
:slots '(header content footer)
:render (lambda (_props slots)
(concat (or (plist-get slots :header) "[no-header]")
"|"
(or (plist-get slots :content) "[no-content]")
"|"
(or (plist-get slots :footer) "[no-footer]"))))
;; Only provide some slots
(let ((result (tp-widget-parse '(card (slot-content "Main")))))
(should (equal result "[no-header]|Main|[no-footer]")))))
(ert-deftest tp-test-widget-named-slots-with-props ()
"Test widget with both props and named slots."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget article
:props '((title . "Untitled") author)
:slots '(intro body)
:render (lambda (props slots)
(format "# %s by %s\n%s\n%s"
(plist-get props :title)
(or (plist-get props :author) "Anonymous")
(or (plist-get slots :intro) "")
(or (plist-get slots :body) ""))))
(let ((result (tp-widget-parse
'(article :title "My Post"
:author "John"
(slot-intro "Introduction...")
(slot-body "Main content...")))))
(should (equal result "# My Post by John\nIntroduction...\nMain content...")))))
(ert-deftest tp-test-widget-named-slots-with-nested-widgets ()
"Test named slots containing nested widgets."
(tp-test-with-temp-buffer
(tp-widget-reset)
(tp-define-twidget emphasis
:slot t
:render (lambda (_props slot)
(concat "*" slot "*")))
(tp-define-twidget layout
:slots '(left right)
:render (lambda (_props slots)
(concat "[" (or (plist-get slots :left) "")
"|"
(or (plist-get slots :right) "") "]")))
(let ((result (tp-widget-parse
'(layout (slot-left (emphasis "Bold"))
(slot-right "Plain")))))
(should (equal result "[*Bold*|Plain]")))))
(let ((tp-debug-mode nil))
;; Clear any existing debug buffer
(tp-debug-clear)
;; Try to log a message
(tp-debug-log "Should not appear")
;; Check that buffer is empty or doesn't exist
(let ((buf (get-buffer "*tp-debug*")))
(if buf
(with-current-buffer buf
(should (string= (buffer-string) ""))))))))
;;; ============================================================
;;; Component Inheritance Tests
;;; Value Transformation Tests
;;; ============================================================
(ert-deftest tp-test-widget-extends-basic ()
"Test basic widget inheritance."
(ert-deftest tp-test-transform-basic ()
"Test that :transform transforms tp-text values."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Define parent widget
(tp-define-twidget base-text
:props '((prefix . ""))
:slot t
:render (lambda (props slot)
(concat (plist-get props :prefix) slot)))
;; Define child widget that extends parent
(tp-define-twidget bold-text
:extends 'base-text
:props '((prefix . "[B]"))
:render (lambda (props slot parent-render)
(let ((result (funcall parent-render props slot)))
(upcase result))))
(let ((result (tp-widget-parse '(bold-text "hello"))))
(should (equal result "[B]HELLO")))))
(unwind-protect
(progn
;; Define a layer with transform
(tp-define-layer 'test-transform-layer
:props '(face bold tp-text $tp-test-value)
:data '((tp-test-value . "hello"))
:transform #'upcase)
(insert "placeholder")
(tp-set 1 12 'test-transform-layer)
;; Text should be transformed to uppercase
(should (equal (buffer-substring-no-properties 1 6) "HELLO")))
;; Cleanup
(ignore-errors (makunbound 'tp-test-value)))))
(ert-deftest tp-test-widget-extends-inherits-slot ()
"Test that child widget inherits slot from parent."
(ert-deftest tp-test-transform-with-reactive-update ()
"Test that :transform works with reactive updates."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Parent has slot t
(tp-define-twidget parent-with-slot
:slot t
:render (lambda (_props slot)
(concat "P:" slot)))
;; Child doesn't specify slot, should inherit
(tp-define-twidget child-inherits-slot
:extends 'parent-with-slot
:render (lambda (_props slot parent-render)
(funcall parent-render nil (concat "C:" slot))))
(let ((result (tp-widget-parse '(child-inherits-slot "content"))))
(should (equal result "P:C:content")))))
(unwind-protect
(progn
;; Define a layer with transform (format as currency)
(tp-define-layer 'test-currency-layer
:props '(face bold tp-text $tp-test-amount)
:data '((tp-test-amount . "100"))
:transform (lambda (text)
(format "$%s.00" text)))
(insert "placeholder")
(tp-set 1 12 'test-currency-layer)
;; Text should be formatted
(should (equal (buffer-substring-no-properties 1 8) "$100.00"))
;; Update the variable
(setq tp-test-amount "250")
;; Text should be updated with transform applied
(should (equal (buffer-substring-no-properties 1 8) "$250.00")))
;; Cleanup
(ignore-errors (makunbound 'tp-test-amount)))))
(ert-deftest tp-test-widget-extends-merges-props ()
"Test that child widget merges props with parent."
(ert-deftest tp-test-transform-removed-on-redefine ()
"Test that :transform is removed when layer is redefined without it."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Parent has props a and b with defaults
(tp-define-twidget parent-props
:props '((a . "A") (b . "B"))
:slot t
:render (lambda (props slot)
(format "%s|%s|%s"
(plist-get props :a)
(plist-get props :b)
slot)))
;; Child overrides default for a, adds c
(tp-define-twidget child-props
:extends 'parent-props
:props '((a . "AA") c)
:render (lambda (props slot parent-render)
(format "[c=%s]%s"
(or (plist-get props :c) "nil")
(funcall parent-render props slot))))
(let ((result (tp-widget-parse '(child-props :c "C" "text"))))
(should (equal result "[c=C]AA|B|text")))))
(ert-deftest tp-test-widget-extends-chain ()
"Test multi-level widget inheritance chain."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Grandparent
(tp-define-twidget grandparent
:slot t
:render (lambda (_props slot)
(concat "[GP:" slot "]")))
;; Parent extends grandparent
(tp-define-twidget parent
:extends 'grandparent
:render (lambda (_props slot parent-render)
(funcall parent-render nil (concat "P:" slot))))
;; Child extends parent
(tp-define-twidget child
:extends 'parent
:render (lambda (_props slot parent-render)
(funcall parent-render nil (concat "C:" slot))))
(let ((result (tp-widget-parse '(child "text"))))
(should (equal result "[GP:P:C:text]")))))
(ert-deftest tp-test-widget-extends-override-slot ()
"Test child can override parent's slot setting."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Parent has no slot (nil by default)
(tp-define-twidget parent-no-slot
:props '((prefix . "P:"))
:render (lambda (props slot)
(concat (plist-get props :prefix) (or slot "no-slot"))))
;; Child explicitly sets slot to t
(tp-define-twidget child-with-slot
:extends 'parent-no-slot
:slot t
:render (lambda (props slot parent-render)
(funcall parent-render props slot)))
(let ((def (cdr (assoc 'child-with-slot tp-widget-alist))))
;; Child should have slot t (explicit override)
(should (eq (plist-get def :slot) t)))
;; Test the widget works
(let ((result (tp-widget-parse '(child-with-slot "content"))))
(should (equal result "P:content")))))
(ert-deftest tp-test-widget-extends-override-slot-to-nil ()
"Test child can explicitly override parent's slot to nil."
(tp-test-with-temp-buffer
(tp-widget-reset)
;; Parent has slot t
(tp-define-twidget parent-with-slot
:slot t
:render (lambda (_props slot)
(or slot "empty")))
;; Child explicitly sets slot to nil
(tp-define-twidget child-no-slot
:extends 'parent-with-slot
:slot nil
:render (lambda (_props slot parent-render)
(format "child: %s" (funcall parent-render nil slot))))
(let ((def (cdr (assoc 'child-no-slot tp-widget-alist))))
;; Child should have slot nil (explicit override, not inherited)
(should (null (plist-get def :slot))))))
(unwind-protect
(progn
;; Define with transform
(tp-define-layer 'test-redef-transform
:props '(face bold tp-text $tp-test-text)
:data '((tp-test-text . "hello"))
:transform #'upcase)
;; Check transform is registered
(should (assoc 'test-redef-transform tp-layer-transforms))
;; Redefine without transform
(tp-define-layer 'test-redef-transform
:props '(face bold tp-text $tp-test-text)
:data '((tp-test-text . "hello")))
;; Transform should be removed
(should-not (assoc 'test-redef-transform tp-layer-transforms)))
;; Cleanup
(ignore-errors (makunbound 'tp-test-text)))))
(provide 'tp-ert-tests)
;;; tp-ert-tests.el ends here

286
tp.el
View File

@ -69,10 +69,65 @@ Each element: (VAR-SYMBOL . ((LAYER-NAME . REACTIVE-PROPS) ...)).")
(defvar tp--anonymous-layer-counter 0
"Counter for generating unique anonymous layer names.")
;;; --- Debug Mode ---
(defcustom tp-debug-mode nil
"When non-nil, enable debug logging for reactive updates.
Debug messages are logged to the *tp-debug* buffer and optionally
displayed in the minibuffer based on `tp-debug-echo' setting."
:type 'boolean
:group 'tp)
(defcustom tp-debug-echo nil
"When non-nil and `tp-debug-mode' is enabled, also echo debug messages.
If nil, debug messages are only logged to the *tp-debug* buffer."
:type 'boolean
:group 'tp)
(defvar tp-layer-transforms nil
"Alist of layer transforms: (LAYER-NAME . TRANSFORM-FN).
TRANSFORM-FN receives the value and returns the transformed value.
Used for tp-text transformations like formatting numbers or dates.")
;;; --- Batched Updates ---
(defvar tp--batch-update-pending nil
"When non-nil, reactive updates are being batched.
This is a list of (LAYER-NAME . CHANGED-VARS) pairs pending update.")
(defvar tp--batch-update-active nil
"When non-nil, we are inside a `tp-with-batch-updates' form.")
;;;============================================================================
;;; Layer 1: Basic Utility Functions
;;;============================================================================
;;; --- Debug Logging ---
(defun tp-debug-log (format-string &rest args)
"Log a debug message if `tp-debug-mode' is enabled.
FORMAT-STRING and ARGS are passed to `format'."
(when tp-debug-mode
(let ((msg (apply #'format format-string args))
(timestamp (format-time-string "%H:%M:%S.%3N")))
(with-current-buffer (get-buffer-create "*tp-debug*")
(goto-char (point-max))
(insert (format "[%s] %s\n" timestamp msg)))
(when tp-debug-echo
(message "[tp] %s" msg)))))
(defun tp-debug-clear ()
"Clear the *tp-debug* buffer."
(interactive)
(when-let ((buf (get-buffer "*tp-debug*")))
(with-current-buffer buf
(erase-buffer))))
(defun tp-debug-show ()
"Show the *tp-debug* buffer."
(interactive)
(pop-to-buffer (get-buffer-create "*tp-debug*")))
;;; --- Anonymous Layer Generation ---
(defun tp--generate-anonymous-layer-name ()
@ -339,9 +394,15 @@ Updates all layers that depend on this variable.
Only 'set' operations trigger updates because:
- 'let'/'unlet': Temporary bindings that will be restored, no need to update UI
- 'makunbound': Variable is being undefined, not a value change
- 'defvaralias': Aliasing, the actual value change will trigger a separate 'set'"
- 'defvaralias': Aliasing, the actual value change will trigger a separate 'set'
When `tp--batch-update-active' is non-nil, buffer updates are deferred until
the batch completes. Layer definitions are still updated immediately."
(when (and (not (equal (symbol-value symbol) newval))
(eq operation 'set))
(tp-debug-log "Variable %s changed: %S -> %S (where: %s)"
symbol (symbol-value symbol) newval
(if where (buffer-name where) "global"))
(let ((deps (cdr (assoc symbol tp-reactive-deps)))
(oldval (symbol-value symbol))
;; Create override alist with the new value
@ -365,17 +426,30 @@ Only 'set' operations trigger updates because:
;; Update only the reactive properties in the layer definition
(let ((current-props (cdr (assoc layer-name tp-layer-alist))))
(when current-props
;; Merge the resolved reactive props into the current layer props
(cl-loop for (key val) on resolved-props by #'cddr
do (setq current-props
(plist-put current-props key val)))
;; Deep merge the resolved reactive props into the current layer props
;; This preserves nested plist values (like face properties)
(setq current-props (tp--deep-merge-plist current-props resolved-props))
(tp--set-layer-props layer-name current-props))))))
;; Update text regions with this layer
;; If tp-text is affected, use tp--update-reactive-text for text replacement
;; Otherwise use tp--update-layer-regions for property-only updates
(if tp-text-affected
(tp--update-reactive-text layer-name where)
(tp--update-layer-regions layer-name where)))))))
;; Update text regions with this layer (or defer if batching)
(if tp--batch-update-active
;; Batching: defer the buffer update
;; Pending format: (layer-name symbols-list where tp-text-affected)
(let ((existing (assoc layer-name tp--batch-update-pending)))
(tp-debug-log " Deferring buffer update for %s (batch mode)" layer-name)
(if existing
;; Update existing entry: add symbol if not present
(let ((symbols (nth 1 existing)))
(unless (memq symbol symbols)
(setf (nth 1 existing) (cons symbol symbols))))
;; Create new entry
(push (list layer-name (list symbol) where tp-text-affected)
tp--batch-update-pending)))
;; Normal: update immediately
(tp-debug-log " Updating layer %s (tp-text affected: %s)"
layer-name (if tp-text-affected "yes" "no"))
(if tp-text-affected
(tp--update-reactive-text layer-name where)
(tp--update-layer-regions layer-name where))))))))
(defun tp--invoke-layer-watchers (layer-name symbol newval oldval)
"Invoke all registered watcher callbacks for LAYER-NAME watching SYMBOL.
@ -385,11 +459,56 @@ NEWVAL is the new value, OLDVAL is the old value."
(let ((watch-sym (car watcher))
(callback (cdr watcher)))
(when (eq watch-sym symbol)
(tp-debug-log " Invoking watcher for %s on %s" watch-sym layer-name)
(condition-case err
(funcall callback newval oldval layer-name)
(error (message "tp: watcher error for %s watching %s: %s"
layer-name watch-sym err))))))))
;;; --- Batched Updates ---
(defun tp--flush-batch-updates ()
"Flush all pending batch updates.
This processes all updates collected during a `tp-with-batch-updates' form."
(tp-debug-log "Flushing %d pending batch updates" (length tp--batch-update-pending))
(let ((processed-layers nil))
;; Process each pending update, avoiding duplicate layer updates
(dolist (pending (nreverse tp--batch-update-pending))
(let ((layer-name (car pending))
(where (caddr pending))
(tp-text-affected (cadddr pending)))
(unless (memq layer-name processed-layers)
(push layer-name processed-layers)
(tp-debug-log " Batch updating layer %s (tp-text: %s)"
layer-name (if tp-text-affected "yes" "no"))
(if tp-text-affected
(tp--update-reactive-text layer-name where)
(tp--update-layer-regions layer-name where))))))
(setq tp--batch-update-pending nil))
(defmacro tp-with-batch-updates (&rest body)
"Execute BODY with reactive updates batched.
Multiple variable changes within BODY are collected and applied
together at the end, avoiding redundant buffer modifications.
This is useful when changing multiple reactive variables simultaneously:
(tp-with-batch-updates
(setq my-color \"red\")
(setq my-size 14)
(setq my-text \"Hello\"))
Without batching, each `setq' would trigger a separate buffer update.
With batching, all updates are consolidated and applied once at the end."
(declare (indent 0) (debug t))
`(let ((tp--batch-update-active t)
(tp--batch-update-pending nil))
(tp-debug-log "Starting batch updates")
(unwind-protect
(progn ,@body)
(tp-debug-log "Ending batch updates")
(tp--flush-batch-updates))))
(defun tp--update-layer-computed (layer-name override-alist)
"Update computed reactive variables for LAYER-NAME with OVERRIDE-ALIST.
Evaluates compute functions and updates the reactive variable values.
@ -609,10 +728,26 @@ This is called when a reactive variable bound to tp-text changes.
WHERE specifies which buffers to update:
- If WHERE is a buffer, only update that buffer (setq-local case).
- If WHERE is nil, update all buffers that have the text property (setq case)."
- If WHERE is nil, update all buffers that have the text property (setq case).
If a transform function is registered for LAYER-NAME via `:transform',
it will be applied to the text before updating."
(let ((props (tp-layer-props layer-name t))) ; include tp-name for reactive tracking
(when props
(let ((new-text (plist-get props 'tp-text)))
(let* ((raw-text (plist-get props 'tp-text))
;; Apply transformation if registered
(transform-fn (cdr (assoc layer-name tp-layer-transforms)))
(new-text (if (and transform-fn raw-text (stringp raw-text))
(condition-case err
(let ((result (funcall transform-fn raw-text)))
(tp-debug-log " Transform %s: %S -> %S"
layer-name raw-text result)
result)
(error
(message "tp: transform error for %s: %s"
layer-name err)
raw-text))
raw-text)))
(when (and new-text (stringp new-text))
(if (and where (bufferp where) (buffer-live-p where))
;; setq-local case: only update the specific buffer
@ -688,43 +823,53 @@ NEW-OBJECT is the new string object (only different for strings with tp-text)."
(list (plist-put props 'tp-text current-text) end object)))
;; tp-text has a string value - replace the text in the region
((stringp tp-text-val)
(if (stringp object)
;; For strings: create a new string with tp-text content
;; The new string replaces the original, with props applied
(let ((new-string (copy-sequence tp-text-val)))
(list props (length new-string) new-string))
;; For buffers: replace text and adjust end position
(let ((old-text (if object
(with-current-buffer object
(buffer-substring-no-properties start end))
(buffer-substring-no-properties start end))))
(if (equal old-text tp-text-val)
;; Same text, no replacement needed
(list props end object)
;; Need to replace text
(let ((existing-props (when preserve-props
(if object
(with-current-buffer object
(text-properties-at start))
(text-properties-at start)))))
(save-excursion
(if object
(with-current-buffer object
(let ((inhibit-read-only t))
(delete-region start end)
(goto-char start)
(insert tp-text-val)))
(let ((inhibit-read-only t))
(delete-region start end)
(goto-char start)
(insert tp-text-val))))
(let ((new-end (+ start (length tp-text-val))))
;; Re-apply existing properties to new text region if preserving
(when existing-props
(cl-loop for (key val) on existing-props by #'cddr
do (put-text-property
start new-end key val object)))
(list props new-end object)))))))
;; Apply transform if layer has one registered
(let* ((layer-name (plist-get props 'tp-name))
(transform-fn (when layer-name (cdr (assoc layer-name tp-layer-transforms))))
(final-text (if transform-fn
(condition-case err
(funcall transform-fn tp-text-val)
(error
(message "tp: transform error for %s: %s" layer-name err)
tp-text-val))
tp-text-val)))
(if (stringp object)
;; For strings: create a new string with tp-text content
;; The new string replaces the original, with props applied
(let ((new-string (copy-sequence final-text)))
(list props (length new-string) new-string))
;; For buffers: replace text and adjust end position
(let ((old-text (if object
(with-current-buffer object
(buffer-substring-no-properties start end))
(buffer-substring-no-properties start end))))
(if (equal old-text final-text)
;; Same text, no replacement needed
(list props end object)
;; Need to replace text
(let ((existing-props (when preserve-props
(if object
(with-current-buffer object
(text-properties-at start))
(text-properties-at start)))))
(save-excursion
(if object
(with-current-buffer object
(let ((inhibit-read-only t))
(delete-region start end)
(goto-char start)
(insert final-text)))
(let ((inhibit-read-only t))
(delete-region start end)
(goto-char start)
(insert final-text))))
(let ((new-end (+ start (length final-text))))
;; Re-apply existing properties to new text region if preserving
(when existing-props
(cl-loop for (key val) on existing-props by #'cddr
do (put-text-property
start new-end key val object)))
(list props new-end object))))))))
;; Other types - return unchanged
(t (list props end object))))))
@ -2016,13 +2161,13 @@ Example:
(defun tp--parse-define-layer-args (args)
"Parse ARGS for tp-define-layer function.
Returns plist with keys :props, :data, :watch, :compute.
- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH] [:compute COMPUTE]"
(let (props data watch compute has-keywords)
Returns plist with keys :props, :data, :watch, :compute, :transform.
- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH] [:compute COMPUTE] [:transform FN]"
(let (props data watch compute transform has-keywords)
(cond
;; Check for keyword arguments format
((and (keywordp (car args))
(memq (car args) '(:props :data :watch :compute)))
(memq (car args) '(:props :data :watch :compute :transform)))
(setq has-keywords t)
;; Parse keyword arguments
(let ((rest args))
@ -2032,6 +2177,7 @@ Returns plist with keys :props, :data, :watch, :compute.
(:data (setq data (cadr rest) rest (cddr rest)))
(:watch (setq watch (cadr rest) rest (cddr rest)))
(:compute (setq compute (cadr rest) rest (cddr rest)))
(:transform (setq transform (cadr rest) rest (cddr rest)))
(_ (error "Unknown keyword in tp-define-layer: %s" (car rest))))))
;; Validate: if :watch, :compute, or :data present, :props must be present
(when (and (or watch compute data) (null props))
@ -2041,18 +2187,18 @@ Returns plist with keys :props, :data, :watch, :compute.
(listp (car args)))
(setq props (car args)))
(t (error "Invalid tp-define-layer format")))
(list :props props :data data :watch watch :compute compute)))
(list :props props :data data :watch watch :compute compute :transform transform)))
(defun tp-define-layer (name &rest args)
"Define a single text property layer named NAME.
This function supports two formats:
Format 1 - Direct plist (no :watch/:compute/:data support):
Format 1 - Direct plist (no :watch/:compute/:data/:transform support):
(tp-define-layer \\='layer-name
\\='(display \"🌑\" face (:height 1.0)))
Format 2 - With :props, :data, :watch, and/or :compute (Vue 3 style reactivity):
Format 2 - With :props, :data, :watch, :compute, and/or :transform (Vue 3 style reactivity):
(tp-define-layer \\='layer-name
;; props: $-prefixed symbols are reactive variables; auto-defined if not bound
:props \\='(face (:foreground $my-color) help-echo $full-name)
@ -2062,7 +2208,9 @@ Format 2 - With :props, :data, :watch, and/or :compute (Vue 3 style reactivity):
:compute \\='((full-name (lambda () (concat first-name \" \" last-name))))
;; watch: list of (VAR-NAME CALLBACK) - side effects when vars change
:watch \\='((my-color (lambda (new old layer)
(message \"Color changed from %s to %s\" old new)))))
(message \"Color changed from %s to %s\" old new))))
;; transform: function to transform tp-text values before display
:transform (lambda (text) (upcase text)))
Reactive Variables:
If any symbol in :props starts with $, it is treated as a reactive variable.
@ -2079,6 +2227,10 @@ Reactive Variables:
:watch - A list of (VAR-SYMBOL CALLBACK) pairs. CALLBACK is called when
VAR-SYMBOL changes, receiving (NEW-VALUE OLD-VALUE LAYER-NAME).
:transform - A function that receives the tp-text value and returns a
transformed string. Useful for formatting numbers, dates, or other values
before display. Example: (lambda (text) (format \"$%.2f\" (string-to-number text)))
Note: When using :watch, :compute, or :data, you MUST use :props to specify
the text properties explicitly.
@ -2090,6 +2242,7 @@ The layer is stored in `tp-layer-alist'."
(data (plist-get parsed :data))
(watch (plist-get parsed :watch))
(compute (plist-get parsed :compute))
(transform (plist-get parsed :transform))
(reactive-syms (tp--collect-reactive-symbols properties))
;; Collect computed variable names (they become reactive too)
(computed-vars (when compute (mapcar #'car compute)))
@ -2105,6 +2258,13 @@ The layer is stored in `tp-layer-alist'."
(append data
props-vars
computed-vars))))
;; Register or unregister transform function
(if transform
(if (assoc name tp-layer-transforms)
(setcdr (assoc name tp-layer-transforms) transform)
(push (cons name transform) tp-layer-transforms))
;; Remove any existing transform when redefining without one
(setq tp-layer-transforms (assq-delete-all name tp-layer-transforms)))
(if (or all-reactive-syms data compute)
;; Has reactive features - register dependencies and resolve at runtime
(progn
@ -2708,17 +2868,19 @@ If resolution fails, return PLIST unchanged (for backward compatibility)."
(defun tp-layer-reset ()
"Reset all layer definitions.
Clears both `tp-layer-alist' and `tp-layer-groups'.
Also resets all reactive text property watchers and dependencies."
Also resets all reactive text property watchers, dependencies, and transforms."
(interactive)
(tp-reactive-reset)
(setq tp-layer-alist nil)
(setq tp-layer-groups nil))
(setq tp-layer-groups nil)
(setq tp-layer-transforms nil))
(defun tp-undefine-layer (name)
"Remove layer NAME from `tp-layer-alist'.
Also unregisters any reactive dependencies for this layer."
Also unregisters any reactive dependencies and transforms for this layer."
(tp--unregister-reactive-deps name)
(setq tp-layer-alist (assq-delete-all name tp-layer-alist)))
(setq tp-layer-alist (assq-delete-all name tp-layer-alist))
(setq tp-layer-transforms (assq-delete-all name tp-layer-transforms)))
(defun tp-undefine-group (name)
"Remove layer group NAME from `tp-layer-groups'."