Update widget slot system to boolean and support multiple slots, add optimization doc
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot]
parent
57b6eb14e3
commit
fbd1e72836
399
docs/widget-optimization-proposals.md
Normal file
399
docs/widget-optimization-proposals.md
Normal file
@ -0,0 +1,399 @@
|
||||
# 组件优化提案文档（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))))
|
||||
|
||||
;; 使用
|
||||
(tp-widget-parse
|
||||
'(card :title "My Card"
|
||||
:header-slot "Header Content"
|
||||
:content-slot "Main Content"
|
||||
:footer-slot "Footer"))
|
||||
```
|
||||
|
||||
**作用**:
|
||||
- 支持更灵活的内容分发
|
||||
- 组件可以有多个内容区域
|
||||
|
||||
**是否必要**: ⭐⭐⭐ 中等优先级
|
||||
- 当组件需要在不同位置插入内容时非常有用
|
||||
- 类似 Vue/React 的 slot 概念
|
||||
|
||||
---
|
||||
|
||||
### 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")))))
|
||||
```
|
||||
|
||||
**作用**:
|
||||
- 代码复用
|
||||
- 创建组件变体
|
||||
|
||||
**是否必要**: ⭐⭐⭐ 中等优先级
|
||||
- 对于创建组件库非常有用
|
||||
- 避免重复代码
|
||||
|
||||
---
|
||||
|
||||
### 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 组件最为重要。
|
||||
117
tp-tests.el
117
tp-tests.el
@ -3436,24 +3436,24 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(ert-deftest tp-test-define-twidget-basic ()
|
||||
"Test basic twidget definition."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
(tp-define-twidget test-widget
|
||||
:props '(name)
|
||||
:slot 'content
|
||||
:slot t
|
||||
:render (lambda (props slot)
|
||||
(concat "Hello " (plist-get props :name) ": " slot)))
|
||||
(should (assoc 'test-widget tp-twidget-alist))
|
||||
(let ((def (cdr (assoc 'test-widget tp-twidget-alist))))
|
||||
(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) 'content)))))
|
||||
(should (equal (plist-get def :slot) t)))))
|
||||
|
||||
(ert-deftest tp-test-widget-parse-basic ()
|
||||
"Test basic widget parsing."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
(tp-define-twidget greeting
|
||||
:props '(name)
|
||||
:slot 'message
|
||||
: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"))))
|
||||
@ -3462,10 +3462,10 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(ert-deftest tp-test-widget-parse-with-default ()
|
||||
"Test widget parsing with default prop values."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
(tp-define-twidget styled-text
|
||||
:props '((color . "blue") message)
|
||||
:slot 'text
|
||||
:slot t
|
||||
:render (lambda (props slot)
|
||||
(let ((color (plist-get props :color))
|
||||
(msg (plist-get props :message)))
|
||||
@ -3483,11 +3483,11 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(ert-deftest tp-test-widget-parse-with-text-properties ()
|
||||
"Test widget parsing with text properties."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
;; Define a simple widget that applies text properties
|
||||
(tp-define-twidget bold-text
|
||||
:props '((color . "black"))
|
||||
:slot 'content
|
||||
:slot t
|
||||
:render (lambda (props slot)
|
||||
(let ((color (plist-get props :color)))
|
||||
(tp-set slot 'face `(:foreground ,color :weight bold)))))
|
||||
@ -3501,7 +3501,7 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(ert-deftest tp-test-widget-parse-button-example ()
|
||||
"Test the button widget example from the problem statement."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
;; First define the tp-space layer (from problem statement)
|
||||
(define-tp tp-space (pixel)
|
||||
`(display (space :width (,pixel))))
|
||||
@ -3509,7 +3509,7 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
;; Note: Using tp-button as the property name to match problem statement
|
||||
(tp-define-twidget button
|
||||
:props '(action (bgcolor . "green"))
|
||||
:slot 'label
|
||||
:slot t
|
||||
:render (lambda (props slot)
|
||||
(let ((action (plist-get props :action))
|
||||
(bgcolor (plist-get props :bgcolor)))
|
||||
@ -3532,35 +3532,35 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(let ((action-prop (get-text-property 2 'tp-button result)))
|
||||
(should (listp (plist-get action-prop :action)))))))
|
||||
|
||||
(ert-deftest tp-test-twidget-reset ()
|
||||
"Test twidget reset clears all definitions."
|
||||
(ert-deftest tp-test-widget-reset ()
|
||||
"Test widget reset clears all definitions."
|
||||
(tp-test-with-temp-buffer
|
||||
(tp-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
(tp-define-twidget test-widget1
|
||||
:props '(a)
|
||||
:slot 'b
|
||||
:slot t
|
||||
:render (lambda (p s) ""))
|
||||
(tp-define-twidget test-widget2
|
||||
:props '(c)
|
||||
:slot 'd
|
||||
:slot t
|
||||
:render (lambda (p s) ""))
|
||||
(should (= (length tp-twidget-alist) 2))
|
||||
(tp-twidget-reset)
|
||||
(should (= (length tp-twidget-alist) 0))))
|
||||
(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-twidget-reset)
|
||||
(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-twidget-reset)
|
||||
(tp-widget-reset)
|
||||
(tp-define-twidget multi-prop
|
||||
:props '(required (opt1 . "default1") (opt2 . "default2"))
|
||||
:slot 'content
|
||||
:slot t
|
||||
:render (lambda (props slot)
|
||||
(format "%s|%s|%s|%s"
|
||||
(plist-get props :required)
|
||||
@ -3577,5 +3577,74 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(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)")))))
|
||||
|
||||
(provide 'tp-ert-tests)
|
||||
;;; tp-ert-tests.el ends here
|
||||
|
||||
90
tp.el
90
tp.el
@ -3541,6 +3541,9 @@ Returns the modified object (string) or nil for buffer operations."
|
||||
"Alist of widget definitions: (WIDGET-NAME . DEFINITION).
|
||||
Each DEFINITION is a plist with :props, :slot, and :render keys.")
|
||||
|
||||
;; Alias for backward compatibility
|
||||
(defvaralias 'tp-twidget-alist 'tp-widget-alist)
|
||||
|
||||
(defmacro tp-define-widget (name &rest args)
|
||||
"Define a text widget (widget) named NAME.
|
||||
|
||||
@ -3548,25 +3551,42 @@ ARGS should include:
|
||||
:props - A quoted list of property definitions. Each can be:
|
||||
- A symbol: required property accessed via keyword
|
||||
- A cons cell (SYMBOL . DEFAULT): property with default value
|
||||
:slot - A quoted symbol naming the slot (last positional argument)
|
||||
:slot - Boolean value. nil (default) means widget does not support slot.
|
||||
t means widget supports slot content.
|
||||
:render - A lambda (props slot) that returns the rendered string
|
||||
|
||||
The render function receives:
|
||||
- PROPS: a plist of resolved property values (with :keyword keys)
|
||||
- SLOT: the slot value (last positional argument)
|
||||
- SLOT: the slot content. When :slot is t, this is a string containing
|
||||
all slot values concatenated together. Slot values can be plain
|
||||
strings or nested widget-forms (which are recursively parsed).
|
||||
When :slot is nil, SLOT will be nil.
|
||||
|
||||
Slot values are all elements that remain after extracting the plist
|
||||
(keyword-value pairs) from the widget invocation. Multiple slot values
|
||||
are supported and can include both strings and nested widget-forms.
|
||||
|
||||
Example:
|
||||
(tp-define-widget button
|
||||
:props \\='(action (bgcolor . \"green\"))
|
||||
:slot \\='label
|
||||
:props \\='(action (bgcolor . \"orange\"))
|
||||
: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)))))"
|
||||
(tp-set \" \" \\='tp-space 6)
|
||||
slot (tp-set \" \" \\='tp-space 6))
|
||||
\\='tp-button \\=`(:bgcolor ,bgcolor :action ,action)))))
|
||||
|
||||
(tp-define-widget p
|
||||
:slot t
|
||||
:render (lambda (_props slot) slot))
|
||||
|
||||
;; Usage with multiple slot values:
|
||||
(tp-widget-parse \\='(p \"happy hacking \"
|
||||
(text \"emacs\")
|
||||
(button :action (lambda () (message \"clicked!\"))
|
||||
\"click\")))"
|
||||
(declare (indent defun))
|
||||
(let ((props nil)
|
||||
(slot nil)
|
||||
@ -3582,11 +3602,13 @@ Example:
|
||||
`(tp--define-widget-internal ',name ,props ,slot ,render)))
|
||||
|
||||
(defalias 'define-twidget 'tp-define-widget)
|
||||
(defalias 'tp-define-twidget 'tp-define-widget)
|
||||
(defalias 'tp-twidget-reset 'tp-widget-reset)
|
||||
|
||||
(defun tp--define-widget-internal (name props slot render)
|
||||
"Internal function to define a widget NAME with PROPS, SLOT, and RENDER.
|
||||
PROPS is a list of property definitions.
|
||||
SLOT is the slot name symbol.
|
||||
SLOT is a boolean indicating whether the widget supports slot content.
|
||||
RENDER is the render function."
|
||||
(let ((definition (list :props props :slot slot :render render))
|
||||
(existing (assoc name tp-widget-alist)))
|
||||
@ -3617,19 +3639,22 @@ Returns nil if no default is specified."
|
||||
"Parse and render a widget invocation.
|
||||
|
||||
WIDGET-FORM is a list starting with the widget name, followed by
|
||||
keyword-value pairs for props, and ending with a single slot value.
|
||||
keyword-value pairs for props, and then slot values (if the widget
|
||||
supports slots).
|
||||
|
||||
The format is: (WIDGET-NAME :prop1 val1 :prop2 val2 ... SLOT-VALUE)
|
||||
The format is: (WIDGET-NAME :prop1 val1 :prop2 val2 ... SLOT-VALUES...)
|
||||
|
||||
Keyword arguments must come before the slot value. The slot value
|
||||
is the last non-keyword argument and must be exactly one value.
|
||||
Keyword arguments must come before slot values. Slot values are all
|
||||
remaining elements after the keyword-value pairs. Each slot value can be:
|
||||
- A string: used directly
|
||||
- A list starting with a widget name: recursively parsed as a widget
|
||||
|
||||
Example:
|
||||
(tp-widget-parse
|
||||
\\='(button :action (lambda ()
|
||||
(interactive)
|
||||
(message \"button clicked!\"))
|
||||
\"CLICK\"))
|
||||
\\='(p \"happy hacking \"
|
||||
(text \"emacs\")
|
||||
(button :action (lambda () (message \"clicked!\"))
|
||||
\"click\")))
|
||||
|
||||
Returns the rendered string with text properties applied."
|
||||
(unless (and (listp widget-form) (symbolp (car widget-form)))
|
||||
@ -3640,26 +3665,39 @@ Returns the rendered string with text properties applied."
|
||||
(unless definition
|
||||
(error "Undefined widget: %S" widget-name))
|
||||
(let* ((prop-defs (plist-get definition :props))
|
||||
(slot-name (plist-get definition :slot))
|
||||
(slot-supported (plist-get definition :slot))
|
||||
(render-fn (plist-get definition :render))
|
||||
(parsed-props nil)
|
||||
(slot-value nil))
|
||||
;; Parse the widget invocation arguments
|
||||
;; Extract keyword arguments and the slot (last positional argument)
|
||||
;; Extract keyword arguments and collect slot values
|
||||
(let ((args rest)
|
||||
(collected-props nil))
|
||||
(collected-props nil)
|
||||
(slot-parts nil))
|
||||
;; Parse keyword arguments
|
||||
(while (and args (keywordp (car args)))
|
||||
(let ((key (car args))
|
||||
(val (cadr args)))
|
||||
(push (cons key val) collected-props)
|
||||
(setq args (cddr args))))
|
||||
;; The remaining argument(s) should be the slot value (exactly one)
|
||||
(when args
|
||||
(setq slot-value (car args))
|
||||
(when (cdr args)
|
||||
(warn "tp-widget-parse: Extra arguments after slot\
|
||||
value ignored: %S" (cdr args))))
|
||||
;; The remaining arguments are slot values (if slot is supported)
|
||||
(when (and slot-supported args)
|
||||
;; Process each slot value
|
||||
(dolist (slot-item args)
|
||||
(cond
|
||||
;; String: use directly
|
||||
((stringp slot-item)
|
||||
(push slot-item slot-parts))
|
||||
;; List starting with a defined widget name: recursively parse
|
||||
((and (listp slot-item)
|
||||
(symbolp (car slot-item))
|
||||
(assoc (car slot-item) tp-widget-alist))
|
||||
(push (tp-widget-parse slot-item) slot-parts))
|
||||
;; Other values: convert to string
|
||||
(t
|
||||
(push (format "%s" slot-item) slot-parts))))
|
||||
;; Combine all slot parts into one string
|
||||
(setq slot-value (apply #'concat (nreverse slot-parts))))
|
||||
;; Build the props plist with defaults
|
||||
(dolist (prop-def prop-defs)
|
||||
(let* ((prop-name (tp--widget-prop-name prop-def))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user