diff options
Diffstat (limited to 'demos/dynarows.tcl')
-rwxr-xr-x | demos/dynarows.tcl | 87 |
1 files changed, 87 insertions, 0 deletions
diff --git a/demos/dynarows.tcl b/demos/dynarows.tcl new file mode 100755 index 0000000..9006953 --- /dev/null +++ b/demos/dynarows.tcl @@ -0,0 +1,87 @@ +#!/bin/sh +# the next line restarts using wish \ +exec wish "$0" ${1+"$@"} + +## dynarows.tcl +## +## This demos shows the use of the validation mechanism of the table +## and uses the table's cache (no -command or -variable) with a cute +## dynamic row routine. +## +## jeff at hobbs org + +source [file join [file dirname [info script]] loadtable.tcl] + +proc table_validate {w idx} { + if {[scan $idx %d,%d row col] != 2} return + set val [$w get $idx] + + ## Entries in the last row are allowed to be empty + set nrows [$w cget -rows] + if {$row == ${nrows}-1 && [string match {} $val]} { return } + + if {[catch {clock scan $val} time]} { + bell + $w activate $idx + $w selection clear all + $w selection set active + $w see active + } else { + set date {} + foreach item [clock format $time -format "%m %d %Y"] { + lappend date [string trimleft $item "0"] + } + $w set $idx [join $date "/"] + if {$row == ${nrows}-1} { + ## if this is the last row and both cols 1 && 2 are not empty + ## then add a row and redo configs + if {[string comp [$w get $row,1] {}] && \ + [string comp [$w get $row,2] {}]} { + $w tag row {} $row + $w set $row,0 $row + $w configure -rows [incr nrows] + $w tag row unset [incr row] + $w set $row,0 "*" + $w see $row,1 + $w activate $row,1 + } + } + } +} + +label .example -text "Dynamic Date Validated Rows" + +set t .table +table $t -rows 2 -cols 3 -cache 1 -selecttype row \ + -titlerows 1 -titlecols 1 \ + -yscrollcommand { .sy set } \ + -xscrollcommand { .sx set } \ + -height 5 -colstretch unset -rowstretch unset \ + -autoclear 1 -browsecommand {table_validate %W %s} + +$t set 0,1 "Begin" 0,2 "End" 1,0 "*" +$t tag config unset -fg \#008811 +$t tag config title -fg red +$t tag row unset 1 +$t width 0 3 + +scrollbar .sy -command [list $t yview] +scrollbar .sx -command [list $t xview] -orient horizontal +grid .example - -sticky ew +grid $t .sy -sticky news +grid .sx -sticky ew +grid columnconfig . 0 -weight 1 +grid rowconfig . 1 -weight 1 + +bind $t <Return> { + set r [%W index active row] + set c [%W index active col] + if {$c == 2} { + %W activate [incr r],1 + } else { + %W activate $r,[incr c] + } + %W see active + break +} +bind $t <KP_Enter> [bind $t <Return>] |