From d9dba48bb3776c131cd883aaac358a3c26d24381 Mon Sep 17 00:00:00 2001 From: Aleteoryx Date: Tue, 31 Dec 2024 19:07:16 -0500 Subject: [PATCH] forms! --- src/ui.tcl | 122 +++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 95 insertions(+), 27 deletions(-) diff --git a/src/ui.tcl b/src/ui.tcl index 38f3339..f931260 100644 --- a/src/ui.tcl +++ b/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 { 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!" } -- 2.45.2