1 files changed, 95 insertions(+), 27 deletions(-)

M src/ui.tcl

@@ 31,13 31,13 @@ namespace eval ui::form {
   variable form_n 0
 }
 
-proc ui::form::show {title heading fields check finish cancel} {
+proc ui::form::show {title heading fields finish {cancel {}}} {
   variable forms
   variable form_n
   set tl .form$form_n
   incr form_n
 
-  set forms(${tl}) [list fields $fields  check $check  finish $finish  cancel $cancel]
+  set forms(${tl}) [list fields $fields  finish $finish  cancel $cancel]
 
   set pad_n 0
 


@@ 49,58 49,126 @@ proc ui::form::show {title heading fields check finish cancel} {
   pack $tl.pad$pad_n -side top
   incr pad_n
 
-  foreach {framed text widget name args} $fields {
+  foreach {framed text widget name args check} $fields {
     if {$framed} {
-      frame $tl.field_$name
-      label $tl.field_$name.lbl -text $text
-      $widget $tl.field_$name.wgt {*}$args ::ui::form::forms(${tl}:$name)
-      pack $tl.field_$name.lbl -side left
-      pack $tl.field_$name.wgt -side right
-      pack $tl.field_$name -side top -anchor w
+      frame $tl.field_${name}_f
+      label $tl.field_${name}_f.lbl -text $text
+      $widget $tl.field_${name}_f.wgt {*}$args ::ui::form::forms(${tl}:$name)
+      pack $tl.field_${name}_f.lbl -side left
+      pack $tl.field_${name}_f.wgt -side right
+      pack $tl.field_${name}_f -side top -anchor w
     } else {
       label $tl.field_${name}_lbl -text $text
       $widget $tl.field_${name}_wgt {*}$args ::ui::form::forms(${tl}:$name)
       pack $tl.field_${name}_lbl -side top -anchor w
       pack $tl.field_${name}_wgt -side top -anchor w
     }
-    label $tl.field_${name}_err -height 0
-    pack $tl.field_${name}_err -side top -anchor w
+    frame $tl.field_${name}_err_anchor
+    pack $tl.field_${name}_err_anchor -side top
+    label $tl.field_${name}_err -fg red -justify left
     frame $tl.pad$pad_n -height 10
     pack $tl.pad$pad_n -side top
     incr pad_n
   }
 
   frame $tl.buttons
-  button $tl.buttons.cancel -text "Cancel" -command [concat [list set tl $tl] {;
-    array unset ::ui::form::forms($tl)
-    array unset ::ui::form::forms(${tl}:*)
-    destroy $tl
-    eval [dict get [set ::ui::form::forms($tl)] cancel]
-  }]
   button $tl.buttons.ok -text "Ok" -command [concat [list set tl $tl] {;
+    set waserror 0
     set formdata {}
-    foreach {framed text widget name args} [dict get [set ::ui::form::forms($tl)] fields] {
-      dict set formdata $name [set ::ui::form::forms(${tl}:$name)]
+    set wraplength [winfo width $tl]
+    foreach {framed text widget name args check} [dict get [set ::ui::form::forms($tl)] fields] {
+      set value [set ::ui::form::forms(${tl}:$name)]
+      dict set formdata $name $value
+
+      if {$check == {} || [set err [eval [list {*}[concat $check [list $value]]]]] == {}} {
+        $tl.field_${name}_err configure -height -1 -text ""
+        pack forget $tl.field_${name}_err
+      } else {
+        set waserror 1
+        $tl.field_${name}_err configure -height 0 -text $err -wraplength $wraplength
+        pack $tl.field_${name}_err -side top -anchor w -after $tl.field_${name}_err_anchor
+      }
     }
 
-    if {[set errs [eval [dict get [set ::ui::form::forms($tl)] check]]] != {}} {
-      ...
-    } else {
-      array unset ::ui::form::forms($tl)
-      array unset ::ui::form::forms(${tl}:*)
-      destroy $tl
+    ::ui::form::recalculate_dims $tl
+
+    if {!$waserror} {
       eval [dict get [set ::ui::form::forms($tl)] finish]
+      unset ::ui::form::forms($tl)
+      array unset ::ui::form::forms ${tl}:*
+      destroy $tl
     }
   }]
+  button $tl.buttons.cancel -text "Cancel" -command [concat [list set tl $tl] {;
+    eval [dict get [set ::ui::form::forms($tl)] cancel]
+    unset ::ui::form::forms($tl)
+    array unset ::ui::form::forms ${tl}:*
+    destroy $tl
+  }]
   bind $tl <Destroy> {
     if {[info exists ::ui::form::forms(%W)]} {
-      array unset ::ui::form::forms(%W)
-      array unset ::ui::form::forms(%W:*)
       eval [dict get [set ::ui::form::forms(%W)] cancel]
+      unset ::ui::form::forms(%W)
+      array unset ::ui::form::forms %W:*
     }
   }
 
   pack $tl.buttons.cancel -side left
   pack $tl.buttons.ok -side left
   pack $tl.buttons -side top -anchor w
+
+  recalculate_dims $tl
+  wm resizable $tl 0 0
+}
+proc ::ui::form::recalculate_dims {window} {
+  update
+  set minwidth 0
+  set minheight 0
+  foreach widget [pack content $window] {
+    if ![string match *_err $widget] {
+      set minwidth [expr {max($minwidth, [winfo width $widget])}]
+    }
+    incr minheight [winfo height $widget]
+  }
+
+  wm minsize $window $minwidth $minheight
+}
+
+proc ::ui::form::not_empty {name value} {
+  if ![string length $value] {
+    return "$name cannot be empty."
+  }
+}
+proc ::ui::form::min_length {min_length name value} {
+  if {[string length $value] < $min_length} {
+    return "$name must be $min_length chars or greater."
+  }
+}
+proc ::ui::form::max_length {max_length name value} {
+  if {[string length $value] > $max_length} {
+    return "$name must be $max_length chars or less."
+  }
+}
+proc ::ui::form::length_range {min_length max_length name value} {
+  if {[string length $value] > $max_length} {
+    return "$name must be $max_length chars or less."
+  } elseif {[string length $value] < $min_length} {
+    return "$name must be $min_length chars or greater."
+  }
+}
+proc ::ui::form::test_regexp {regexp err value} {
+  if ![regexp $regexp $value] {
+    return $err
+  }
+}
+
+::ui::form::show "Log in" "Enter your credentials" {
+  1 "Username" entry "username" {-textvariable}
+    {::ui::form::test_regexp {^[a-zA-Z_0-9]+$} "Username must only contain letters, numbers, and underscores."}
+  1 "Password" entry "password" {-show * -textvariable}
+    {::ui::form::not_empty "Password"}
+} {
+  puts "got formdata: $formdata"
+} {
+  puts "cancelled!"
 }