1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
namespace eval ui {}
namespace eval ui::basic {}
proc ui::basic::setup {mount} {
global version
menu $mount.menu
$mount configure -menu "$mount.menu"
menu $mount.menu.conn
menu $mount.menu.server
menu $mount.menu.me
$mount.menu.me add command -label "About" -command [subst {
tk_messageBox -title "About tclircc" \
-message "tclircc $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" -menu $mount.menu.me
}
proc ui::basic::teardown {mount} {
destroy $mount.menu
}
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 <Destroy> {
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!"
}