namespace eval ui {} namespace eval ui::basic { variable toplevels } proc ui::basic::setup {mount} { global version variable toplevels set toplevels($mount) {} menu $mount.menu $mount configure -menu $mount.menu menu $mount.menu.conn menu $mount.menu.network $mount.menu.network add command -label "Add a Network" -command ::ui::basic::addnetwork $mount.menu.network add separator menu $mount.menu.me $mount.menu.me add command -label "About" -command [subst { tk_messageBox -title "About tclircc" \ -message "tclircc v${version}" \ -detail "by Aleteoryx\nhttps://amehut.dev/~aleteoryx/tclircc\n\nThis software is in the public domain." \ -type ok \ -parent $mount }] $mount.menu add cascade -label "Connections" -menu $mount.menu.conn $mount.menu add cascade -label "Networks" -menu $mount.menu.network $mount.menu add cascade -label "tclircc v${version}" -menu $mount.menu.me menu_update } proc ui::basic::teardown {mount} { variable toplevels unset toplevels($mount) destroy $mount.menu } proc ui::basic::menu_update {} { variable toplevels set networks [::db::networks::ls core_db] } namespace eval ui::form { variable forms variable form_n 0 } 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 finish $finish cancel $cancel] set pad_n 0 toplevel $tl wm title $tl $title label $tl.heading -text $heading -font TkHeadingFont pack $tl.heading -side top frame $tl.pad$pad_n -height 10 pack $tl.pad$pad_n -side top incr pad_n foreach {framed text widget name args check} $fields { if {$framed} { 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 } 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.ok -text "Ok" -command [concat [list set tl $tl] {; set waserror 0 set formdata {} 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 } } ::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)]} { 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!" }