New input widgets

docs/changelog.lisp

@@ -10,6 +10,22 @@
                               "REPL"
                               "CSS"
                               "HTTP"))
+  (0.4.0 2025-11-23
+         "
+## Added
+
+New input widgets were added:
+
+- textarea
+- selectbox
+- checkbox
+- modal
+
+## Changed
+
+- button now accepts optional name, value and type arguments. 
+
+")
   (0.3.0 2025-05-21
          "
 ## Fixes

reblocks-ui2-tailwind.asd

@@ -17,11 +17,15 @@
                "reblocks-ui2/containers/row/themes/tailwind"
                "reblocks-ui2/containers/column/themes/tailwind"
                "reblocks-ui2/inputs/text-input/themes/tailwind"
+               "reblocks-ui2/inputs/textarea/themes/tailwind"
+               "reblocks-ui2/inputs/select/themes/tailwind"
+               "reblocks-ui2/inputs/checkbox/themes/tailwind"
                "reblocks-ui2/themes/tailwind/padding"
                "reblocks-ui2/card/themes/tailwind"
                "reblocks-ui2/form/themes/tailwind"
                "reblocks-ui2/themes/tailwind/size"
                "reblocks-ui2/containers/controls-row/themes/tailwind"
                "reblocks-ui2/icon/themes/tailwind"
                "reblocks-ui2/buttons/themes/tailwind"
-               "reblocks-ui2/containers/tabs/themes/tailwind"))
+               "reblocks-ui2/containers/tabs/themes/tailwind"
+               "reblocks-ui2/modal/themes/tailwind"))

reblocks-ui2.asd

@@ -12,7 +12,9 @@
   :depends-on ("reblocks-ui2/core"
                "reblocks-ui2/containers/stack"
                "reblocks-ui2/tables/clickable-row"
+               "reblocks-ui2/editable/string"
                "reblocks-ui2/html"
+               "reblocks-ui2/tables/search"
                ;; And we need to explicitly specify this dependency
                ;; to load all necessary components of Reblocks.
                ;; Otherwise possible some strange errors like:

src/buttons/button.lisp

@@ -1,7 +1,6 @@
 (uiop:define-package #:reblocks-ui2/buttons/button
   (:use #:cl)
   (:import-from #:reblocks/widget
-                #:get-html-tag
                 #:create-widget-from
                 #:widget
                 #:defwidget)
@@ -21,6 +20,8 @@
                 #:css-classes
                 #:css-styles)
   (:import-from #:reblocks-ui2/widget
+                #:get-html-tag
+                #:html-attrs
                 #:widget-height
                 #:widget-width
                 #:on-click
@@ -31,6 +32,11 @@
   (:import-from #:reblocks-ui2/utils/pin
                 #:ensure-pin
                 #:pin)
+  (:import-from #:reblocks-ui2/inputs/base
+                #:input-value
+                #:base-input-widget)
+  (:import-from #:reblocks-ui2/inputs/named
+                #:input-name)
   (:export #:button
            #:button-content
            #:button-class
@@ -42,7 +48,7 @@
 (in-package #:reblocks-ui2/buttons/button)
 
 
-(defwidget button (ui-widget)
+(defwidget button (base-input-widget)
   ((content :initarg :content
             :type widget
             :accessor button-content)
@@ -64,17 +70,33 @@
    (disabled :initarg :disabled
              :initform nil
              :type boolean
-             :accessor button-disabled))
+             :accessor button-disabled)
+   (type :initarg :type
+         :initform nil
+         :type (or null string)
+         :accessor button-type
+         :documentation "If not given, then type will be \"button\" for a button having on-click callback or \"submit\" otherwise."))
   (:default-initargs :width :min))
 
 
-(defun button (content &key (widget-class 'button) on-click (class "button") disabled style
-                            (view :normal)
-                            (size :l)
-                            (pin :round)
-                            (width :min)
-                            height)
+(defun button (content &key
+                         name
+                         value
+                         type
+                         (widget-class 'button)
+                         on-click
+                         (class "button")
+                         disabled
+                         style
+                         (view :normal)
+                         (size :l)
+                         (pin :round)
+                         (width :min)
+                         height)
   (make-instance widget-class
+                 :name name
+                 :value value
+                 :type type
                  :content (create-widget-from content)
                  :on-click on-click
                  :class class
@@ -88,36 +110,54 @@
 
 
 (defmethod render ((widget button) (theme t))
+  (render (button-content widget)
+          theme))
+
+
+(defmethod css-classes ((widget button) (theme t) &key)
+  (let ((view (if (button-disabled widget)
+                  (get-disabled-button-view (button-view widget))
+                  (button-view widget))))
+    (list
+     (button-class widget)
+     view
+     (widget-width widget)
+     (widget-height widget)
+     (button-size widget)
+     (button-pin widget)
+     ;; TODO: this is a Tailwind's property
+     ;; and we need to replace it with some object
+     ;; which will return css classes depending on theme.
+     "whitespace-nowrap")))
+
+
+(defmethod get-html-tag ((button button) (theme t))
+  :button)
+
+
+(defmethod html-attrs ((widget button) (theme t))
   (let ((view (if (button-disabled widget)
                   (get-disabled-button-view (button-view widget))
                   (button-view widget))))
-    (with-html ()
-      (:button :type (if (on-click widget)
-                         ;; We need to set type to button for all buttons having
-                         ;; having on-click handler to prevent the handler to be
-                         ;; triggered when button is in the form and user hits
-                         ;; Enter on some text-input field:
-                         ;; https://stackoverflow.com/questions/62144665
-                         "button"
-                         "submit")
-               :class (join-css-classes theme
-                                        (button-class widget)
-                                        view
-                                        (widget-width widget)
-                                        (widget-height widget)
-                                        (button-size widget)
-                                        (button-pin widget)
-                                        ;; TODO: this is a Tailwind's property
-                                        ;; and we need to replace it with some object
-                                        ;; which will return css classes depending on theme.
-                                        "whitespace-nowrap")
-               :style (join-css-styles (button-style widget)
-                                       (css-styles view
-                                                   theme)
-                                       (css-styles (button-size widget)
-                                                   theme)
-                                       (css-styles (button-pin widget)
-                                                   theme))
-               :disabled (button-disabled widget)
-               (render (button-content widget)
-                       theme)))))
+    (list :type (cond
+                  ((button-type widget)
+                   (button-type widget))
+                  ((on-click widget)
+                   ;; We need to set type to button for all buttons having
+                   ;; having on-click handler to prevent the handler to be
+                   ;; triggered when button is in the form and user hits
+                   ;; Enter on some text-input field:
+                   ;; https://stackoverflow.com/questions/62144665
+                   "button")
+                  (t
+                   "submit"))
+          :name (input-name widget)
+          :value (input-value widget)
+          :style (join-css-styles (button-style widget)
+                                  (css-styles view
+                                              theme)
+                                  (css-styles (button-size widget)
+                                              theme)
+                                  (css-styles (button-pin widget)
+                                              theme))
+          :disabled (button-disabled widget))))

src/buttons/themes/tailwind.lisp

@@ -153,10 +153,3 @@
          (:brick nil)
          (:round (add-size-suffix "rounded-r"))
          (:circle "rounded-r-full"))))))
-
-
-;; Button's outer container
-(defmethod css-classes ((button button) (theme tailwind-theme) &key)
-  (list
-   ;; To make it possible to add a button iside a text block.
-   "inline-block"))

src/card.lisp

@@ -34,6 +34,8 @@
   (:import-from #:reblocks-ui2/utils/align
                 #:vertical-align
                 #:horizontal-align)
+  (:import-from #:reblocks-ui2/utils/margin
+                #:margin)
   (:export #:card
            #:card-widget
            #:card-content
@@ -71,7 +73,7 @@
                      (width "full")
                      (height '(120 . nil))
                      (padding :l)
-                     margin
+                     (margin '(nil nil))
                      (horizontal-align :center)
                      (vertical-align :center)
                      on-click
@@ -85,4 +87,4 @@
                  :horizontal-align (horizontal-align horizontal-align)
                  :vertical-align (vertical-align vertical-align)
                  :padding (padding padding)
-                 :margin margin))
+                 :margin (margin margin)))

src/containers/container.lisp

@@ -47,19 +47,20 @@
   (loop with collecting-subwidgets-p = t
         for item in subwidgets-and-options
         when (keywordp item)
-        do (setf collecting-subwidgets-p nil)
+          do (setf collecting-subwidgets-p nil)
         if collecting-subwidgets-p
-        collect item into subwidgets
+          collect item into subwidgets
         else
-        collect item into options
+          collect item into options
         finally (return
-                  (destructuring-bind (&key (gap *default-gap*)
-                                            (column-type default-widget-class)
-                                            margin
-                                            (width :full)
-                                            height
-                                            on-click
-                                            css-classes)
+                  (destructuring-bind (&key
+                                         (gap *default-gap*)
+                                         (column-type default-widget-class)
+                                         margin
+                                         (width :full)
+                                         height
+                                         on-click
+                                         css-classes)
                       options
                     (make-instance column-type
                                    :subwidgets (mapcar #'create-widget-from

src/events.lisp

@@ -3,11 +3,12 @@
   (:import-from #:event-emitter
                 #:event-emitter)
   (:import-from #:reblocks/widget
-                #:defwidget
-                #:widget)
+                #:defwidget)
+  (:import-from #:reblocks-ui2/widget
+                #:ui-widget)
   (:export #:event-emitting-widget))
 (in-package #:reblocks-ui2/events)
 
 
-(defwidget event-emitting-widget (event-emitter widget)
+(defwidget event-emitting-widget (event-emitter ui-widget)
   ())

src/form.lisp

@@ -20,13 +20,17 @@
                 #:input-name
                 #:named-input)
   (:import-from #:reblocks-ui2/utils/walk
+                #:children
                 #:walk)
   (:import-from #:alexandria
+                #:hash-table-values
                 #:make-keyword
                 #:length=)
   (:import-from #:str
                 #:downcase)
   (:import-from #:trivial-arguments)
+  (:import-from #:reblocks-ui2/events
+                #:event-emitting-widget)
   (:export #:form-widget
            #:form-content
            #:form-on-submit
@@ -39,7 +43,7 @@
   (log:info "Empty action was called with" args))
 
 
-(defwidget form-widget (ui-widget)
+(defwidget form-widget (event-emitting-widget)
   ((content :initarg :content
             :reader form-content)
    (on-submit :initarg :on-submit
@@ -104,24 +108,31 @@
 
 (defun form (content &key (widget-class 'form-widget)
                           on-submit)
-  (let ((widget (make-instance widget-class
-                               :content content)))
+  (let ((form-widget (make-instance widget-class
+                                    :content content)))
     (when on-submit
-      (validate-on-submit-fun-args content on-submit)
+      ;; NOTE: Previously I've thought it is a good idea to validate
+      ;; argument names when form widget is created, but in general case
+      ;; all text-inputs can be known only after the form was rendered,
+      ;; because form content can use a generic HTML widget as it's content
+      ;; (validate-on-submit-fun-args content on-submit)
 
-      (setf (slot-value widget 'on-submit)
-            (make-on-submit-wrapper widget on-submit)))
-    (values widget)))
+      (setf (slot-value form-widget 'on-submit)
+            (make-on-submit-wrapper form-widget on-submit)))
+    (values form-widget)))
 
 
-(defun make-on-submit-wrapper (widget on-submit-func)
+(defun make-on-submit-wrapper (form-widget on-submit-func)
   "Makes an action handler which calls on-submit-func only with validated values of all form inputs"
   (flet ((on-submit (&rest form-data)
            (handler-case
-               (let ((validated-data (validate-form-data widget form-data)))
-                 (apply on-submit-func widget validated-data))
+               (let ((validated-data (validate-form-data form-widget form-data)))
+                 (apply on-submit-func form-widget validated-data)
+                 (event-emitter:emit :submit form-widget
+                                     form-widget
+                                     validated-data))
              (validation-error ()
-               (update widget)))))
+               (update form-widget)))))
     #'on-submit))
 
 
@@ -149,3 +160,7 @@
              name)
     (setf (gethash name (form-inputs *current-form*))
           widget)))
+
+
+(defmethod children ((widget form-widget))
+  (hash-table-values (form-inputs widget)))

src/form/validation.lisp

@@ -26,6 +26,12 @@
                     (error-args condition)))))
 
 
+(defun validation-error (message &rest args)
+  (error 'validation-error
+         :error-message message
+         :error-args args))
+
+
 (define-condition form-validation-error (validation-error)
   ((num-errors :initarg :num-errors
                :reader num-errors)))