2
# the next line restarts using wish \
3
exec wish "$0" ${1+"$@"}
5
#==============================================================================
6
# Demonstrates the interactive tablelist cell editing with the aid of some
7
# widgets from the Iwidgets package and of the Tk core checkbutton widget.
9
# Copyright (c) 2004-2007 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
10
#==============================================================================
12
package require Tablelist
13
package require Iwidgets
15
wm title . "Serial Line Configuration"
18
# Add some entries to the Tk option database
20
set dir [file dirname [info script]]
21
source [file join $dir option.tcl]
22
option add *Tablelist*Checkbutton.background white
23
option add *Tablelist*Checkbutton.activeBackground white
24
option add *Tablelist*textBackground white
25
option add *Tablelist*Entry.disabledBackground white
26
option add *Tablelist*Entry.disabledForeground black
27
option add *Tablelist*Dateentry*Label.background white
28
option add *Tablelist*Timeentry*Label.background white
31
# Register some widgets from the Iwidgets package for interactive cell editing
33
tablelist::addIncrEntryfield
34
tablelist::addIncrSpinint
35
tablelist::addIncrCombobox
36
tablelist::addIncrDateTimeWidget dateentry -seconds
37
tablelist::addIncrDateTimeWidget timeentry -seconds
40
# Create two images, to be displayed in tablelist cells with boolean values
42
set checkedImg [image create photo -file [file join $dir checked.gif]]
43
set uncheckedImg [image create photo -file [file join $dir unchecked.gif]]
46
# Create a tablelist widget with editable columns (except the first one)
49
tablelist::tablelist $tbl \
50
-columns {0 "No." right
58
0 "Activation Date" center
59
0 "Activation Time" center} \
60
-editstartcommand editStartCmd -editendcommand editEndCmd \
62
if {[$tbl cget -selectborderwidth] == 0} {
63
$tbl configure -spacing 1
65
$tbl columnconfigure 0 -sortmode integer
66
$tbl columnconfigure 1 -name available -editable yes -editwindow checkbutton \
67
-formatcommand emptyStr
68
$tbl columnconfigure 2 -name lineName -editable yes -editwindow entryfield \
70
$tbl columnconfigure 3 -name baudRate -editable yes -editwindow combobox \
72
$tbl columnconfigure 4 -name dataBits -editable yes -editwindow spinint
73
$tbl columnconfigure 5 -name parity -editable yes -editwindow combobox
74
$tbl columnconfigure 6 -name stopBits -editable yes -editwindow combobox
75
$tbl columnconfigure 7 -name handshake -editable yes -editwindow combobox
76
$tbl columnconfigure 8 -name actDate -editable yes -editwindow dateentry \
77
-formatcommand formatDate -sortmode integer
78
$tbl columnconfigure 9 -name actTime -editable yes -editwindow timeentry \
79
-formatcommand formatTime -sortmode integer
81
proc emptyStr val { return "" }
82
proc formatDate val { return [clock format $val -format "%Y-%m-%d"] }
83
proc formatTime val { return [clock format $val -format "%H:%M:%S"] }
86
# Populate the tablelist widget; set the activation
87
# date & time to 10 minutes past the current clock value
89
set clock [clock seconds]
91
for {set n 1} {$n <= 8} {incr n} {
92
$tbl insert end [list $n 1 "Line $n" 9600 8 None 1 XON/XOFF $clock $clock]
93
$tbl cellconfigure end,available -image $checkedImg
95
for {set n 9} {$n <= 16} {incr n} {
96
$tbl insert end [list $n 0 "Line $n" 9600 8 None 1 XON/XOFF $clock $clock]
97
$tbl cellconfigure end,available -image $uncheckedImg
100
set btn [button .btn -text "Close" -command exit]
105
pack $btn -side bottom -pady 10
106
pack $tbl -side top -expand yes -fill both
108
#------------------------------------------------------------------------------
111
# Applies some configuration options to the edit window; if the latter is a
112
# combobox, the procedure populates it.
113
#------------------------------------------------------------------------------
114
proc editStartCmd {tbl row col text} {
115
set w [$tbl editwinpath]
117
switch [$tbl columncget $col -name] {
120
# Set an upper limit of 20 for the number of characters
122
$w configure -pasting no -fixed 20
127
# Populate the combobox and allow no more
128
# than 6 digits in its entry component
130
$w insert list end 50 75 110 300 1200 2400 4800 9600 19200 38400 \
131
57600 115200 230400 460800 921600
132
$w configure -pasting no -fixed 6 -validate numeric
137
# Configure the spinint widget
139
$w configure -range {5 8} -wrap no -pasting no -fixed 1 \
140
-validate {regexp {^[5-8]$} %c}
145
# Populate the combobox and make it non-editable
147
$w insert list end None Even Odd Mark Space
148
$w configure -editable no -listheight 120
153
# Populate the combobox and make it non-editable
155
$w insert list end 1 1.5 2
156
$w configure -editable no -listheight 90
161
# Populate the combobox and make it non-editable
163
$w insert list end XON/XOFF RTS/CTS None
164
$w configure -editable no -listheight 90
169
# Set the date format "%Y-%m-%d"
171
$w configure -int yes
176
# Set the time format "%H:%M:%S"
178
$w configure -format military
185
#------------------------------------------------------------------------------
188
# Performs a final validation of the text contained in the edit window and gets
189
# the cell's internal contents.
190
#------------------------------------------------------------------------------
191
proc editEndCmd {tbl row col text} {
192
switch [$tbl columncget $col -name] {
195
# Update the image contained in the cell
197
set img [expr {$text ? $::checkedImg : $::uncheckedImg}]
198
$tbl cellconfigure $row,$col -image $img
203
# Check whether the baud rate is an integer in the range 50..921600
205
if {![regexp {^[0-9]+$} $text] || $text < 50 || $text > 921600} {
207
tk_messageBox -title Error -icon error -type ok -message \
208
"The baud rate must be an integer in the range 50..921600"
215
# Check whether the # of data bits is an integer in the range 5..8
217
if {![regexp {^[5-8]$} $text]} {
219
tk_messageBox -title Error -icon error -type ok -message \
220
"The # of data bits must be an integer in the range 5..8"
227
# Check whether the activation clock value is later than the
228
# current one; if this is the case then make sure the cells
229
# "actDate" and "actTime" will have the same internal value
231
set actTime [$tbl cellcget $row,actTime -text]
232
set actClock [clock scan [formatTime $actTime] -base $text]
233
if {$actClock <= [clock seconds]} {
235
tk_messageBox -title Error -icon error -type ok -message \
236
"The activation date & time must be in the future"
239
$tbl cellconfigure $row,actTime -text $actClock
246
# Check whether the activation clock value is later than the
247
# current one; if this is the case then make sure the cells
248
# "actDate" and "actTime" will have the same internal value
250
set actDate [$tbl cellcget $row,actDate -text]
251
set actClock [clock scan [formatTime $text] -base $actDate]
252
if {$actClock <= [clock seconds]} {
254
tk_messageBox -title Error -icon error -type ok -message \
255
"The activation date & time must be in the future"
258
$tbl cellconfigure $row,actDate -text $actClock
added
removed
demos/iwidgets.tcl
