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

Change named slots syntax from :name-slot to (slot-name ...) sexp format

Browse Source 
Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
This commit is contained in:
copilot-swe-agent[bot] 2025-12-29 04:00:02 +00:00
parent 7c64cb32ff
commit 388bb667ca
3 changed files with 59 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,17 +54,17 @@
"\n" "\n"
(plist-get slots :footer)))) (plist-get slots :footer))))
;; 使用 - 通过 :slotname-slot 关键字传递内容 ;; 使用 - 通过 (slot-<name> content...) sexp 格式传递内容
(tp-widget-parse (tp-widget-parse
'(card :title "My Card" '(card :title "My Card"
:header-slot "Header Content" (slot-header "Header Content")
:content-slot "Main Content" (slot-content "Main Content")
:footer-slot "Footer")) (slot-footer "Footer")))
;; 命名插槽也支持嵌套组件 ;; 命名插槽也支持嵌套组件
(tp-widget-parse (tp-widget-parse
'(layout :left-slot (emphasis "Bold Text") '(layout (slot-left (emphasis "Bold Text"))
:right-slot "Plain Text")) (slot-right "Plain Text")))
``` ```
**作用**: **作用**:

16
tp-tests.el
View File

@ -3663,9 +3663,9 @@ When using tp-set (direct property setting), tp-name is NOT added."
"|" "|"
(or (plist-get slots :footer) "")))) (or (plist-get slots :footer) ""))))
(let ((result (tp-widget-parse (let ((result (tp-widget-parse
'(card :header-slot "Title" '(card (slot-header "Title")
:content-slot "Body" (slot-content "Body")
:footer-slot "End")))) (slot-footer "End")))))
(should (equal result "Title|Body|End"))))) (should (equal result "Title|Body|End")))))
(ert-deftest tp-test-widget-named-slots-partial () (ert-deftest tp-test-widget-named-slots-partial ()
@ -3681,7 +3681,7 @@ When using tp-set (direct property setting), tp-name is NOT added."
"|" "|"
(or (plist-get slots :footer) "[no-footer]")))) (or (plist-get slots :footer) "[no-footer]"))))
;; Only provide some slots ;; Only provide some slots
(let ((result (tp-widget-parse '(card :content-slot "Main")))) (let ((result (tp-widget-parse '(card (slot-content "Main")))))
(should (equal result "[no-header]|Main|[no-footer]"))))) (should (equal result "[no-header]|Main|[no-footer]")))))
(ert-deftest tp-test-widget-named-slots-with-props () (ert-deftest tp-test-widget-named-slots-with-props ()
@ -3700,8 +3700,8 @@ When using tp-set (direct property setting), tp-name is NOT added."
(let ((result (tp-widget-parse (let ((result (tp-widget-parse
'(article :title "My Post" '(article :title "My Post"
:author "John" :author "John"
:intro-slot "Introduction..." (slot-intro "Introduction...")
:body-slot "Main content...")))) (slot-body "Main content...")))))
(should (equal result "# My Post by John\nIntroduction...\nMain content..."))))) (should (equal result "# My Post by John\nIntroduction...\nMain content...")))))
(ert-deftest tp-test-widget-named-slots-with-nested-widgets () (ert-deftest tp-test-widget-named-slots-with-nested-widgets ()
@ -3719,8 +3719,8 @@ When using tp-set (direct property setting), tp-name is NOT added."
"|" "|"
(or (plist-get slots :right) "") "]"))) (or (plist-get slots :right) "") "]")))
(let ((result (tp-widget-parse (let ((result (tp-widget-parse
'(layout :left-slot (emphasis "Bold") '(layout (slot-left (emphasis "Bold"))
:right-slot "Plain")))) (slot-right "Plain")))))
(should (equal result "[*Bold*|Plain]"))))) (should (equal result "[*Bold*|Plain]")))))
;;; ============================================================ ;;; ============================================================

68
tp.el
View File

@ -3578,11 +3578,11 @@ Named Slots Example:
(plist-get slots :content) \"\\n\" (plist-get slots :content) \"\\n\"
(plist-get slots :footer)))) (plist-get slots :footer))))
;; Usage: ;; Usage - named slots use (slot<name> content...) sexp format:
(tp-widget-parse (tp-widget-parse
\\='(card :header-slot \"Title\" \\='(card (slot-header \"Title\")
:content-slot \"Body text\" (slot-content \"Body text\")
:footer-slot \"Footer\")) (slot-footer \"Footer\")))
Component Inheritance Example: Component Inheritance Example:
(tp-define-widget base-button (tp-define-widget base-button
@ -3718,6 +3718,21 @@ Returns nil if no default is specified."
(not (null slot-def)) (not (null slot-def))
(symbolp (car slot-def)))) (symbolp (car slot-def))))
(defun tp--widget-is-slot-sexp-p (form slot-def)
"Return non-nil if FORM is a named slot sexp like (slot-header content...).
SLOT-DEF is the list of defined slot names."
(and (listp form)
(symbolp (car form))
(let ((name (symbol-name (car form))))
(and (string-prefix-p "slot-" name)
(memq (intern (substring name 5)) slot-def)))))
(defun tp--widget-extract-slot-name (slot-sexp)
"Extract the slot name from SLOT-SEXP like (slot-header content...).
Returns the slot name as a symbol (e.g., \\='header)."
(let ((name (symbol-name (car slot-sexp))))
(intern (substring name 5))))
(defun tp-widget-parse (widget-form) (defun tp-widget-parse (widget-form)
"Parse and render a widget invocation. "Parse and render a widget invocation.
@ -3727,8 +3742,10 @@ supports slots).
The format is: (WIDGET-NAME :prop1 val1 :prop2 val2 ... SLOT-VALUES...) The format is: (WIDGET-NAME :prop1 val1 :prop2 val2 ... SLOT-VALUES...)
For named slots, use :slotname-slot keywords: For named slots, use (slot-<name> content...) sexp format:
(WIDGET-NAME :prop1 val1 :header-slot \"Header\" :content-slot \"Content\") (WIDGET-NAME :prop1 val1
(slot-header \"Header\")
(slot-content \"Content\"))
Keyword arguments must come before slot values. Slot values are all Keyword arguments must come before slot values. Slot values are all
remaining elements after the keyword-value pairs. Each slot value can be: remaining elements after the keyword-value pairs. Each slot value can be:
@ -3764,33 +3781,38 @@ Returns the rendered string with text properties applied."
(collected-props nil) (collected-props nil)
(collected-named-slots nil) (collected-named-slots nil)
(slot-parts nil)) (slot-parts nil))
;; Parse keyword arguments (including named slot keywords like :header-slot) ;; Parse keyword arguments first
(while (and args (keywordp (car args))) (while (and args (keywordp (car args)))
(let* ((key (car args)) (let ((key (car args))
(key-name (symbol-name key)) (val (cadr args)))
(val (cadr args))) (push (cons key val) collected-props)
;; 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)))) (setq args (cddr args))))
;; The remaining arguments are default slot values (if slot is supported) ;; Process remaining arguments (slot values or named slot sexps)
(when args (when args
(if slot-def (if slot-def
(if named-slots-p (if named-slots-p
;; For named slots, remaining args go to :default slot if defined ;; Named slots mode - look for (slot-<name> ...) sexps
(when (memq 'default slot-def) (dolist (arg args)
(setq slot-value (tp--widget-process-slot-args args))) (if (tp--widget-is-slot-sexp-p arg slot-def)
;; This is a named slot sexp
(let* ((slot-name (tp--widget-extract-slot-name arg))
(slot-keyword (intern (format ":%s" slot-name)))
(slot-content (cdr arg)))
(push (cons slot-keyword
(tp--widget-process-slot-args slot-content))
collected-named-slots))
;; Not a slot sexp - could be default slot content
(when (memq 'default slot-def)
(push (tp--widget-process-slot-value arg) slot-parts))))
;; Single slot mode ;; Single slot mode
(setq slot-value (tp--widget-process-slot-args args))) (setq slot-value (tp--widget-process-slot-args args)))
;; Slot not supported - warn about ignored arguments ;; Slot not supported - warn about ignored arguments
(warn "tp-widget-parse: Widget `%s' does not support slot content. \ (warn "tp-widget-parse: Widget `%s' does not support slot content. \
Ignoring arguments: %S" widget-name args))) Ignoring arguments: %S" widget-name args)))
;; Combine default slot parts if any
(when (and named-slots-p slot-parts)
(push (cons :default (apply #'concat (nreverse slot-parts)))
collected-named-slots))
;; Build named slots plist if using named slots ;; Build named slots plist if using named slots
(when named-slots-p (when named-slots-p
(let ((slots-plist nil)) (let ((slots-plist nil))