diff --git a/docs/reactive-optimization-en.md b/docs/reactive-optimization-en.md new file mode 100644 index 0000000..8c085c8 --- /dev/null +++ b/docs/reactive-optimization-en.md @@ -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 | diff --git a/docs/reactive-optimization.md b/docs/reactive-optimization.md new file mode 100644 index 0000000..22d4848 --- /dev/null +++ b/docs/reactive-optimization.md @@ -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` | 层定义中的转换选项 | diff --git a/docs/widget-optimization-proposals.md b/docs/widget-optimization-proposals.md deleted file mode 100644 index a2bb1ac..0000000 --- a/docs/widget-optimization-proposals.md +++ /dev/null @@ -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 的 ``, `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- 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 组件最为重要。 diff --git a/tp-tests.el b/tp-tests.el index 331c3f1..cbb1d1f 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -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 diff --git a/tp.el b/tp.el index 76fc76a..da5e226 100644 --- a/tp.el +++ b/tp.el @@ -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'."