From 09b56b584e6d8ffc333558f1dd496a3a013f6a26 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 28 Dec 2025 19:15:44 +0000 Subject: [PATCH] Implement tp-define-twidget and tp-widget-parse for widget definition and parsing Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com> --- tp-tests.el | 147 ++++++++++++++++++++++++++++++++++++++++++++++++++++ tp.el | 135 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 282 insertions(+) diff --git a/tp-tests.el b/tp-tests.el index 31fa36b..67ab73d 100644 --- 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 diff --git a/tp.el b/tp.el index 76fc76a..85e5521 100644 --- 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