Implement named slots and component inheritance for widgets
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
parent
edf2c908ea
commit
7c64cb32ff
@ -38,7 +38,7 @@
|
||||
|
||||
---
|
||||
|
||||
### 2. 命名插槽(Named Slots)
|
||||
### 2. 命名插槽(Named Slots) ✅ 已实现
|
||||
|
||||
**参考**: Vue3 的 `<slot name="header">`, `v-slot:header`
|
||||
|
||||
@ -54,21 +54,24 @@
|
||||
"\n"
|
||||
(plist-get slots :footer))))
|
||||
|
||||
;; 使用
|
||||
;; 使用 - 通过 :slotname-slot 关键字传递内容
|
||||
(tp-widget-parse
|
||||
'(card :title "My Card"
|
||||
:header-slot "Header Content"
|
||||
:content-slot "Main Content"
|
||||
:footer-slot "Footer"))
|
||||
|
||||
;; 命名插槽也支持嵌套组件
|
||||
(tp-widget-parse
|
||||
'(layout :left-slot (emphasis "Bold Text")
|
||||
:right-slot "Plain Text"))
|
||||
```
|
||||
|
||||
**作用**:
|
||||
- 支持更灵活的内容分发
|
||||
- 组件可以有多个内容区域
|
||||
|
||||
**是否必要**: ⭐⭐⭐ 中等优先级
|
||||
- 当组件需要在不同位置插入内容时非常有用
|
||||
- 类似 Vue/React 的 slot 概念
|
||||
**状态**: ✅ 已实现
|
||||
|
||||
---
|
||||
|
||||
@ -106,7 +109,7 @@
|
||||
|
||||
---
|
||||
|
||||
### 4. 组件继承/组合(Component Inheritance/Composition)
|
||||
### 4. 组件继承/组合(Component Inheritance/Composition) ✅ 已实现
|
||||
|
||||
**参考**: Vue3 的 `mixins`, `extends`
|
||||
|
||||
@ -124,15 +127,37 @@
|
||||
: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` 参数,可调用父组件的渲染逻辑
|
||||
- 支持多级继承链
|
||||
|
||||
**作用**:
|
||||
- 代码复用
|
||||
- 创建组件变体
|
||||
|
||||
**是否必要**: ⭐⭐⭐ 中等优先级
|
||||
- 对于创建组件库非常有用
|
||||
- 避免重复代码
|
||||
**状态**: ✅ 已实现
|
||||
|
||||
---
|
||||
|
||||
@ -314,18 +339,18 @@
|
||||
|
||||
## 优先级总结
|
||||
|
||||
| 优化项 | 优先级 | 复杂度 | 价值 |
|
||||
|-------|-------|-------|-----|
|
||||
| 响应式状态 | ⭐⭐⭐⭐ | 中 | 高 |
|
||||
| 事件系统 | ⭐⭐⭐⭐ | 中 | 高 |
|
||||
| 命名插槽 | ⭐⭐⭐ | 低 | 中 |
|
||||
| 组件继承 | ⭐⭐⭐ | 中 | 中 |
|
||||
| 条件渲染辅助 | ⭐⭐⭐ | 低 | 中 |
|
||||
| 生命周期钩子 | ⭐⭐ | 低 | 低 |
|
||||
| 作用域插槽 | ⭐⭐ | 高 | 中 |
|
||||
| 依赖注入 | ⭐⭐ | 中 | 低 |
|
||||
| 类型验证 | ⭐⭐ | 低 | 低 |
|
||||
| 异步组件 | ⭐ | 高 | 低 |
|
||||
| 优化项 | 优先级 | 复杂度 | 价值 | 状态 |
|
||||
|-------|-------|-------|-----|------|
|
||||
| 响应式状态 | ⭐⭐⭐⭐ | 中 | 高 | 待实现 |
|
||||
| 事件系统 | ⭐⭐⭐⭐ | 中 | 高 | 待实现 |
|
||||
| 命名插槽 | ⭐⭐⭐ | 低 | 中 | ✅ 已实现 |
|
||||
| 组件继承 | ⭐⭐⭐ | 中 | 中 | ✅ 已实现 |
|
||||
| 条件渲染辅助 | ⭐⭐⭐ | 低 | 中 | 待实现 |
|
||||
| 生命周期钩子 | ⭐⭐ | 低 | 低 | 待实现 |
|
||||
| 作用域插槽 | ⭐⭐ | 高 | 中 | 待实现 |
|
||||
| 依赖注入 | ⭐⭐ | 中 | 低 | 待实现 |
|
||||
| 类型验证 | ⭐⭐ | 低 | 低 | 待实现 |
|
||||
| 异步组件 | ⭐ | 高 | 低 | 待实现 |
|
||||
|
||||
---
|
||||
|
||||
@ -335,11 +360,13 @@
|
||||
- 这两个特性对交互式组件最重要
|
||||
- 可以利用现有的 tp reactive 系统
|
||||
|
||||
2. **第二阶段**: 命名插槽 + 条件渲染辅助
|
||||
- 提升组件的灵活性和开发体验
|
||||
2. **第二阶段**: ~~命名插槽~~ ✅ + 条件渲染辅助
|
||||
- ~~提升组件的灵活性和开发体验~~
|
||||
- 命名插槽已实现
|
||||
|
||||
3. **第三阶段**: 组件继承 + 生命周期钩子
|
||||
- 对于构建组件库有价值
|
||||
3. **第三阶段**: ~~组件继承~~ ✅ + 生命周期钩子
|
||||
- ~~对于构建组件库有价值~~
|
||||
- 组件继承已实现
|
||||
|
||||
4. **第四阶段**: 其他高级特性
|
||||
- 根据实际需求决定
|
||||
|
||||
205
tp-tests.el
205
tp-tests.el
@ -3646,5 +3646,210 @@ When using tp-set (direct property setting), tp-name is NOT added."
|
||||
(let ((result (tp-widget-parse '(no-slot-widget :value "test" "ignored slot"))))
|
||||
(should (equal result "test (slot: nil)")))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Named Slots Tests
|
||||
;;; ============================================================
|
||||
|
||||
(ert-deftest tp-test-widget-named-slots-basic ()
|
||||
"Test widget with named slots."
|
||||
(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 :header-slot "Title"
|
||||
:content-slot "Body"
|
||||
:footer-slot "End"))))
|
||||
(should (equal result "Title|Body|End")))))
|
||||
|
||||
(ert-deftest tp-test-widget-named-slots-partial ()
|
||||
"Test widget with partial named slots."
|
||||
(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 :content-slot "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"
|
||||
:intro-slot "Introduction..."
|
||||
:body-slot "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 :left-slot (emphasis "Bold")
|
||||
:right-slot "Plain"))))
|
||||
(should (equal result "[*Bold*|Plain]")))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Component Inheritance Tests
|
||||
;;; ============================================================
|
||||
|
||||
(ert-deftest tp-test-widget-extends-basic ()
|
||||
"Test basic widget inheritance."
|
||||
(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")))))
|
||||
|
||||
(ert-deftest tp-test-widget-extends-inherits-slot ()
|
||||
"Test that child widget inherits slot from parent."
|
||||
(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")))))
|
||||
|
||||
(ert-deftest tp-test-widget-extends-merges-props ()
|
||||
"Test that child widget merges props with parent."
|
||||
(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))))))
|
||||
|
||||
(provide 'tp-ert-tests)
|
||||
;;; tp-ert-tests.el ends here
|
||||
|
||||
249
tp.el
249
tp.el
@ -3551,45 +3551,56 @@ 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 - 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
|
||||
:slot - Boolean value or list of slot names.
|
||||
nil (default) means widget does not support slot.
|
||||
t means widget supports a single default slot.
|
||||
A list of symbols defines named slots, e.g., \\='(header content footer)
|
||||
:slots - Alias for :slot with named slots (for clarity)
|
||||
:extends - Symbol of a parent widget to inherit from.
|
||||
The child widget inherits :props and :slot from the parent.
|
||||
Child :props override parent defaults; child :render can call parent-render.
|
||||
:render - A lambda that returns the rendered string.
|
||||
For single slot: (lambda (props slot) ...)
|
||||
For named slots: (lambda (props slots) ...) where slots is a plist
|
||||
When :extends is used: (lambda (props slot parent-render) ...)
|
||||
|
||||
The render function receives:
|
||||
- PROPS: a plist of resolved property values (with :keyword keys)
|
||||
- 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/SLOTS: For single slot (t), a string containing all slot values.
|
||||
For named slots, a plist with slot names as keywords.
|
||||
- PARENT-RENDER: When :extends is used, a function to call parent's render.
|
||||
|
||||
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.
|
||||
Named Slots Example:
|
||||
(tp-define-widget card
|
||||
:slots \\='(header content footer)
|
||||
:render (lambda (props slots)
|
||||
(concat (plist-get slots :header) \"\\n\"
|
||||
(plist-get slots :content) \"\\n\"
|
||||
(plist-get slots :footer))))
|
||||
|
||||
Example:
|
||||
(tp-define-widget button
|
||||
:props \\='(action (bgcolor . \"orange\"))
|
||||
;; Usage:
|
||||
(tp-widget-parse
|
||||
\\='(card :header-slot \"Title\"
|
||||
:content-slot \"Body text\"
|
||||
:footer-slot \"Footer\"))
|
||||
|
||||
Component Inheritance Example:
|
||||
(tp-define-widget base-button
|
||||
:props \\='((type . \"default\"))
|
||||
: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 6)
|
||||
slot (tp-set \" \" \\='tp-space 6))
|
||||
\\='tp-button \\=`(:bgcolor ,bgcolor :action ,action)))))
|
||||
(tp-set slot \\='face \\='button)))
|
||||
|
||||
(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\")))"
|
||||
(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\")))))"
|
||||
(declare (indent defun))
|
||||
(let ((props nil)
|
||||
(slot nil)
|
||||
(slot :tp--unspecified) ; Sentinel value to detect if :slot was provided
|
||||
(extends nil)
|
||||
(render nil)
|
||||
(rest args))
|
||||
;; Parse keyword arguments
|
||||
@ -3597,25 +3608,91 @@ Example:
|
||||
(pcase (car rest)
|
||||
(:props (setq props (cadr rest) rest (cddr rest)))
|
||||
(:slot (setq slot (cadr rest) rest (cddr rest)))
|
||||
(:slots (setq slot (cadr rest) rest (cddr rest))) ; Alias for named slots
|
||||
(:extends (setq extends (cadr rest) rest (cddr rest)))
|
||||
(:render (setq render (cadr rest) rest (cddr rest)))
|
||||
(_ (error "Unknown keyword %S in tp-define-widget" (car rest)))))
|
||||
`(tp--define-widget-internal ',name ,props ,slot ,render)))
|
||||
;; Prepare slot value - the sentinel :tp--unspecified needs to be passed as-is
|
||||
;; Other values (t, nil, or list) should evaluate properly
|
||||
(let ((slot-form (if (eq slot :tp--unspecified)
|
||||
:tp--unspecified
|
||||
;; If slot is a quoted list (from ':slots '(x y z)),
|
||||
;; the value is actually (quote (x y z)), so we just pass it
|
||||
slot)))
|
||||
`(tp--define-widget-internal ',name ,props ,slot-form ,extends ,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.
|
||||
(defun tp--define-widget-internal (name props slot extends render)
|
||||
"Internal function to define a widget NAME with PROPS, SLOT, EXTENDS, and RENDER.
|
||||
PROPS is a list of property definitions.
|
||||
SLOT is a boolean indicating whether the widget supports slot content.
|
||||
SLOT is a boolean, list of slot names, or :tp--unspecified (not provided).
|
||||
EXTENDS is a symbol of a parent widget to inherit from.
|
||||
RENDER is the render function."
|
||||
(let ((definition (list :props props :slot slot :render render))
|
||||
(existing (assoc name tp-widget-alist)))
|
||||
(if existing
|
||||
(setcdr existing definition)
|
||||
(push (cons name definition) tp-widget-alist)))
|
||||
(assoc name tp-widget-alist))
|
||||
;; Handle inheritance if :extends is specified
|
||||
(let* ((slot-was-specified (not (eq slot :tp--unspecified)))
|
||||
(final-slot (if slot-was-specified slot nil))
|
||||
(final-props props)
|
||||
(parent-render nil))
|
||||
(when extends
|
||||
(let ((parent-def (cdr (assoc extends tp-widget-alist))))
|
||||
(unless parent-def
|
||||
(error "Parent widget not found: %S" extends))
|
||||
;; Inherit slot from parent only if child didn't specify :slot
|
||||
(unless slot-was-specified
|
||||
(setq final-slot (plist-get parent-def :slot)))
|
||||
;; Merge props: child props override parent defaults
|
||||
(let ((parent-props (plist-get parent-def :props)))
|
||||
(setq final-props (tp--merge-widget-props parent-props final-props)))
|
||||
;; Store parent render for child to call - resolve the full chain
|
||||
(let ((parent-extends (plist-get parent-def :extends)))
|
||||
(if parent-extends
|
||||
;; Parent also extends something - wrap parent render to pass its parent
|
||||
(let ((grandparent-render (plist-get parent-def :parent-render)))
|
||||
(setq parent-render
|
||||
(lambda (props slot)
|
||||
(funcall (plist-get parent-def :render)
|
||||
props slot grandparent-render))))
|
||||
;; Parent doesn't extend - use parent render directly
|
||||
(setq parent-render (plist-get parent-def :render))))))
|
||||
(let ((definition (list :props final-props
|
||||
:slot final-slot
|
||||
:extends extends
|
||||
:parent-render parent-render
|
||||
:render render))
|
||||
(existing (assoc name tp-widget-alist)))
|
||||
(if existing
|
||||
(setcdr existing definition)
|
||||
(push (cons name definition) tp-widget-alist)))
|
||||
(assoc name tp-widget-alist)))
|
||||
|
||||
(defun tp--merge-widget-props (parent-props child-props)
|
||||
"Merge PARENT-PROPS with CHILD-PROPS.
|
||||
Child props override parent props with the same name.
|
||||
Props without defaults in child inherit defaults from parent."
|
||||
(let ((result nil)
|
||||
(parent-map (make-hash-table :test 'equal))
|
||||
(child-map (make-hash-table :test 'equal)))
|
||||
;; Build maps of prop-name -> prop-def
|
||||
(dolist (prop parent-props)
|
||||
(puthash (tp--widget-prop-name prop) prop parent-map))
|
||||
(dolist (prop child-props)
|
||||
(puthash (tp--widget-prop-name prop) prop child-map))
|
||||
;; Merge: child overrides parent
|
||||
(maphash (lambda (name prop)
|
||||
(let ((child-prop (gethash name child-map)))
|
||||
(if child-prop
|
||||
(push child-prop result)
|
||||
(push prop result))))
|
||||
parent-map)
|
||||
;; Add any child-only props
|
||||
(maphash (lambda (name prop)
|
||||
(unless (gethash name parent-map)
|
||||
(push prop result)))
|
||||
child-map)
|
||||
(nreverse result)))
|
||||
|
||||
(defun tp--widget-prop-name (prop-def)
|
||||
"Extract the property name from PROP-DEF.
|
||||
@ -3635,6 +3712,12 @@ Returns nil if no default is specified."
|
||||
"Return non-nil if PROP-DEF has a default value."
|
||||
(consp prop-def))
|
||||
|
||||
(defun tp--widget-slot-is-named-p (slot-def)
|
||||
"Return non-nil if SLOT-DEF defines named slots (a list of symbols)."
|
||||
(and (listp slot-def)
|
||||
(not (null slot-def))
|
||||
(symbolp (car slot-def))))
|
||||
|
||||
(defun tp-widget-parse (widget-form)
|
||||
"Parse and render a widget invocation.
|
||||
|
||||
@ -3644,6 +3727,9 @@ supports slots).
|
||||
|
||||
The format is: (WIDGET-NAME :prop1 val1 :prop2 val2 ... SLOT-VALUES...)
|
||||
|
||||
For named slots, use :slotname-slot keywords:
|
||||
(WIDGET-NAME :prop1 val1 :header-slot \"Header\" :content-slot \"Content\")
|
||||
|
||||
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
|
||||
@ -3665,44 +3751,56 @@ Returns the rendered string with text properties applied."
|
||||
(unless definition
|
||||
(error "Undefined widget: %S" widget-name))
|
||||
(let* ((prop-defs (plist-get definition :props))
|
||||
(slot-supported (plist-get definition :slot))
|
||||
(slot-def (plist-get definition :slot))
|
||||
(extends (plist-get definition :extends))
|
||||
(parent-render-fn (plist-get definition :parent-render))
|
||||
(render-fn (plist-get definition :render))
|
||||
(parsed-props nil)
|
||||
(slot-value nil))
|
||||
(slot-value nil)
|
||||
(named-slots-p (tp--widget-slot-is-named-p slot-def)))
|
||||
;; Parse the widget invocation arguments
|
||||
;; Extract keyword arguments and collect slot values
|
||||
(let ((args rest)
|
||||
(collected-props nil)
|
||||
(collected-named-slots nil)
|
||||
(slot-parts nil))
|
||||
;; Parse keyword arguments
|
||||
;; Parse keyword arguments (including named slot keywords like :header-slot)
|
||||
(while (and args (keywordp (car args)))
|
||||
(let ((key (car args))
|
||||
(val (cadr args)))
|
||||
(push (cons key val) collected-props)
|
||||
(let* ((key (car args))
|
||||
(key-name (symbol-name key))
|
||||
(val (cadr args)))
|
||||
;; Check if this is a named slot keyword (ends with -slot)
|
||||
(if (and named-slots-p (string-suffix-p "-slot" key-name))
|
||||
(let* ((slot-name-str (substring key-name 1 (- (length key-name) 5)))
|
||||
(slot-name (intern slot-name-str)))
|
||||
(when (memq slot-name slot-def)
|
||||
(push (cons (intern (format ":%s" slot-name-str))
|
||||
(tp--widget-process-slot-value val))
|
||||
collected-named-slots)))
|
||||
(push (cons key val) collected-props))
|
||||
(setq args (cddr args))))
|
||||
;; The remaining arguments are slot values (if slot is supported)
|
||||
;; The remaining arguments are default slot values (if slot is supported)
|
||||
(when args
|
||||
(if slot-supported
|
||||
;; Process each slot value
|
||||
(progn
|
||||
(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))))
|
||||
(if slot-def
|
||||
(if named-slots-p
|
||||
;; For named slots, remaining args go to :default slot if defined
|
||||
(when (memq 'default slot-def)
|
||||
(setq slot-value (tp--widget-process-slot-args args)))
|
||||
;; Single slot mode
|
||||
(setq slot-value (tp--widget-process-slot-args args)))
|
||||
;; Slot not supported - warn about ignored arguments
|
||||
(warn "tp-widget-parse: Widget `%s' does not support slot content. \
|
||||
Ignoring arguments: %S" widget-name args)))
|
||||
;; Build named slots plist if using named slots
|
||||
(when named-slots-p
|
||||
(let ((slots-plist nil))
|
||||
(dolist (slot-name slot-def)
|
||||
(let* ((slot-keyword (intern (format ":%s" slot-name)))
|
||||
(provided (assoc slot-keyword collected-named-slots)))
|
||||
(when provided
|
||||
(setq slots-plist
|
||||
(plist-put slots-plist slot-keyword (cdr provided))))))
|
||||
(setq slot-value slots-plist)))
|
||||
;; Build the props plist with defaults
|
||||
(dolist (prop-def prop-defs)
|
||||
(let* ((prop-name (tp--widget-prop-name prop-def))
|
||||
@ -3717,7 +3815,28 @@ Ignoring arguments: %S" widget-name args)))
|
||||
(plist-put parsed-props prop-keyword
|
||||
(tp--widget-prop-default prop-def))))))))
|
||||
;; Call the render function
|
||||
(funcall render-fn parsed-props slot-value))))
|
||||
(if extends
|
||||
;; With inheritance, pass parent-render as third argument
|
||||
(funcall render-fn parsed-props slot-value parent-render-fn)
|
||||
;; Normal render call
|
||||
(funcall render-fn parsed-props slot-value)))))
|
||||
|
||||
(defun tp--widget-process-slot-value (val)
|
||||
"Process a single slot VAL, recursively parsing widget forms."
|
||||
(cond
|
||||
((stringp val) val)
|
||||
((and (listp val)
|
||||
(symbolp (car val))
|
||||
(assoc (car val) tp-widget-alist))
|
||||
(tp-widget-parse val))
|
||||
(t (format "%s" val))))
|
||||
|
||||
(defun tp--widget-process-slot-args (args)
|
||||
"Process multiple slot ARGS into a single concatenated string."
|
||||
(let ((slot-parts nil))
|
||||
(dolist (slot-item args)
|
||||
(push (tp--widget-process-slot-value slot-item) slot-parts))
|
||||
(apply #'concat (nreverse slot-parts))))
|
||||
|
||||
(defun tp-widget-reset ()
|
||||
"Reset all widget definitions."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user