/usr/share/doc/tk-table/examples/buttons.tcl is in tk-table 2.10-3.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 | #!/bin/sh
# next line is a comment in tcl \
exec wish "$0" ${1+"$@"}
## buttons.tcl
##
## demonstrates the simulation of a button array
##
## ellson@lucent.com
## modifications made by jeff at hobbs org
source [file join [file dirname [info script]] loadtable.tcl]
array set table {
rows 20
cols 20
table .table
}
# create the table
set t $table(table)
table $t -rows [expr {$table(rows)+1}] -cols [expr {$table(cols)+1}] \
-titlerows 1 -titlecols 1 \
-roworigin -1 -colorigin -1 \
-colwidth 4 \
-width 8 -height 8 \
-variable tab \
-flashmode off \
-cursor top_left_arrow \
-borderwidth 2 \
-state disabled \
-xscrollcommand ".sx set" -yscrollcommand ".sy set"
scrollbar .sx -orient h -command "$t xview"
scrollbar .sy -orient v -command "$t yview"
grid $t .sy -sticky nsew
grid .sx -sticky ew
grid columnconfig . 0 -weight 1
grid rowconfig . 0 -weight 1
# set up tags for the various states of the buttons
$t tag configure OFF -bg red -relief raised
$t tag configure ON -bg green -relief sunken
$t tag configure sel -bg gray75 -relief flat
# clean up if mouse leaves the widget
bind $t <Leave> {
%W selection clear all
}
# highlight the cell under the mouse
bind $t <Motion> {
if {[%W selection includes @%x,%y]} break
%W selection clear all
%W selection set @%x,%y
break
## "break" prevents the call to tkTableCheckBorder
}
# mousebutton 1 toggles the value of the cell
# use of "selection includes" would work here
bind $t <1> {
set rc [%W cursel]
if {[string match ON $tab($rc)]} {
set tab($rc) OFF
%W tag celltag OFF $rc
} {
set tab($rc) ON
%W tag celltag ON $rc
}
}
# inititialize the array, titles, and celltags
for {set i 0} {$i < $table(rows)} {incr i} {
set tab($i,-1) $i
for {set j 0} {$j < $table(cols)} {incr j} {
if {! $i} {set tab(-1,$j) $j}
set tab($i,$j) "OFF"
$t tag celltag OFF $i,$j
}
}
|