Posted to tcl by Gerry at Tue Dec 04 01:25:43 GMT 2007view raw
- proc leftarrow thetable {
- if {$::incell} {
- $thetable icursor [expr {[$thetable icursor]-1}]
- return -code break
- }
- }
- proc rightarrow thetable {
- if {$::incell} {
- $thetable icursor [expr {[$thetable icursor]+1}]
- return -code break
- }
- }
- proc ttbrowsecmd thetable {
- set ::incell false
- .tktabtest.e configure -validate none
- .tktabtest.e delete 0 end
- .tktabtest.e insert 0 [$thetable get active]
- .tktabtest.e configure -validate key
- }
- proc ttvcmd {thetable newcontent index} {
- if {[string equal [string index $newcontent $index] \n]} {
- event generate $thetable <Key-Down>
- return false
- }
- set ::incell true
- .tktabtest.e configure -validate none
- .tktabtest.e delete 0 end
- .tktabtest.e insert 0 $newcontent
- .tktabtest.e configure -validate key
- return true
- }
- # First argument not used in example but needed in my app.
- proc tevcmd {theentry newcontent newchar} {
- if {[string equal $newchar \n]} {
- event generate .tktabtest.t <Key-Down>
- return false
- }
- .tktabtest.t set active $newcontent
- return true
- }
- # First argument not used in example but needed in my app.
- proc entryreturn theentry {
- focus .tktabtest.t
- event generate .tktabtest.t <Key-Down>
- }
- catch {destroy .tktabtest}
- set t [toplevel .tktabtest]
- pack [entry $t.e -width 30 -validate none -vcmd [list tevcmd %W %P %S]] \
- [table $t.t -variable tt -multiline false -browsecmd [list ttbrowsecmd %W ] \
- -validate true -vcmd [list ttvcmd %W %S %i]]
- array set tt [list 1,1 asdf 1,2 qwert 2,1 zxcv 2,2 1234567890123456789]
- # $t.t tag configure active -relief {}
- $t.t tag configure active -fg black
- bind $t.t <Button-1> {set ::incell true}
- bind $t.t <Key-Left> [list leftarrow %W]
- bind $t.t <Key-Right> [list rightarrow %W]
- bind $t.e <Return> [list entryreturn %W]