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

[WJP] 2008-06-29 - A little bit more of an explanation of what this is for and how to use it
would be very helpful. [FF] Spreadsheed/data-grid. Basically viewing and editing a grid of data (not necessarily numbers... try '''[[.t columnconfigure 0 -type note]]''' for example ;p [HexEdit - an hexadecimal editor] is another example, although incomplete, and doesn't feature almost any cool feature of [TrackerWidget]... more to come...)

'''ChangeLog'''

2008-07-17 - [FF] - standardized methods arguments, added selectionmethod, notify calbacks for cursor movement, selection, data change, added selection iterator, added readonly state; introduced public/private methods in its little OO system.

2008-07-01 - [FF] - added configure command, columnconfigure command, improved keyboard support - this is coming up really nice, although it needs a bit more optimization :] -- and: minor fixes, support for very long numbers

2008-06-30 - [FF] - after counting how many tracker_* and tracker_struct was repeated in the source, I created a tiny object system :)) you can see the benefit loking at the diff; thanks to [DGP] for helping me in removing all those ugly eval's

2008-06-29 - [FF] - Full scroll/visibility support

2008-06-28 - [FF] - Added more color keys, added partial scroll support

older - [FF] - The big mess

----
Usage example:
 pack [tracker::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]

----
[AMG]: This example doesn't work, since the `-colchars` option doesn't exist.

It's interesting that you made your own object system, but have you considered rewriting this in terms of [[[namespace ensemble]]], [TclOO], or (heh) [[[sproc]]]?  It could also be turned into a [snidget].

----
 #!/usr/bin/env wish
 
 #######################################################################
 #
 # TrackerWidget
 # written by Federico Ferri - 2007-2008
 #
 #######################################################################
 #
 # 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
 
 package provide tracker 1.0
 
 namespace eval tracker {
         variable valid_options {
                 -rows -cols -hl1 -hl2
                 -width -height -hspacing -vspacing
                 -xscrollcommand -yscrollcommand
                 -background -backgroundHl1 -backgroundHl2
                 -foreground -foregroundHl1 -foregroundHl2
                 -backgroundsel -backgroundselHl1 -backgroundselHl2
                 -foregroundsel -foregroundselHl1 -foregroundselHl2
                 -backgroundcur -backgroundcurHl1 -backgroundcurHl2
                 -foregroundcur -foregroundcurHl1 -foregroundcurHl2
                 -selectionmethod
                 -selectionnotify -setdatanotify -cursornotify
                 -state
         }
         variable public_method_prefix @
         variable private_method_prefix #
 
         proc static {method name arglist body} {
                 # just eye candy wrapper for proc => static method
                 if {$method != {method}} {
                         return -code error "must be: static method <name> <arglist> <body>"
                 }
                 uplevel 1 [list proc ${name} $arglist $body]
         }
 
         proc constructor {arglist body} {
                 uplevel 1 [list method public tracker $arglist $body]
         }
 
         proc method {qualifier name arglist body} {
                 set valid_qualifiers {public private}
                 if {[lsearch -exact $valid_qualifiers $qualifier] < 0} {
                         return -code error "qualifier must be one of: $valid_qualifiers"
                 }
                 variable ${qualifier}_method_prefix
                 variable _
                 set m_prefix [set ${qualifier}_method_prefix]
                 # preprocess method body:
                 set pbody [regsub -all {self\(} $body _(\$w:]
                 if {"::$name" != [namespace current]} {set name "${m_prefix}${name}"}
                 uplevel 1 [list proc $name [linsert $arglist 0 w] "variable _; $pbody"]
         }
 
         proc public {method name arglist body} {
                 uplevel 1 [list method public $name $arglist $body]
         }
 
         proc private {method name arglist body} {
                 uplevel 1 [list method private $name $arglist $body]
         }
 
         proc method_call_unknown {method_name args} {
                 if [catch {set m [method_spec $method_name]}] {
                         uplevel 1 [list ::unknown $method_name $args]
                 }
                 upvar 1 w w
                 uplevel 1 [linsert $args 0 $m $w]
         }
 
         proc method_spec {method_name {private 1}} {
                 variable public_method_prefix
                 variable private_method_prefix
                 set ns [namespace current]
                 if [llength [info procs ${ns}::${public_method_prefix}${method_name}]] {
                         return ${ns}::${public_method_prefix}${method_name}
                 } elseif {$private && [llength [info procs ${ns}::${private_method_prefix}${method_name}]]} {
                         return ${ns}::${private_method_prefix}${method_name}
                 } else {
                         return -code error "no such method: $method_name"
                 }
         }
 
         proc method_call_spec {method_name {args_l {}}} {
                 # always call public methods only
                 return [linsert $args_l 0 [method_spec $method_name 0] [uplevel 1 {set w}]]
         }
 
         namespace unknown {method_call_unknown}
         namespace export -clear tracker
 
         constructor {args} {
                 # set default options
                 set self(-rows) 16
                 set self(-cols) 6
                 set self(-width) 0
                 set self(-height) 0
                 set self(-hspacing) 8
                 set self(-vspacing) 4
                 set self(-hl1) -1
                 set self(-hl2) -1
                 set self(-background) "#000000"
                 set self(-backgroundHl1) "#222222"
                 set self(-backgroundHl2) "#444444"
                 set self(-foreground) "#0011fc"
                 set self(-foregroundHl1) "#0065db"
                 set self(-foregroundHl2) "#0092e9"
                 set self(-backgroundsel) "#18e02b"
                 set self(-backgroundselHl1) "#79e383"
                 set self(-backgroundselHl2) "#aaedb0"
                 set self(-foregroundsel) "#000000"
                 set self(-foregroundselHl1) "#404980"
                 set self(-foregroundselHl2) "#354cd9"
                 set self(-backgroundcur) "#ff0505"
                 set self(-backgroundcurHl1) "#e75b5b"
                 set self(-backgroundcurHl2) "#e88b8b"
                 set self(-foregroundcur) "white"
                 set self(-foregroundcurHl1) "black"
                 set self(-foregroundcurHl2) "black"
                 set self(-xscrollcommand) ""
                 set self(-yscrollcommand) ""
                 set self(-selectionmethod) "rect"
                 set self(-state) "normal"
 
                 set self(-col:default:-type) "number"
                 set self(-col:default:-inputmethod) "number"
                 set self(-col:default:-displaymethod) "number"
                 set self(-col:default:-width) 3
 
                 # parse options
                 variable valid_options
                 foreach {opt val} $args {
                         if {[lsearch -exact $valid_options $opt] == -1} {
                                 return -code error -errorinfo \
                                         "tracker($w): unknown option: $opt"
                         } else {
                                 set self($opt) $val
                         }
                 }
 
                 foreach k {-selectionnotify -setdatanotify -cursornotify} {
                         catch [concat configure $k {$self($k); unset self($k)}]
                 }
                 
                 # font stuff:
                 set self(font) \
                  [font create -family Courier -size 10 \
                  -weight bold -slant roman -underline false -overstrike false]
                 set self(font:-ascent) [font metrics $self(font) -ascent]
                 set self(font:-descent) [font metrics $self(font) -descent]
                 set self(font:-linespace) [font metrics $self(font) -linespace]
                 set self(font:-width) [font measure $self(font) m]
                 set self(-charwidth) $self(font:-width)
                 set self(-charheight) $self(font:-linespace)
                 
                 set c [uplevel #1 [list canvas $w \
                         -background $self(-background) \
                         -xscrollcommand $self(-xscrollcommand) \
                         -yscrollcommand $self(-yscrollcommand) \
                         -width $self(-width) -height $self(-height) \
                         -takefocus 1]]
 
                 rename $c ${w}_canvas
                 set self(canvas) ${w}_canvas
                 set self(window) $w
 
                 set self(cursor:col) 0
                 set self(cursor:row) 0
                 set self(internal:subcol) 0
                 set self(sel:start:col) 0
                 set self(sel:start:row) 0
                 set self(sel:stop:col) 0
                 set self(sel:stop:row) 0
                 set self(copybuf:w) 0
                 set self(copybuf:h) 0
                 
                 # setup callback proc
                 uplevel 1 [list proc $w args \
                         "if {\[llength \$args\] < 1} {
                                 return -code error \"wrong # args: should be \\\"$w option ?arg arg ...?\\\"\"
                         }
                         return \[uplevel 1 \[linsert \$args 0 [method_spec callback] $w\]\]"]
 
                 # this also calls initialization (@init)
                 configure -rows $self(-rows) -cols $self(-cols)
         }
 
         public method callback {command {args {}}} {
                 # dispatch command, if it exists
                 return [uplevel 1 [method_call_spec $command $args]]
         }
 
         public method xview {args} {
                 return [uplevel #1 [linsert $args 0 $self(canvas) xview]]
         }
 
         public method yview {args} {
                 return [uplevel #1 [linsert $args 0 $self(canvas) yview]]
         }
 
         private method get_row_color {colorkey nrow} {
                 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 {$self(-hl1)>1 && [expr {$nrow%$self(-hl1)}]==0} {set suffix Hl1}
                 if {$self(-hl2)>1 && [expr {$nrow%$self(-hl2)}]==0} {set suffix Hl2}
                 set colorkey2 $colorkey$suffix
                 if {$self(-$colorkey2) == {}} {
                         return $self(-$colorkey)
                 } else {
                         return $self(-$colorkey2)
                 }
         }
 
         static method item_rc_tag {row col {prefix xy}} {
                 # make an xy tag index
                 return "${prefix}_${row}_${col}"
         }
 
         private method init {} {
                 # initialize tracker, canvas items
                 $self(canvas) delete bg txt playhead
                 for {set x 0} {$x < $self(-cols)} {incr x} {
                         set xpp [expr {$x+1}]
                         for {set y 0} {$y < $self(-rows)} {incr y} {
                                 set ypp [expr {$y+1}]
                                 set tagid_bg [item_rc_tag $y $x]
                                 set tagid_txt [item_rc_tag $y $x xytxt]
                                 set rx [col_to_x $x]
                                 set ry [row_to_y $y]
                                 $self(canvas) create rectangle \
                                         $rx $ry [col_to_x $xpp] [row_to_y $ypp] \
                                         -fill [get_row_color background $y] -outline {} \
                                         -tags [list bg bg_row_$y $tagid_bg]
                                 $self(canvas) create text \
                                         [expr {$rx+1}] [expr {$ry+1}] \
                                         -fill {} -text {} -font $self(font) -anchor nw \
                                         -tags [list txt txt_row_$y $tagid_txt]
                                 bindcell $y $x $tagid_bg
                                 bindcell $y $x $tagid_txt
                                 updatecelltext $y $x
                                 updatecellcolor $y $x
                         }
                 }
                 $self(canvas) create rectangle -1 -1 -1 -1 -fill yellow -outline {} -tags playhead
                 $self(canvas) raise playhead
                 $self(canvas) raise txt
                 
                 set self(regionw) [col_to_x $self(-cols)]
                 set self(regionh) [row_to_y $self(-rows)]
                 set lh [expr {$self(-vspacing)+$self(-charheight)}]
                 set cw [expr {$self(-hspacing)+$self(-charwidth)}]
                 $self(canvas) configure \
                         -xscrollincrement $cw -yscrollincrement $lh \
                         -scrollregion [list 0 0 $self(regionw) $self(regionh)]
                 
                 set self(-width) [expr {$self(-cols)*$cw}]
                 set self(-height) [expr {$self(-rows)*$lh}]
                 
                 bind $self(window) <KeyPress> "[method_call_spec keypress] %K %s"
                 bind $self(window) <ButtonPress-1> "focus %W"
                 bind $self(window) <MouseWheel> "%W yview scroll \[expr {-(%D)}\] units"
                 bind $self(window) <Button-4> "%W yview scroll -1 units"
                 bind $self(window) <Button-5> "%W yview scroll 1 units"
                 setsel -1 -1 -1 -1
                 moveby 0 0
         }
 
         public method cget {key} {
                 variable valid_options
                 if {[lsearch -exact $valid_options $key] >= 0} {
                         return $self($key)
                 } else {
                         switch -- $key {
                                 -takefocus {return 1}
                                 -state {return {normal}}
                         }
                 }
                 return -code error "unknown option \"$key\""
         }
 
         public method configure {args} {
                 variable valid_options
                 set re_init 0
                 set update_colors 0
                 foreach {key value} $args {
                         switch -- $key {
                                 -background - -foreground - -backgroundHl1 - -backgroundHl2 - -foregroundHl1 -
                                 -foregroundHl2 - -backgroundsel - -backgroundselHl1 - -backgroundselHl2 -
                                 -foregroundsel - -foregroundselHl1 - -foregroundselHl2 - -backgroundcur -
                                 -backgroundcurHl1 - -backgroundcurHl2 - -foregroundcur - -foregroundcurHl1 -
                                 -foregroundcurHl2 - -hl1 - -hl2 {
                                         # stuff which only requires @updatecolors:
                                         if {$key == {-background}} {$self(canvas) configure -background $value}
                                         set self($key) $value
                                         set update_colors 1
                                 }
                                 -hspacing - -vspacing {
                                         set self($key) $value
                                         set self(regionw) [col_to_x $self(-cols)]
                                         set self(regionh) [row_to_y $self(-rows)]
                                         $self(canvas) configure -scrollregion \
                                                 [list 0 0 $self(regionw) $self(regionh)]
                                         set re_init 1
                                 }
                                 -rows - -cols {
                                         set self($key) $value
                                         set self(regionw) [col_to_x $self(-cols)]
                                         set self(regionh) [row_to_y $self(-rows)]
                                         $self(canvas) configure -scrollregion \
                                                 [list 0 0 $self(regionw) $self(regionh)]
                                         set re_init 1
                                 }
                                 -xscrollcommand - -yscrollcommand -
                                 -width - -height {
                                         set self($key) $value
                                         $self(canvas) configure $key $value
                                 }
                                 -selectionmethod {
                                         set valid_methods {rect text}
                                         if {[lsearch -exact $valid_methods $value] >= 0} {
                                                 set self($key) $value
                                         } else {
                                                 return -code error "$key <method> must be one of: $valid_methods"
                                         }
                                 }
                                 -selectionnotify {
                                         set self(-notify:selection) $value
                                 }
                                 -setdatanotify {
                                         set self(-notify:setdata) $value
                                 }
                                 -cursornotify {
                                         set self(-notify:cursor) $value
                                 }
                                 -state {
                                         set valid_states {normal readonly}
                                         if {[lsearch -exact $valid_states $value] >= 0} {
                                                 set self($key) $value
                                         } else {
                                                 return -code error "$key <method> must be one of: $valid_states"
                                         }
                                 }
                                 default {
                                         if {[lsearch -exact $valid_options $key] >= 0} {
                                                 return -code error "unsupported option for configure \"$key\""
                                         } else {
                                                 return -code error "unknown option \"$key\""
                                         }
                                 }
                         }
                 }
                 if {$re_init} {init}
                 if {$update_colors} {updatecolors}
         }
 
         public method columnconfigure {col args} {
                 if {$col != {default} && ($col < 0 || $col >= $self(-cols))} {
                         return -code error "column index $col out fo range"
                 }
                 if {[llength $args] == 1} {
                         set key [lindex $args 0]
                         if [info exists self(-col:$col:$key)] {
                                 return $self(-col:$col:$key)
                         }
                         if [info exists self(-col:default:$key)] {
                                 return $self(-col:default:$key)
                         }
                         return -code error "invalid column option \"$key\""
                 }
                 set re_init 0
                 set update_col 0
                 foreach {key value} $args {
                         switch -- $key {
                                 -type {
                                         # sets both input and display methods
                                         set valid_types {number numberhex note symbol}
                                         if {[lsearch -exact $valid_types $value] >= 0} {
                                                 set self(-col:$col:$key) $value
                                                 columnconfigure $col -inputmethod $value
                                                 columnconfigure $col -displaymethod $value
                                         } else {
                                                 return -code error "invalid value for $key: \"$value\". must be one of [join $valid_types {, }]"
                                         }
                                 }
                                 -width {
                                         set self(-col:$col:$key) [expr {int($value)}]
                                         set re_init 1
                                 }
                                 -inputmethod {
                                         # this triggers an error in case of missing method:
                                         method_spec input$value
                                         set self(-col:$col:$key) $value
                                 }
                                 -displaymethod {
                                         # this triggers an error in case of missing method:
                                         method_spec display$value
                                         set self(-col:$col:$key) $value
                                         set update_col 1
                                 }
                         }
                 }
                 if {$re_init} {init}
                 if {$update_col} {updatecolumn $col}
         }
 
         private method callnotify {type args} {
                 if ![info exists self(-notify:$type)] {return}
                 switch -- $type {
                         cursor - selection - setdata {
                                 uplevel 1 [concat $self(-notify:$type) $args]
                         }
                 }
         }
 
         public method moveby {drow dcol} {
                 # move cursor by relative amount dx dy, wrap if needed
                 set old_row $self(cursor:row)
                 set old_col $self(cursor:col)
                 incr self(cursor:row) $drow
                 incr self(cursor:col) $dcol
                 while {$self(cursor:row) < 0} {incr self(cursor:row) $self(-rows)}
                 while {$self(cursor:col) < 0} {incr self(cursor:col) $self(-cols)}
                 set self(cursor:row) [expr {$self(cursor:row)%$self(-rows)}]
                 set self(cursor:col) [expr {$self(cursor:col)%$self(-cols)}]
                 set self(internal:subcol) 0
                 # do the scrolling if cell is not visible:
                 while {[cursor_scroll_proc] > 0} {}
                 if {$old_col == $self(cursor:col) && $old_row == $self(cursor:row)} {
                         return
                 }
                 callnotify cursor $self(cursor:row) $self(cursor:col)
                 if ![deselect] {
                         updatecellcolor $old_row $old_col
                         updatecellcolor $self(cursor:row) $self(cursor:col)
                 }
         }
 
         public method moveabs {row col} {
                 # move cursor to absolute position
                 set old_row $self(cursor:row)
                 set old_col $self(cursor:col)
                 set self(cursor:row) $row
                 set self(cursor:col) $col
                 moveby 0 0
                 if {$self(cursor:row) != $old_row  || $self(cursor:col) != $old_col} {
                         updatecellcolor $old_row $old_col
                         updatecellcolor $self(cursor:row) $self(cursor:col)
                         callnotify cursor $self(cursor:row) $self(cursor:col)
                 }
                 if ![deselect] {
                         updatecellcolor $old_row $old_col
                         updatecellcolor $self(cursor:row) $self(cursor:col)
                 }
         }
 
         public method moveabs_mousewrap {row col} {
                 if {[cget -state] == {readonly}} {return}
                 return [moveabs $row $col]
         }
 
         public method moveplayhead {row} {
                 if {$row < 0} {
                         $self(canvas) coords playhead -1 -1 -1 -1
                 } else {
                         $self(canvas) coords playhead 0 [row_to_y $row] [col_to_x $self(-cols)] [row_to_y [incr row]]
                 }
         }
 
         private method cursor_scroll_proc {} {
                 set fx1 [col_to_x $self(cursor:col)]
                 set fx2 [col_to_x [expr {$self(cursor:col)+1}]]
                 foreach {rx1 rx2} [$self(canvas) xview] {break}
                 set rx1 [expr {$rx1*$self(regionw)}]
                 set rx2 [expr {$rx2*$self(regionw)}]
                 set fy1 [row_to_y $self(cursor:row)]
                 set fy2 [row_to_y [expr {$self(cursor:row)+1}]]
                 foreach {ry1 ry2} [$self(canvas) yview] {break}
                 set ry1 [expr {$ry1*$self(regionh)}]
                 set ry2 [expr {$ry2*$self(regionh)}]
                 if {$rx1 != $rx2} {
                         if {$fx1 < $rx1 || $fx2 < $rx1} {
                                 $self(canvas) xview scroll -1 units
                                 return 1
                         }
                         if {$fx1 > $rx2 || $fx2 > $rx2} {
                                 $self(canvas) xview scroll 1 units
                                 return 1
                         }
                 }
                 if {$ry1 != $ry2} {
                         if {$fy1 < $ry1 || $fy2 < $ry1} {
                                 $self(canvas) yview scroll -1 units
                                 return 1
                         }
                         if {$fy1 > $ry2 || $fy2 > $ry2} {
                                 $self(canvas) yview scroll 1 units
                                 return 1
                         }
                 }
                 return 0
         }
 
         private method updatecellcolor {row col} {
                 if {$col == $self(cursor:col) && $row == $self(cursor:row)} {
                         set fgcolkey foregroundcur
                         set bgcolkey backgroundcur
                 } elseif {[isselected $row $col]} {
                         set fgcolkey foregroundsel
                         set bgcolkey backgroundsel
                 } else {
                         set fgcolkey foreground
                         set bgcolkey background
                 }
                 $self(canvas) itemconfigure [item_rc_tag $row $col] -fill [get_row_color $bgcolkey $row]
                 $self(canvas) itemconfigure [item_rc_tag $row $col xytxt] -fill [get_row_color $fgcolkey $row]
         }
 
         private method updatecelltext {row col} {
                 # call the proper displayXXX method to render the cell's text:
                 set vis_data [uplevel 0 [list display[columnconfigure $col -displaymethod] $row $col]]
                 $self(canvas) itemconfigure [item_rc_tag $row $col xytxt] -text $vis_data
         }
 
         private method updatecolor {row_start col_start {row_end -1} {col_end -1}} {
                 if {$col_end == {end}} {
                         set col_end [expr {$self(-cols)-1}]
                 } elseif {$col_end == -1} {
                         set col_end $col_start
                 }
                 if {$row_end == {end}} {
                         set row_end [expr {$self(-rows)-1}]
                 } elseif {$row_end == -1} {
                         set row_end $row_start
                 }
                 for {set col $col_start} {$col <= $col_end} {incr col} {
                         for {set row $row_start} {$row <= $row_end} {incr row} {
                                 if {$col == $self(cursor:col) && $row == $self(cursor:row)} {
                                         set fgcolkey foregroundcur
                                         set bgcolkey backgroundcur
                                 } elseif {[isselected $row $col]} {
                                         set fgcolkey foregroundsel
                                         set bgcolkey backgroundsel
                                 } else {
                                         set fgcolkey foreground
                                         set bgcolkey background
                                 }
                                 $self(canvas) itemconfigure [item_rc_tag $row $col] -fill [get_row_color $bgcolkey $row]
                                 $self(canvas) itemconfigure [item_rc_tag $row $col xytxt] -fill [get_row_color $fgcolkey $row]
                         }
                 }
         }
 
         private method updatetext {row_start col_start {row_end -1} {col_end -1}} {
                 if {$col_end == {end}} {
                         set col_end [expr {$self(-cols)-1}]
                 } elseif {$col_end == -1} {
                         set col_end $col_start
                 }
                 if {$row_end == {end}} {
                         set row_end [expr {$self(-rows)-1}]
                 } elseif {$row_end == -1} {
                         set row_end $row_start
                 }
                 for {set col $col_start} {$col <= $col_end} {incr col} {
                         set display_method display[columnconfigure $col -displaymethod]
                         for {set row $row_start} {$row <= $row_end} {incr row} {
                                 $self(canvas) itemconfigure [item_rc_tag $row $col xytxt] \
                                         -text [uplevel 0 [list $display_method $row $col]]
                         }
                 }
         }
 
         private method updatecolumn {col} {
                 if {$col == {default}} {
                         set colstart 0
                         set colend end
                 } else {
                         set colstart $col
                         set colend $colstart
                 }
                 updatetext 0 $colstart end $colend
                 updatecolor 0 $colstart end $colend
         }
 
         private method displaynumber {row col} {
                 set d [getdata $row $col]
                 set width [columnconfigure $col -width]
                 if {$d == {}} {return [string repeat . $width]}
                 set d [expr {$d%10**$width}]
                 return [format %${width}.lld $d]
         }
 
         private method displaynumberhex {row col} {
                 set d [getdata $row $col]
                 set width [columnconfigure $col -width]
                 if {$d == {}} {return [string repeat . $width]}
                 set d [expr {$d%16**$width}]
                 return [format %.0${width}llx $d]
         }
 
         private method displaynote {row col} {
                 set d [getdata $row $col]
                 if {$d == {}} {return {...}}
                 set note [expr {$d%12}]
                 set oct [expr {($d-$note)/12}]
                 if {$oct >= 10} {set oct 9}
                 if {$oct < 0} {set oct 0}
                 return "[lindex {C- C# D- D# E- F- F# G- G# A- A# B-} $note]${oct}"
         }
 
         private method displaysymbol {row col} {
                 #TODO:
                 return [string repeat ? [columnconfigure $col -width]]
         }
 
         private method displaybyte {row col} {
                 set d [getdata $row $col]
                 if {$d == {}} {return {}}
                 return [format %c $d]
         }
 
         private method resetcolors {} {
                 $self(canvas) itemconfigure bg -fill {}
                 $self(canvas) itemconfigure txt -fill {}
                 for {set row 0} {$row < $self(-rows)} {incr row} {
                         $self(canvas) itemconfigure bg_row_$row -fill [get_row_color background $row]
                         $self(canvas) itemconfigure txt_row_$row -fill [get_row_color foreground $row]
                 }
                 updatecursor
         }
 
         public method setdata {row col d} {
                 # change data at specified position
                 # d is an integer
                 setdata_noupdate $row $col $d
                 updatecelltext $row $col
                 updatecellcolor $row $col
         }
 
         private method setdata_noupdate {row col d} {
                 if {$d == {}} {
                         catch {unset self(data:$col,$row)}
                 } else {
                         if [catch {set d [expr {entier($d)}]}] {set d 0}
                         set self(data:$col,$row) $d
                         callnotify setdata $row $col $self(data:$col,$row)
                 }
         }
 
         public method getdata {row col {d {}}} {
                 # get data at specified position
                 set r $d
                 catch {set r [expr {entier($self(data:$col,$row))}]}
                 return $r
         }
 
         public method resetdata {} {
                 array unset _ $w:data:*
         }
 
         public method setdata_from_array {arrayname {prefix {}}} {
                 set data [uplevel 1 [list array get $arrayname "${prefix}*"]]
                 set default_prefix "$w:data:"
                 if {$prefix == {}} {set prefix $default_prefix}
                 if {$prefix != $default_prefix} {
                         set data2 {}
                         foreach {k v} $data {
                                 lappend data2 [regsub "^$prefix" $k $default_prefix] $v
                         }
                         set data $data2 ; unset data2
                         # TODO: implement setdata notify
                 }
                 array unset _ "${default_prefix}*"
                 array set _ $data
                 updatetext 0 0 end end
         }
 
         public method getdata_to_array {arrayname {prefix {}}} {
                 set default_prefix "$w:data:"
                 set data [array get _ "${default_prefix}*"]
                 if {$prefix == {}} {set prefix $default_prefix}
                 if {$prefix != $default_prefix} {
                         set data2 {}
                         foreach {k v} $data {
                                 lappend data2 [regsub "^$default_prefix" $k $prefix] $v
                         }
                         set data $data2 ; unset data2
                 }
                 uplevel 1 [list array unset $arrayname "${prefix}*"]
                 uplevel 1 [list array set $arrayname $data]
         }
 
         public method copy {} {
                 # perform a copy of selected area
                 array unset _ $w:copybuf:*
                 set idx 0
                 iterateselection row col {
                         set self(copybuf:$idx) [getdata $row $col]
                         incr idx
                 }
                 set self(copybuf:start:col) $self(sel:start:col)
                 set self(copybuf:start:row) $self(sel:start:row)
                 set self(copybuf:stop:col) $self(sel:stop:col)
                 set self(copybuf:stop:row) $self(sel:stop:row)
         }
 
         public method delete {} {
                 # delete selected area
                 iterateselection row col {
                         setdata $row $col {}
                 }
         }
 
         public method cut {} {
                 # perform a cut (that is: copy & delete)
                 copy
                 delete
         }
 
         public method paste {} {
                 # paste data from copybuf to current position
 
                 # if selection is empty, use the copybuf dimensions
                 set sel_flag 0
                 if {![sel]} {
                         set sel_flag 1
                         setsel $self(cursor:row) $self(cursor:col) \
                                 [expr {$self(cursor:row)+$self(copybuf:stop:row)-$self(copybuf:start:row)}] \
                                 [expr {$self(cursor:col)+$self(copybuf:stop:col)-$self(copybuf:start:col)}]
                 }
 
                 set idx 0
                 iterateselection row col {
                         catch {setdata $row $col $self(copybuf:$idx)}
                         incr idx
                 }
 
                 if {$sel_flag} {
                         deselect
                 }
                 moveby 0 0
         }
 
         public method randomize {} {
                 # randomize area in selected area. usefull when testing & debugging
                 iterateselection row col {
                         set width [columnconfigure $col -width]
                         # TODO: use proper charset depending on column type
                         set charset [split {0123456789} {}]
                         set d {}
                         while {$width > 0} {
                                 incr width -1
                                 append d [lindex $charset [expr {int(rand()*[llength $charset])}]]
                         }
                         setdata $row $col $d
                 }
         }
 
         private method bindcell {row col tag} {
                 # re-bind events to specific cell
                 $self(canvas) bind $tag <ButtonPress-1> "[method_call_spec moveabs_mousewrap] $row $col"
                 $self(canvas) bind $tag <B1-Motion> "[method_call_spec extendsel] %x %y"
         }
 
         public method select_all {} {
                 setsel 0 0 [expr {$self(-rows)-1}] [expr {$self(-cols)-1}]
         }
 
         public method select_none {} {
                 setsel $self(cursor:row) $self(cursor:col) $self(cursor:row) $self(cursor:col)
         }
 
         public method select_row {} {
                 setsel $self(cursor:row) 0 $self(cursor:row) [expr {$self(-cols)-1}]
         }
 
         public method select_column {} {
                 setsel 0 $self(cursor:col) [expr {$self(-rows)-1}] $self(cursor:col)
         }
 
         public method keypress {ks st} {
                 if {[cget -state] == {readonly}} {return}
                 # handle global (canvas) keypress (from event)
                 set shift [expr {($st&0x0001)>0}]
                 set caps [expr {($st&0x0002)>0}]
                 set control [expr {($st&0x0004)>0}]
                 set alt [expr {($st&0x0008)>0}]
                 set super [expr {($st&0x0040)>0}]
 
                 if $shift { switch -- $ks {
                         Left {extendsel_rel 0 -1; return}
                         Right {extendsel_rel 0 1; return}
                         Up {extendsel_rel -1 0; return}
                         Down {extendsel_rel 1 0; return}
                         Home {moveabs $self(cursor:row) 0; return}
                         End {moveabs $self(cursor:row) -1; return}
                 } }
                 if $control { switch -- $ks {
                         c {copy; return}
                         x {cut; return}
                         v {paste; return}
                         r {randomize; return}
                         a {select_all; return}
                         u {select_none; return}
                         l {if $shift {select_row} else {select_column}}
                 } }
                 switch -- $ks {
                         Left {moveby 0 -1; return}
                         Right {moveby 0 1; return}
                         Up {moveby -1 0; return}
                         Down {moveby 1 0; return}
                         BackSpace {delete; return}
                         Home {moveabs 0 $self(cursor:col); return}
                         End {moveabs -1 $self(cursor:col); return}
                         Next {moveby [expr {max(4,$self(-hl2))}] 0; return}
                         Prior {moveby [expr {-max(4,$self(-hl2))}] 0; return}
                 }
 
                 uplevel 0 [list input[columnconfigure $self(cursor:col) -inputmethod] $self(cursor:row) $self(cursor:col) $ks $st]
         }
 
         private method inputnumber {row col keysym state} {
                 # keypresses are sent here from method keypress, based on <col> -inputmethod (-type)
                 if {![regexp -nocase -- {^[0123456789]$} $keysym]} {
                         return
                 }
                 set d [getdata $row $col 0]
                 set colch [columnconfigure $col -width]
                 if {$self(internal:subcol) == 0} {
                         set d $keysym
                 } else {
                         set d [expr {($d*10+$keysym)%(10**$colch)}]
                 }
                 setdata $row $col $d
                 incr self(internal:subcol)
                 if {$self(internal:subcol) >= $colch} {
                         moveby 1 0
                 }
         }
 
         private method inputnumberhex {row col keysym state} {
                 if {![regexp -nocase -- {^[0123456789abcdef]$} $keysym]} {
                         return
                 }
                 set keysym "0x$keysym"
                 set d [getdata $row $col 0]
                 set width [columnconfigure $col -width]
                 if {$self(internal:subcol) == 0} {
                         set d $keysym
                 } else {
                         set d [expr {($d*16+$keysym)%(16**$width)}]
                 }
                 setdata $row $col $d
                 incr self(internal:subcol)
                 if {$self(internal:subcol) >= $width} {
                         moveby 1 0
                 }
         }
 
         private method inputnote {row col keysym state} {
                 set map {z 0 s 1 x 2 d 3 c 4 v 5 g 6 b 7 h 8 n 9 j 10 m 11}
                 set d [getdata $row $col 0]
                 set note [expr {$d%12}]
                 set oct [expr {($d-$note)/12}]
                 switch -- $keysym {
                         z - s - x - d - c - v - g - b - h - n - j - m {
                                 set note [string map -nocase $map $keysym]
                         }
                         0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 {
                                 set oct $keysym
                         }
                         default {
                                 return
                         }
                 }
                 setdata $row $col [expr {$oct*12+$note}]
                 moveby 1 0
         }
 
         private method inputsymbol {row col keysym state} {
                 moveby 1 0
         }
 
         private method col_from_x {x} {
                 # get col# from x position
                 set curcol 0
                 set xlim 0
                 while {$curcol < $self(-cols)} {
                         set colwidth [expr {[columnconfigure $curcol -width]*$self(-charwidth)+$self(-hspacing)}]
                         incr xlim $colwidth
                         if {$x <= $xlim} {return $curcol}
                         incr curcol
                 }
                 return -1
         }
 
         private method row_from_y {y} {
                 # get row# from y position
                 set currow 0
                 set ylim 0
                 set lineheight [expr {$self(-charheight)+$self(-vspacing)}]
                 while {$currow < $self(-rows)} {
                         incr ylim $lineheight
                         if {$y <= $ylim} {return $currow}
                         incr currow
                 }
                 return -1
         }
 
         private method col_to_x {col} {
                 # get the x position of given col#
                 set x 0
                 set li 0
                 while {$col > 0} {
                         incr x [expr {($self(-charwidth)*\
                          [columnconfigure $li -width])+\
                          $self(-hspacing)}]
                         incr li
                         if {$li >= $self(-cols)} {
                                 return $x
                         }
                         incr col -1
                 }
                 return $x
         }
 
         private method row_to_y {row} {
                 # get the y position of given row#
                 return [expr {$row*($self(-charheight)+$self(-vspacing))}]
         }
 
         public method extendsel {_x _y} {
                 if {[cget -state] == {readonly}} {return}
                 # extend selection to specified (pixel) position (from event)
                 set oldsel [selstring]
                 clip_x_y _x _y
                 set self(sel:stop:col) [col_from_x $_x]
                 set self(sel:stop:row) [row_from_y $_y]
                 clipsel
                 set newsel [selstring]
                 if {$oldsel != $newsel} {uplevel 1 [notifysel]}
                 updatesel
         }
 
         private method extendsel_rel {drow dcol} {
                 set oldsel [selstring]
                 incr self(sel:stop:col) $dcol
                 incr self(sel:stop:row) $drow
                 clipsel
                 set newsel [selstring]
                 if {$oldsel != $newsel} {uplevel 1 [notifysel]}
                 updatesel
         }
 
         public method setsel {startrow startcol stoprow stopcol} {
                 set oldsel [selstring]
                 if {$stoprow == {end}} {set stoprow [expr {[cget -rows]-1}]}
                 if {$stopcol == {end}} {set stopcol [expr {[cget -cols]-1}]}
                 set self(sel:start:row) $startrow
                 set self(sel:start:col) $startcol
                 set self(sel:stop:row) $stoprow
                 set self(sel:stop:col) $stopcol
                 clipsel
                 set newsel [selstring]
                 if {$oldsel != $newsel} {uplevel 1 [notifysel]}
                 updatesel
         }
 
         private method notifysel {} {
                 callnotify selection \
                         $self(sel:start:row) $self(sel:start:col) \
                         $self(sel:stop:row) $self(sel:stop:col)
         }
 
         private method selstring {} {
                 return [join [list \
                         $self(sel:start:row) $self(sel:start:col) \
                         $self(sel:stop:row) $self(sel:stop:col)] ,]
         }
 
         private method clipsel {} {
                 # clip selection bounds based upon the current selection method
                 if {$self(sel:start:col) < 0} {set self(sel:start:col) 0}
                 if {$self(sel:start:row) < 0} {set self(sel:start:row) 0}
                 switch -- [cget -selectionmethod] {
                         rect {
                                 if {$self(sel:stop:col) < $self(sel:start:col)} {set self(sel:stop:col) $self(sel:start:col)}
                                 if {$self(sel:stop:row) < $self(sel:start:row)} {set self(sel:stop:row) $self(sel:start:row)}
                         }
                         text {
                                 if {$self(sel:stop:row) < $self(sel:start:row)} {set self(sel:stop:row) $self(sel:start:row)}
                                 if {$self(sel:stop:row) == $self(sel:start:row)} {
                                         if {$self(sel:stop:col) < $self(sel:start:col)} {set self(sel:stop:col) $self(sel:start:col)}
                                 }
                         }
                 }
         }
 
         private method updatesel {} {
                 $self(canvas) dtag sel
                 resetcolors
                 set old_row {}
                 iterateselection row col {
                         if {$row != $old_row} {
                                 set bgcol [get_row_color backgroundsel $row]
                                 set fgcol [get_row_color foregroundsel $row]
                                 set old_row $row
                         }
                         $self(canvas) addtag sel withtag [item_rc_tag $row $col]
                         $self(canvas) itemconfigure [item_rc_tag $row $col] -fill $bgcol
                         $self(canvas) itemconfigure [item_rc_tag $row $col xytxt] -fill $fgcol
                 }
                 updatecursor
         }
 
         private method iterateselection {row_var_name col_var_name body} {
                 upvar 1 $row_var_name row
                 upvar 1 $col_var_name col
                 switch -- [cget -selectionmethod] {
                         rect {
                                 for {set row $self(sel:start:row)} {$row <= $self(sel:stop:row)} {incr row} {
                                         for {set col $self(sel:start:col)} {$col <= $self(sel:stop:col)} {incr col} {
                                                 uplevel 1 $body
                                         }
                                 }
                         }
                         text {
                                 if {$self(sel:start:row) == $self(sel:stop:row)} {
                                         set row $self(sel:start:row)
                                         for {set col $self(sel:start:col)} {$col <= $self(sel:stop:col)} {incr col} {
                                                 uplevel 1 $body
                                         }
                                 } else {
                                         set row $self(sel:start:row)
                                         for {set col $self(sel:start:col)} {$col < $self(-cols)} {incr col} {
                                                 uplevel 1 $body
                                         }
 
                                         for {set row [expr {$self(sel:start:row)+1}]} {$row < $self(sel:stop:row)} {incr row} {
                                                 for {set col 0} {$col < $self(-cols)} {incr col} {
                                                         uplevel 1 $body
                                                 }
                                         }
 
                                         set row $self(sel:stop:row)
                                         for {set col 0} {$col <= $self(sel:stop:col)} {incr col} {
                                                 uplevel 1 $body
                                         }
                                 }
                         }
                 }
         }
 
         private method isselected {row col} {
                 switch -- [cget -selectionmethod] {
                         rect {
                                 if {$col < $self(sel:start:col) || $col > $self(sel:stop:col)} {return 0}
                                 if {$row < $self(sel:start:row) || $row > $self(sel:stop:row)} {return 0}
                                 return 1
                         }
                         text {
                                 if {$row == $self(sel:start:row) && $row == $self(sel:stop:row)} {
                                         return 0
                                         if {$col >= $self(sel:start:col) && $col <= $self(sel:stop:col)} {
                                                 return 1
                                         } else {
                                                 return 0
                                         }
                                 }
                                 if {$row == $self(sel:start:row) && $col >= $self(sel:start:col)} {return 1}
                                 if {$row == $self(sel:stop:row) && $col <= $self(sel:stop:col)} {return 1}
                                 if {$row > $self(sel:start:row) && $row < $self(sel:stop:row)} {return 1}
                                 return 0
                         }
                         default {
                                 # trigger an error, eventually
                                 configure -selectionmethod [cget -selectionmethod]
                         }
                 }
         }
 
         public method sel {} {
                 # return whether selection is set or not
                 if {$self(sel:start:col) != $self(sel:stop:col)} {return 1}
                 if {$self(sel:start:row) != $self(sel:stop:row)} {return 1}
                 return 0
         }
 
         public method deselect {} {
                 # clears current selection
                 set retval 0
                 if {$self(sel:start:col)<$self(sel:stop:col) || $self(sel:start:row)<$self(sel:stop:row)} {
                         set retval 1
                 }
                 set self(sel:start:col) $self(cursor:col)
                 set self(sel:start:row) $self(cursor:row)
                 set self(sel:stop:col) $self(sel:start:col)
                 set self(sel:stop:row) $self(sel:start:row)
                 uplevel 1 [notifysel]
                 if $retval resetcolors
                 return $retval
         }
 
         private method updatecolors {} {
                 resetcolors
                 updatesel
         }
 
         private method updatecursor {} {
                 $self(canvas) itemconfigure \
                  [item_rc_tag $self(cursor:row) $self(cursor:col)] \
                  -fill [get_row_color backgroundcur $self(cursor:row)]
                 $self(canvas) itemconfigure \
                  [item_rc_tag $self(cursor:row) $self(cursor:col) xytxt] \
                  -fill [get_row_color foregroundcur $self(cursor:row)]
         }
 
         public method focus {} {
                 # take focus (by a click, from event)
                 focus $w
         }
 
         private method clip_x_y {varw varh} {
                 set width [col_to_x $self(-cols)]
                 set height [row_to_y $self(-rows)]
                 upvar 1 $varw _varw
                 upvar 1 $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}]}
         }
 }
 
 namespace import tracker::tracker

----
!!!!!!
%| [Category Widget] |%
!!!!!!