1#!/bin/sh 2# the next line restarts using wish \ 3exec wish "$0" ${1+"$@"} 4 5## valid.tcl 6## 7## This demos shows the use of the validation mechanism of the table 8## and uses the table's cache (no -command or -variable) 9## 10## jeff at hobbs org 11 12source [file join [file dirname [info script]] loadtable.tcl] 13 14array set table { 15 rows 10 16 cols 10 17 table .table 18} 19 20proc colorize num { 21 if {$num>0 && $num%2} { return colored } 22} 23 24proc fill_headers {w {r 10} {c 10}} { 25 for {set i 1} {$i < $r} {incr i} { 26 $w set $i,0 "$i" 27 } 28 for {set j 1} {$j < $c} {incr j} { 29 if {$j%3==1} { 30 $w set 0,$j AlphaNum 31 } elseif {$j%2==1} { 32 $w set 0,$j Alpha 33 } elseif {$j} { 34 $w set 0,$j Real 35 } 36 } 37} 38 39proc validate {c val} { 40 if {$c%3==1} { 41 ## Alphanum 42 set expr {^[A-Za-z0-9 ]*$} 43 } elseif {$c%2==1} { 44 ## Alpha 45 set expr {^[A-Za-z ]*$} 46 } elseif {$c} { 47 ## Real 48 set expr {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?e[-+]?[0-9]*)?$} 49 } 50 if {[regexp $expr $val]} { 51 return 1 52 } else { 53 bell 54 return 0 55 } 56} 57 58label .example -text "TkTable v1 Validated Table Example" 59 60set t $table(table) 61table $t \ 62 -rows $table(rows) \ 63 -cols $table(cols) \ 64 -cache 1 \ 65 -titlerows 1 \ 66 -titlecols 1 \ 67 -yscrollcommand { .tsy set } \ 68 -xscrollcommand { .tsx set } \ 69 -width 5 -height 5 \ 70 -coltagcommand colorize \ 71 -flashmode on \ 72 -selectmode extended \ 73 -colstretch unset \ 74 -rowstretch unset \ 75 -validate yes \ 76 -vcmd {if {![%W tag includes title %C]} { validate %c %S } } 77 78fill_headers $t 79$t tag config colored -bg lightblue 80$t tag config title -fg red 81$t width 0 3 82 83scrollbar .tsy -command [list $t yview] 84scrollbar .tsx -command [list $t xview] -orient horizontal 85button .exit -text "Exit" -command {exit} 86 87grid .example - -sticky ew 88grid $t .tsy -sticky news 89grid .tsx -sticky ew 90grid .exit - -sticky ew 91grid columnconfig . 0 -weight 1 92grid rowconfig . 1 -weight 1 93 94puts [list Table is $table(table)] 95 96