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