blob: 9006953c7e6242674452acac9184a2fa20445535 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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>]
|
