1#!/bin/sh 2# the next line restarts using wish \ 3exec wish "$0" ${1+"$@"} 4 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. 8# 9# Copyright (c) 2004-2010 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) 10#============================================================================== 11 12package require tablelist_tile 5.1 13package require Iwidgets 14 15wm title . "Serial Line Configuration" 16 17# 18# Add some entries to the Tk option database 19# 20set dir [file dirname [info script]] 21source [file join $dir option_tile.tcl] 22option add *Tablelist*Checkbutton.background white 23option add *Tablelist*Checkbutton.activeBackground white 24option add *Tablelist*textBackground white 25option add *Tablelist*Entry.disabledBackground white 26option add *Tablelist*Entry.disabledForeground black 27option add *Tablelist*Dateentry*Label.background white 28option add *Tablelist*Timeentry*Label.background white 29 30# 31# Register some widgets from the Iwidgets package for interactive cell editing 32# 33tablelist::addIncrEntryfield 34tablelist::addIncrSpinint 35tablelist::addIncrCombobox 36tablelist::addIncrDateTimeWidget dateentry -seconds 37tablelist::addIncrDateTimeWidget timeentry -seconds 38 39# 40# Create two images, to be displayed in tablelist cells with boolean values 41# 42set checkedImg [image create photo -file [file join $dir checked.gif]] 43set uncheckedImg [image create photo -file [file join $dir unchecked.gif]] 44 45# 46# Improve the window's appearance by using a tile 47# frame as a container for the other widgets 48# 49set f [ttk::frame .f] 50 51# 52# Create a tablelist widget with editable columns (except the first one) 53# 54set tbl $f.tbl 55tablelist::tablelist $tbl \ 56 -columns {0 "No." right 57 0 "Available" center 58 0 "Name" left 59 0 "Baud Rate" right 60 0 "Data Bits" center 61 0 "Parity" left 62 0 "Stop Bits" center 63 0 "Handshake" left 64 0 "Activation Date" center 65 0 "Activation Time" center} \ 66 -editstartcommand editStartCmd -editendcommand editEndCmd \ 67 -height 0 -width 0 68if {[$tbl cget -selectborderwidth] == 0} { 69 $tbl configure -spacing 1 70} 71$tbl columnconfigure 0 -sortmode integer 72$tbl columnconfigure 1 -name available -editable yes -editwindow checkbutton \ 73 -formatcommand emptyStr 74$tbl columnconfigure 2 -name lineName -editable yes -editwindow entryfield \ 75 -sortmode dictionary 76$tbl columnconfigure 3 -name baudRate -editable yes -editwindow combobox \ 77 -sortmode integer 78$tbl columnconfigure 4 -name dataBits -editable yes -editwindow spinint 79$tbl columnconfigure 5 -name parity -editable yes -editwindow combobox 80$tbl columnconfigure 6 -name stopBits -editable yes -editwindow combobox 81$tbl columnconfigure 7 -name handshake -editable yes -editwindow combobox 82$tbl columnconfigure 8 -name actDate -editable yes -editwindow dateentry \ 83 -formatcommand formatDate -sortmode integer 84$tbl columnconfigure 9 -name actTime -editable yes -editwindow timeentry \ 85 -formatcommand formatTime -sortmode integer 86 87proc emptyStr val { return "" } 88proc formatDate val { return [clock format $val -format "%Y-%m-%d"] } 89proc formatTime val { return [clock format $val -format "%H:%M:%S"] } 90 91# 92# Populate the tablelist widget; set the activation 93# date & time to 10 minutes past the current clock value 94# 95set clock [clock seconds] 96incr clock 600 97for {set n 1} {$n <= 8} {incr n} { 98 $tbl insert end [list $n 1 "Line $n" 9600 8 None 1 XON/XOFF $clock $clock] 99 $tbl cellconfigure end,available -image $checkedImg 100} 101for {set n 9} {$n <= 16} {incr n} { 102 $tbl insert end [list $n 0 "Line $n" 9600 8 None 1 XON/XOFF $clock $clock] 103 $tbl cellconfigure end,available -image $uncheckedImg 104} 105 106set btn [ttk::button $f.btn -text "Close" -command exit] 107 108# 109# Manage the widgets 110# 111pack $btn -side bottom -pady 10 112pack $tbl -side top -expand yes -fill both 113pack $f -expand yes -fill both 114 115#------------------------------------------------------------------------------ 116# editStartCmd 117# 118# Applies some configuration options to the edit window; if the latter is a 119# combobox, the procedure populates it. 120#------------------------------------------------------------------------------ 121proc editStartCmd {tbl row col text} { 122 set w [$tbl editwinpath] 123 124 switch [$tbl columncget $col -name] { 125 lineName { 126 # 127 # Set an upper limit of 20 for the number of characters 128 # 129 $w configure -pasting no -fixed 20 130 } 131 132 baudRate { 133 # 134 # Populate the combobox and allow no more 135 # than 6 digits in its entry component 136 # 137 $w insert list end 50 75 110 300 1200 2400 4800 9600 19200 38400 \ 138 57600 115200 230400 460800 921600 139 $w configure -pasting no -fixed 6 -validate numeric 140 } 141 142 dataBits { 143 # 144 # Configure the spinint widget 145 # 146 $w configure -range {5 8} -wrap no -pasting no -fixed 1 \ 147 -validate {regexp {^[5-8]$} %c} 148 } 149 150 parity { 151 # 152 # Populate the combobox and make it non-editable 153 # 154 $w insert list end None Even Odd Mark Space 155 $w configure -editable no -listheight 120 156 } 157 158 stopBits { 159 # 160 # Populate the combobox and make it non-editable 161 # 162 $w insert list end 1 1.5 2 163 $w configure -editable no -listheight 90 164 } 165 166 handshake { 167 # 168 # Populate the combobox and make it non-editable 169 # 170 $w insert list end XON/XOFF RTS/CTS None 171 $w configure -editable no -listheight 90 172 } 173 174 actDate { 175 # 176 # Set the date format "%Y-%m-%d" 177 # 178 $w configure -int yes 179 } 180 181 actTime { 182 # 183 # Set the time format "%H:%M:%S" 184 # 185 $w configure -format military 186 } 187 } 188 189 return $text 190} 191 192#------------------------------------------------------------------------------ 193# editEndCmd 194# 195# Performs a final validation of the text contained in the edit window and gets 196# the cell's internal contents. 197#------------------------------------------------------------------------------ 198proc editEndCmd {tbl row col text} { 199 switch [$tbl columncget $col -name] { 200 available { 201 # 202 # Update the image contained in the cell 203 # 204 set img [expr {$text ? $::checkedImg : $::uncheckedImg}] 205 $tbl cellconfigure $row,$col -image $img 206 } 207 208 baudRate { 209 # 210 # Check whether the baud rate is an integer in the range 50..921600 211 # 212 if {![regexp {^[0-9]+$} $text] || $text < 50 || $text > 921600} { 213 bell 214 tk_messageBox -title "Error" -icon error -message \ 215 "The baud rate must be an integer in the range 50..921600" 216 $tbl rejectinput 217 } 218 } 219 220 dataBits { 221 # 222 # Check whether the # of data bits is an integer in the range 5..8 223 # 224 if {![regexp {^[5-8]$} $text]} { 225 bell 226 tk_messageBox -title "Error" -icon error -message \ 227 "The # of data bits must be an integer in the range 5..8" 228 $tbl rejectinput 229 } 230 } 231 232 actDate { 233 # 234 # Check whether the activation clock value is later than the 235 # current one; if this is the case then make sure the cells 236 # "actDate" and "actTime" will have the same internal value 237 # 238 set actTime [$tbl cellcget $row,actTime -text] 239 set actClock [clock scan [formatTime $actTime] -base $text] 240 if {$actClock <= [clock seconds]} { 241 bell 242 tk_messageBox -title "Error" -icon error -message \ 243 "The activation date & time must be in the future" 244 $tbl rejectinput 245 } else { 246 $tbl cellconfigure $row,actTime -text $actClock 247 return $actClock 248 } 249 } 250 251 actTime { 252 # 253 # Check whether the activation clock value is later than the 254 # current one; if this is the case then make sure the cells 255 # "actDate" and "actTime" will have the same internal value 256 # 257 set actDate [$tbl cellcget $row,actDate -text] 258 set actClock [clock scan [formatTime $text] -base $actDate] 259 if {$actClock <= [clock seconds]} { 260 bell 261 tk_messageBox -title "Error" -icon error -message \ 262 "The activation date & time must be in the future" 263 $tbl rejectinput 264 } else { 265 $tbl cellconfigure $row,actDate -text $actClock 266 return $actClock 267 } 268 } 269 } 270 271 return $text 272} 273