[FF] 2007-05-26 - This widget has various uses. Basically it's a grid/spreadsheet like widget.

''ChangeLog''

 2008-06-29:  Full scroll/visibility support
 2008-06-28:  Added more color keys, added partial scroll support
 older:       The big mess
----
Usage example:
 pack [tracker .t \
	     -rows 32 -cols 24 \
	     -colchars {8 1 1 1 2 4 1 4 1 2 3 2 1} \
	     -hl1 4 -hl2 16]
 
 # fill with ranom data
 set dgts {0 1 2 3 4 5 6 7 8 9 a b c d e f} ; set dgtsl [llength $dgts]

 for {set y 0} {$y < 32} {incr y} {
     for {set x 0} {$x < 24} {incr x} {
	 set d {}
	 for {set z 0} {$z < 8} {incr z} {
	     append d [lindex $dgts [expr {int(rand()*$dgtsl)}]]
	 }
	 .t setdata $y $x $d
     }
 }
 
 .t move 5 8
 .t setsel 2 2 5 5

[http://www.freemove.it/main/fileadmin/trackerwidget2.png]
----
 #!/usr/bin/env wish
 
 #######################################################################
 #
 # TrackerWidget
 # written by Federico Ferri - 2007
 #
 #######################################################################
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; version 2 of the License.
 #
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 #######################################################################
 
 package require Tk
 
 proc tracker {w args} {
     global tracker_struct
 
     # set default options
     set tracker_struct($w:-rows) 16
     set tracker_struct($w:-cols) 6
     set tracker_struct($w:-colchars) [list]
     set tracker_struct($w:-hspacing) 8
     set tracker_struct($w:-vspacing) 4
     set tracker_struct($w:-hl1) -1
     set tracker_struct($w:-hl2) -1
     set tracker_struct($w:-background) "#000000"
     set tracker_struct($w:-backgroundHl1) "#222222"
     set tracker_struct($w:-backgroundHl2) "#444444"
     set tracker_struct($w:-foreground) "#0011fc"
     set tracker_struct($w:-foregroundHl1) "#0065db"
     set tracker_struct($w:-foregroundHl2) "#0092e9"
     set tracker_struct($w:-backgroundsel) "#18e02b"
     set tracker_struct($w:-backgroundselHl1) "#79e383"
     set tracker_struct($w:-backgroundselHl2) "#aaedb0"
     set tracker_struct($w:-foregroundsel) "#000000"
     set tracker_struct($w:-foregroundselHl1) "#404980"
     set tracker_struct($w:-foregroundselHl2) "#354cd9"
     set tracker_struct($w:-backgroundcur) "#ff0505"
     set tracker_struct($w:-backgroundcurHl1) "#e75b5b"
     set tracker_struct($w:-backgroundcurHl2) "#e88b8b"
     set tracker_struct($w:-foregroundcur) "white"
     set tracker_struct($w:-foregroundcurHl1) "black"
     set tracker_struct($w:-foregroundcurHl2) "black"
     set tracker_struct($w:-xscrollcommand) ""
     set tracker_struct($w:-yscrollcommand) ""
 
     # parse options
     set valid_opts {
            -rows -cols -colchars -hl1 -hl2
            -hspacing -vspacing
            -xscrollcommand -yscrollcommand
            -background -backgroundHl1 -backgroundHl2
            -foreground -foregroundHl1 -foregroundHl2
            -backgroundsel -backgroundselHl1 -backgroundselHl2
            -foregroundsel -foregroundselHl1 -foregroundselHl2
            -backgroundcur -backgroundcurHl1 -backgroundcurHl2
            -foregroundcur -foregroundcurHl1 -foregroundcurHl2
     }
     foreach {opt val} $args {
         if {[lsearch -exact $valid_opts $opt] == -1} {
             return -code error -errorinfo \
                 "tracker($w): unknown option: $opt"
         } else {
             set tracker_struct($w:$opt) $val
         }
     }
     # col chars other than 1?
     if {[llength $tracker_struct($w:-colchars)] == 0} {
         lappend tracker_struct($w:-colchars) 1
     }
     set cclen [llength $tracker_struct($w:-colchars)]
     for {set i $cclen} {$i < $tracker_struct($w:-cols)} {incr i} {
         lappend tracker_struct($w:-colchars) \
          [lindex $tracker_struct($w:-colchars) [expr {$i%$cclen}]]
     }
     set tracker_struct($w:font) \
      [font create -family Courier -size 10 \
      -weight bold -slant roman -underline false -overstrike false]
     set tracker_struct($w:font:-ascent) [font metrics $tracker_struct($w:font) -ascent]
     set tracker_struct($w:font:-descent) [font metrics $tracker_struct($w:font) -descent]
     set tracker_struct($w:font:-linespace) [font metrics $tracker_struct($w:font) -linespace]
     set tracker_struct($w:font:-width) [font measure $tracker_struct($w:font) m]
     set tracker_struct($w:-charwidth) $tracker_struct($w:font:-width)
     set tracker_struct($w:-charheight) $tracker_struct($w:font:-linespace)
     set lh [expr {$tracker_struct($w:-vspacing)+$tracker_struct($w:-charheight)}]
     set cw [expr {$tracker_struct($w:-hspacing)+$tracker_struct($w:-charwidth)}]
     set tracker_struct($w:-width) [expr {$tracker_struct($w:-cols)*$cw}]
     set tracker_struct($w:-height) [expr {$tracker_struct($w:-rows)*$lh}]
     set tracker_struct($w:regionw) [expr {[tracker_col_to_x $w $tracker_struct($w:-cols)]-0}]
     set tracker_struct($w:regionh) [expr {[tracker_row_to_y $w $tracker_struct($w:-rows)]-0}]
     set tracker_struct($w:lineheight) $lh
     set sr [list 0 0 $tracker_struct($w:regionw) $tracker_struct($w:regionh)]
     set c [canvas $w \
         -background $tracker_struct($w:-background)\
         -xscrollcommand $tracker_struct($w:-xscrollcommand) \
         -yscrollcommand $tracker_struct($w:-yscrollcommand) \
         -xscrollincrement $cw -yscrollincrement $lh \
         -scrollregion $sr -takefocus  1]
         #-width      [expr {[tracker_col_to_x $w $tracker_struct($w:-cols)]-1}]\
         -height     [expr {[tracker_row_to_y $w $tracker_struct($w:-rows)]-1}]\
 
     rename $c ${w}_canvas
     set tracker_struct($w:canvas) ${w}_canvas
     set tracker_struct($w:window) $w
 
     set tracker_struct($w:cursor:x) 0
     set tracker_struct($w:cursor:y) 0
 
     set tracker_struct($w:sel:start:x) 0
     set tracker_struct($w:sel:start:y) 0
     set tracker_struct($w:sel:stop:x) 0
     set tracker_struct($w:sel:stop:y) 0
 
     set tracker_struct($w:internal:subcol) 0
 
     # setup callback proc
     proc $w args "return \[eval tracker_callback $w \$args\]"
 
     if [tracker_init $w] {
         return $c
     } else {
         return -code error -errorinfo \
             "tracker($w): init failed"
     }
 }
 
 proc tracker_callback {w command {args {}}} {
     # dispatch command, if it exists
     global tracker_struct
     if {[llength [info procs tracker_$command]] > 0} {
         return [eval tracker_$command $w $args]
     } else {
         return -code error -errorinfo \
             "tracker($w): no such command: $command"
     }
 }
 
 proc tracker_xview {w args} {
     global tracker_struct
     eval "$tracker_struct($w:canvas) xview $args"
 }
 
 proc tracker_yview {w args} {
     global tracker_struct
     eval "$tracker_struct($w:canvas) yview $args"
 }
 
 proc tracker_get_row_color {w colorkey nrow} {
     global tracker_struct
     set colors {background foreground backgroundsel foregroundsel backgroundcur foregroundcur}
     if {[lsearch -exact $colors $colorkey] == -1} {
         return -code error -errorinfo "tracker($w): wrong color-key: $colorkey"
     }
     set suffix {}
     if {[expr {$nrow%$tracker_struct($w:-hl1)}]==0 && $tracker_struct($w:-hl1)>1} {set suffix Hl1}
     if {[expr {$nrow%$tracker_struct($w:-hl2)}]==0 && $tracker_struct($w:-hl2)>1} {set suffix Hl2}
     set colorkey2 $colorkey$suffix
     if {$tracker_struct($w:-$colorkey2) == {}} {
         return $tracker_struct($w:-$colorkey)
     } else {
         return $tracker_struct($w:-$colorkey2)
     }
 }
 
 proc tracker_xy {x y {prefix xy}} {
     # make an xy tag index
     return "${prefix}_${x}_${y}"
 }
 
 proc tracker_init {w} {
     # initialize tracker, canvas items
     global tracker_struct
     set rh $tracker_struct($w:-charheight)
     set rx 1
     for {set x 0} {$x < $tracker_struct($w:-cols)} {incr x} {
         set rw [expr {$tracker_struct($w:-charwidth)*[lindex $tracker_struct($w:-colchars) $x]}]
         set ry 0
         for {set y 0} {$y < $tracker_struct($w:-rows)} {incr y} {
             $tracker_struct($w:canvas) create rectangle \
                 $rx $ry [expr {$rx+$rw+$tracker_struct($w:-hspacing)}] [expr {$ry+$rh}] \
                 -fill [tracker_get_row_color $w background $y] \
                 -outline {} \
                 -tags [list bg bg_row_$y [tracker_xy $x $y]]
             tracker_bindcell $w $y $x [tracker_xy $x $y]
             incr ry [expr {$rh+$tracker_struct($w:-vspacing)}]
         }
         incr rx [expr {$rw+$tracker_struct($w:-hspacing)}]
     }
     bind $tracker_struct($w:window) <KeyPress> "tracker_keypress $w %K %s"
     bind $tracker_struct($w:window) <ButtonPress-1> "focus $w"
     tracker_setsel $w -1 -1 -1 -1
     tracker_move $w 0 0
     return 1
 }
 
 proc tracker_move {w dx dy} {
     # move cursor by relative amount dx dy, wrap if needed
     global tracker_struct
     $tracker_struct($w:canvas) itemconfigure bg -fill {}
     set old_x $tracker_struct($w:cursor:x)
     set old_y $tracker_struct($w:cursor:y)
     incr tracker_struct($w:cursor:x) $dx
     incr tracker_struct($w:cursor:y) $dy
     if {$tracker_struct($w:cursor:x) < 0} {
         incr tracker_struct($w:cursor:x) $tracker_struct($w:-cols)
     }
     if {$tracker_struct($w:cursor:y) < 0} {
         incr tracker_struct($w:cursor:y) $tracker_struct($w:-rows)
     }
     set tracker_struct($w:cursor:x) \
      [expr {$tracker_struct($w:cursor:x)%$tracker_struct($w:-cols)}]
     set tracker_struct($w:cursor:y) \
      [expr {$tracker_struct($w:cursor:y)%$tracker_struct($w:-rows)}]
     set tracker_struct($w:internal:subcol) 0
 
     # do the scrolling if cell is not visible:
     while {[tracker_cursor_scroll_proc $w] > 0} {}
     tracker_deselect $w
 }
 
 proc tracker_cursor_scroll_proc {w} {
     global tracker_struct
     set fx1 [tracker_col_to_x $w $tracker_struct($w:cursor:x)]
     set fx2 [tracker_col_to_x $w [expr {$tracker_struct($w:cursor:x)+1}]]
     foreach {rx1 rx2} [$tracker_struct($w:canvas) xview] {break}
     set rx1 [expr {$rx1*$tracker_struct($w:regionw)}]
     set rx2 [expr {$rx2*$tracker_struct($w:regionw)}]
     set fy1 [tracker_row_to_y $w $tracker_struct($w:cursor:y)]
     set fy2 [tracker_row_to_y $w [expr {$tracker_struct($w:cursor:y)+1}]]
     foreach {ry1 ry2} [$tracker_struct($w:canvas) yview] {break}
     set ry1 [expr {$ry1*$tracker_struct($w:regionh)}]
     set ry2 [expr {$ry2*$tracker_struct($w:regionh)}]
     if {$rx1 != $rx2} {
         if {$fx1 < $rx1 || $fx2 < $rx1} {
             $tracker_struct($w:canvas) xview scroll -1 units
             return 1
         }
         if {$fx1 > $rx2 || $fx2 > $rx2} {
             $tracker_struct($w:canvas) xview scroll 1 units
             return 1
         }
     }
     if {$ry1 != $ry2} {
         if {$fy1 < $ry1 || $fy2 < $ry1} {
             $tracker_struct($w:canvas) yview scroll -1 units
             return 1
         }
         if {$fy1 > $ry2 || $fy2 > $ry2} {
             $tracker_struct($w:canvas) yview scroll 1 units
             return 1
         }
     }
     return 0
 }
 
 proc tracker_update_cell_color {w x y} {
     puts [info level 0]
     global tracker_struct
     if {$x == $tracker_struct($w:cursor:x) && $y == $tracker_struct($w:cursor:x)} {
         set fgcolkey foregroundcur
         set bgcolkey backgroundcur
     } elseif {$x >= $tracker_struct($w:sel:start:x) && $x <= $tracker_struct($w:sel:stop:x) &&
         $y >= $tracker_struct($w:sel:start:y) && $y <= $tracker_struct($w:sel:stop:y) &&
         $tracker_struct($w:sel:start:x) != $tracker_struct($w:sel:stop:x) &&
         $tracker_struct($w:sel:start:y) != $tracker_struct($w:sel:stop:y)} {
         set fgcolkey foregroundsel
         set bgcolkey backgroundsel
     } else {
         set fgcolkey foreground
         set bgcolkey background
     }
     $tracker_struct($w:canvas) itemconfigure [tracker_xy $x $y] -fill [tracker_get_row_color $w $bgcolkey $y]
     $tracker_struct($w:canvas) itemconfigure [tracker_xy $x $y xytxt] -fill [tracker_get_row_color $w $fgcolkey $y]
 }
 
 proc tracker_resetcolors {w} {
     global tracker_struct
     $tracker_struct($w:canvas) itemconfigure bg -fill {}
     $tracker_struct($w:canvas) itemconfigure txt -fill {}
     for {set y 0} {$y < $tracker_struct($w:-rows)} {incr y} {
         $tracker_struct($w:canvas) itemconfigure bg_row_$y -fill [tracker_get_row_color $w background $y]
         $tracker_struct($w:canvas) itemconfigure txt_row_$y -fill [tracker_get_row_color $w foreground $y]
     }
     tracker_updatecursor $w
 }
 
 proc tracker_setdata {w row col d} {
     # change data at specified position
     global tracker_struct
     set coords [$tracker_struct($w:canvas) coords [tracker_xy $col $row]]
     set tag [tracker_xy $col $row xytxt]
     $tracker_struct($w:canvas) delete $tag
     set x [expr {[lindex $coords 0]+1}]
     set y [expr {[lindex $coords 1]+1}]
     set tracker_struct($w:data:$col,$row) \
      [string range $d 0 [expr {[lindex $tracker_struct($w:-colchars) $col]-1}]]
     if {$row == $tracker_struct($w:cursor:y) && $col == $tracker_struct($w:cursor:x)} {
         set fill [tracker_get_row_color $w foregroundcur $row]
     } else {
         set fill [tracker_get_row_color $w foreground $row]
     }
     $tracker_struct($w:canvas) create text $x $y -tags [list $tag txt txt_row_$row] \
      -text $tracker_struct($w:data:$col,$row) -font $tracker_struct($w:font) \
      -fill $fill -anchor nw
     tracker_bindcell $w $row $col $tag
 }
 
 proc tracker_getdata {w row col {d {}}} {
     # get data at specified position
     global tracker_struct
     set r $d
     catch {set r $tracker_struct($w:data:$col,$row)}
     return $r
 }
 
 proc tracker_copy {w} {
     # perform a copy of selected area
     global tracker_struct
     for {set ty $tracker_struct($w:sel:start:y); set by 0} \
      {$ty <= $tracker_struct($w:sel:stop:y)} {incr ty; incr by} {
         for {set tx $tracker_struct($w:sel:start:x); set bx 0} \
          {$tx <= $tracker_struct($w:sel:stop:x)} {incr tx; incr bx} {
             catch {
                 set tracker_struct($w:copybuf:$bx,$by) \
                  $tracker_struct($w:data:$tx,$ty)
             }
         }
     }
     set tracker_struct($w:copybuf:w) $bx
     set tracker_struct($w:copybuf:h) $by
 }
 
 proc tracker_delete {w} {
     # delete selected area
     global tracker_struct
     for {set ty $tracker_struct($w:sel:start:y)} \
      {$ty <= $tracker_struct($w:sel:stop:y)} {incr ty} {
         for {set tx $tracker_struct($w:sel:start:x)} \
          {$tx <= $tracker_struct($w:sel:stop:x)} {incr tx} {
             $tracker_struct($w:canvas) delete [tracker_xy $tx $ty xytxt]
             unset tracker_struct($w:data:$tx,$ty)
         }
     }
 }
 
 proc tracker_cut {w} {
     # perform a cut (that is: copy & delete)
     tracker_copy $w
     tracker_delete $w
 }
 
 proc tracker_paste {w} {
     # paste data from copybuf to current position
     global tracker_struct
     set py $tracker_struct($w:cursor:y)
     for {set by 0} {$by < $tracker_struct($w:copybuf:h)} {incr by; incr py} {
         set px $tracker_struct($w:cursor:x)
         for {set bx 0} {$bx < $tracker_struct($w:copybuf:w)} {incr bx; incr px} {
             catch {
                 tracker_setdata $w $py $px $tracker_struct($w:copybuf:$bx,$by)
             }
         }
     }
     tracker_move $w 0 0
 }
 
 proc tracker_bindcell {w row col tag} {
     # re-bind events to specific cell
     global tracker_struct
     $tracker_struct($w:canvas) bind $tag <ButtonPress-1> "tracker_moveabs $w $col $row"
     $tracker_struct($w:canvas) bind $tag <B1-Motion> "tracker_extendsel $w %x %y"
 }
 
 proc tracker_keypress {w ks st} {
     # handle global (canvas) keypress (from event)
     global tracker_struct
     switch $ks {
         Left {tracker_move $w -1 0; return}
         Right {tracker_move $w 1 0; return}
         Up {tracker_move $w 0 -1; return}
         Down {tracker_move $w 0 1; return}
     }
     if {[expr {$st&0x4}] > 0} {
         switch $ks {
             c {tracker_copy $w; return}
             x {tracker_cut $w; return}
             v {tracker_paste $w; return}
         }
     }
     if {[regexp -nocase -- {^[0123456789abcdef]$} $ks]} {
         set ret [tracker_inputdata $w \
          $tracker_struct($w:cursor:x) $tracker_struct($w:cursor:y) $ks $st]
         return $ret
     }
 }
 
 proc tracker_inputdata {w col row keysym state} {
     # keypresses relate to data input are sent here (from tracker_keypress)
     # here is handled multi-digit cell input
     # you can override with your own input method
     global tracker_struct
     set colch  [lindex $tracker_struct($w:-colchars) $col]
     set subcol $tracker_struct($w:internal:subcol)
     set default [string repeat 0 $colch]
     set nd [lreplace [lrange \
      [split [tracker_getdata $w $row $col $default] {}] \
      0 [expr {$colch-1}]\
      ] $subcol $subcol $keysym]
     set nd [join $nd {}]
     tracker_setdata $w $row $col $nd
     incr tracker_struct($w:internal:subcol)
     if {$tracker_struct($w:internal:subcol) >= $colch} {
         tracker_move $w 0 1
     }
 }
 
 proc tracker_moveabs {w mx my} {
     # move cursor to absolute position
     global tracker_struct
     set old_x $tracker_struct($w:cursor:x)
     set old_y $tracker_struct($w:cursor:y)
     set tracker_struct($w:cursor:x) $mx
     set tracker_struct($w:cursor:y) $my
     tracker_move $w 0 0
     set tracker_struct($w:sel:start:x) $mx
     set tracker_struct($w:sel:start:y) $my
     set tracker_struct($w:sel:stop:x) $mx
     set tracker_struct($w:sel:stop:y) $my
     tracker_deselect $w
 }
 
 proc tracker_col_from_x {w x} {
     global tracker_struct
     set curcol 0
     set xlim 0
     while {$curcol < $tracker_struct($w:-cols)} {
         set colchars [lindex $tracker_struct($w:-colchars) $curcol]
         set colwidth [expr {$colchars*$tracker_struct($w:-charwidth)+$tracker_struct($w:-hspacing)}]
         incr xlim $colwidth
         if {$x <= $xlim} {return $curcol}
         incr curcol
     }
     return -1
 }
 
 proc tracker_row_from_y {w y} {
     global tracker_struct
     set currow 0
     set ylim 0
     set lineheight [expr {$tracker_struct($w:-charheight)+$tracker_struct($w:-vspacing)}]
     while {$currow < $tracker_struct($w:-rows)} {
         incr ylim $lineheight
         if {$y <= $ylim} {return $currow}
         incr currow
     }
     return -1
 }
 
 proc tracker_col_to_x {w col} {
     global tracker_struct
     set x 0
     set li 0
     while {$col > 0} {
         incr x [expr {($tracker_struct($w:-charwidth)*\
          [lindex $tracker_struct($w:-colchars) $li])+\
          $tracker_struct($w:-hspacing)}]
         incr li
         if {$li >= [llength $tracker_struct($w:-colchars)]} {
             return $x
         }
         incr col -1
     }
     return $x
 }
 
 proc tracker_row_to_y {w row} {
     global tracker_struct
     return [expr {$row*($tracker_struct($w:-charheight)+$tracker_struct($w:-vspacing))}]
 }
 
 proc tracker_extendsel {w _x _y} {
     # extend selection to specified position (from event)
     global tracker_struct
     tracker_clip_x_y $w _x _y
     set mx [tracker_col_from_x $w $_x]
     set my [tracker_row_from_y $w $_y]
     if {$mx < $tracker_struct($w:sel:start:x)} {set mx $tracker_struct($w:sel:start:x)}
     if {$my < $tracker_struct($w:sel:start:y)} {set my $tracker_struct($w:sel:start:y)}
     set tracker_struct($w:sel:stop:x) $mx
     set tracker_struct($w:sel:stop:y) $my
     tracker_updatesel $w
 }
 
 proc tracker_setsel {w startrow startcol stoprow stopcol} {
     global tracker_struct
     set tracker_struct($w:sel:start:y) $startrow
     set tracker_struct($w:sel:start:x) $startcol
     set tracker_struct($w:sel:stop:y) $stoprow
     set tracker_struct($w:sel:stop:x) $stopcol
     tracker_updatesel $w
 }
 
 proc tracker_updatesel {w} {
     global tracker_struct
     $tracker_struct($w:canvas) dtag sel
     tracker_resetcolors $w
     for {set ty $tracker_struct($w:sel:start:y)} {$ty <= $tracker_struct($w:sel:stop:y)} {incr ty} {
         set bgcol [tracker_get_row_color $w backgroundsel $ty]
         set fgcol [tracker_get_row_color $w foregroundsel $ty]
         for {set tx $tracker_struct($w:sel:start:x)} {$tx <= $tracker_struct($w:sel:stop:x)} {incr tx} {
             $tracker_struct($w:canvas) addtag sel withtag [tracker_xy $tx $ty]
             $tracker_struct($w:canvas) itemconfigure [tracker_xy $tx $ty] -fill $bgcol
             $tracker_struct($w:canvas) itemconfigure [tracker_xy $tx $ty xytxt] -fill $fgcol
         }
     }
     tracker_updatecursor $w
 }
 
 proc tracker_updatecursor {w} {
     global tracker_struct
     $tracker_struct($w:canvas) itemconfigure \
      [tracker_xy $tracker_struct($w:cursor:x) $tracker_struct($w:cursor:y)] \
      -fill [tracker_get_row_color $w backgroundcur $tracker_struct($w:cursor:y)]
     $tracker_struct($w:canvas) itemconfigure \
      [tracker_xy $tracker_struct($w:cursor:x) $tracker_struct($w:cursor:y) xytxt] \
      -fill [tracker_get_row_color $w foregroundcur $tracker_struct($w:cursor:y)]
 }
 
 proc tracker_deselect {w} {
     # clears current selection
     global tracker_struct
     set tracker_struct($w:sel:stop:x) $tracker_struct($w:sel:start:x)
     set tracker_struct($w:sel:stop:y) $tracker_struct($w:sel:start:y)
     tracker_resetcolors $w
     return 1
 }
 
 proc tracker_focus {w} {
     # take focus (by a click, from event)
     focus $w
 }
 
 proc tracker_clip_x_y {w varw varh} {
     global tracker_struct
     set width [tracker_col_to_x $w $tracker_struct($w:-cols)]
     set height [tracker_row_to_y $w $tracker_struct($w:-rows)]
     upvar $varw _varw
     upvar $varh _varh
     if {$_varw < 0} {set _varw 0}
     if {$_varw >= $width} {set _varw [expr {$width-1}]}
     if {$_varh < 0} {set _varh 0}
     if {$_varh >= $height} {set _varh [expr {$height-1}]}
 }
----
[[ [Category Widget] ]]