Implement tp-define-twidget and tp-widget-parse for widget definition and parsing

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>
2025-12-28 19:15:44 +00:00 · 2025-12-28 19:15:44 +00:00 · 09b56b584e
commit 09b56b584e
parent 64ef1c02bc
2 changed files with 282 additions and 0 deletions
--- a/tp-tests.el
+++ b/tp-tests.el
@ -3429,5 +3429,152 @@ When using tp-set (direct property setting), tp-name is NOT added."
      ;; Face property exists
      (should (get-text-property 0 'face result)))))

+;;; ============================================================
+;;; Twidget (Text Widget) Tests
+;;; ============================================================
+
+(ert-deftest tp-test-define-twidget-basic ()
+  "Test basic twidget definition."
+  (tp-test-with-temp-buffer
+    (tp-twidget-reset)
+    (tp-define-twidget test-widget
+      :props '(name)
+      :slot 'content
+      :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 (equal (plist-get def :props) '(name)))
+      (should (equal (plist-get def :slot) 'content)))))
+
+(ert-deftest tp-test-widget-parse-basic ()
+  "Test basic widget parsing."
+  (tp-test-with-temp-buffer
+    (tp-twidget-reset)
+    (tp-define-twidget greeting
+      :props '(name)
+      :slot 'message
+      :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-twidget-reset)
+    (tp-define-twidget styled-text
+      :props '((color . "blue") message)
+      :slot 'text
+      :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-twidget-reset)
+    ;; Define a simple widget that applies text properties
+    (tp-define-twidget bold-text
+      :props '((color . "black"))
+      :slot 'content
+      :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-twidget-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
+    (tp-define-twidget button
+      :props '(action (bgcolor . "green"))
+      :slot 'label
+      :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)
+                          'button-action `(: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 button-action property is applied
+      (let ((action-prop (get-text-property 2 'button-action result)))
+        (should (listp (plist-get action-prop :action)))))))
+
+(ert-deftest tp-test-twidget-reset ()
+  "Test twidget reset clears all definitions."
+  (tp-test-with-temp-buffer
+    (tp-twidget-reset)
+    (tp-define-twidget test-widget1
+      :props '(a)
+      :slot 'b
+      :render (lambda (p s) ""))
+    (tp-define-twidget test-widget2
+      :props '(c)
+      :slot 'd
+      :render (lambda (p s) ""))
+    (should (= (length tp-twidget-alist) 2))
+    (tp-twidget-reset)
+    (should (= (length tp-twidget-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)
+    (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-define-twidget multi-prop
+      :props '(required (opt1 . "default1") (opt2 . "default2"))
+      :slot 'content
+      :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")))))
+
 (provide 'tp-ert-tests)
 ;;; tp-ert-tests.el ends here
--- a/tp.el
+++ b/tp.el
@ -3533,5 +3533,140 @@ Returns the modified object (string) or nil for buffer operations."
       (read-only-mode 1))
     (pop-to-buffer buffer)))

+;;;============================================================================
+;;; Widget System: Component Definition and Parsing
+;;;============================================================================
+
+(defvar tp-twidget-alist nil
+  "Alist of twidget definitions: (TWIDGET-NAME . DEFINITION).
+Each DEFINITION is a plist with :props, :slot, and :render keys.")
+
+(defmacro tp-define-twidget (name &rest args)
+  "Define a text widget (twidget) named NAME.
+
+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)
+  :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)
+
+Example:
+  (tp-define-twidget button
+    :props \\='(action (bgcolor . \"green\"))
+    :slot \\='label
+    :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)))))"
+  (declare (indent defun))
+  (let ((props nil)
+        (slot nil)
+        (render nil)
+        (rest args))
+    ;; Parse keyword arguments
+    (while rest
+      (pcase (car rest)
+        (:props (setq props (cadr rest) rest (cddr rest)))
+        (:slot (setq slot (cadr rest) rest (cddr rest)))
+        (:render (setq render (cadr rest) rest (cddr rest)))
+        (_ (error "Unknown keyword %S in tp-define-twidget" (car rest)))))
+    `(tp--define-twidget-internal ',name ,props ,slot ,render)))
+
+(defun tp--define-twidget-internal (name props slot render)
+  "Internal function to define a twidget NAME with PROPS, SLOT, and RENDER.
+PROPS is a list of property definitions.
+SLOT is the slot name symbol.
+RENDER is the render function."
+  (let ((definition (list :props props :slot slot :render render)))
+    (if (assoc name tp-twidget-alist)
+        (setf (cdr (assoc name tp-twidget-alist)) definition)
+      (push (cons name definition) tp-twidget-alist)))
+  (assoc name tp-twidget-alist))
+
+(defun tp--twidget-prop-name (prop-def)
+  "Extract the property name from PROP-DEF.
+PROP-DEF can be a symbol or a cons cell (SYMBOL . DEFAULT)."
+  (if (consp prop-def)
+      (car prop-def)
+    prop-def))
+
+(defun tp--twidget-prop-default (prop-def)
+  "Extract the default value from PROP-DEF.
+Returns nil if no default is specified."
+  (if (consp prop-def)
+      (cdr prop-def)
+    nil))
+
+(defun tp--twidget-prop-has-default-p (prop-def)
+  "Return non-nil if PROP-DEF has a default value."
+  (consp prop-def))
+
+(defun tp-widget-parse (widget-form)
+  "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 the slot value.
+
+Example:
+  (tp-widget-parse
+   \\='(button :action (lambda ()
+                      (interactive)
+                      (message \"button clicked!\"))
+            \"CLICK\"))
+
+Returns the rendered string with text properties applied."
+  (unless (and (listp widget-form) (symbolp (car widget-form)))
+    (error "Invalid widget form: must be a list starting with widget name"))
+  (let* ((widget-name (car widget-form))
+         (rest (cdr widget-form))
+         (definition (cdr (assoc widget-name tp-twidget-alist))))
+    (unless definition
+      (error "Undefined twidget: %S" widget-name))
+    (let* ((prop-defs (plist-get definition :props))
+           (slot-name (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)
+      (let ((args rest)
+            (collected-props 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 is the slot value
+        (when args
+          (setq slot-value (car args)))
+        ;; Build the props plist with defaults
+        (dolist (prop-def prop-defs)
+          (let* ((prop-name (tp--twidget-prop-name prop-def))
+                 (prop-keyword (intern (format ":%s" prop-name)))
+                 (provided (assoc prop-keyword collected-props)))
+            (if provided
+                (setq parsed-props (plist-put parsed-props prop-keyword (cdr provided)))
+              ;; Use default value if available
+              (when (tp--twidget-prop-has-default-p prop-def)
+                (setq parsed-props (plist-put parsed-props prop-keyword
+                                              (tp--twidget-prop-default prop-def))))))))
+      ;; Call the render function
+      (funcall render-fn parsed-props slot-value))))
+
+(defun tp-twidget-reset ()
+  "Reset all twidget definitions."
+  (interactive)
+  (setq tp-twidget-alist nil))
+
 (provide 'tp)
 ;;; tp.el ends here