[FF] - 2008-07-01 - Since people asked what [TrackerWidget] is for, here's is an example (still incomplete) of some of its features.

N.B.: requires [TrackerWidget] saved in a tracker.tcl file in current directory.

[http://wiki.tcl.tk/_repo/images/FF/hexedit2.png]
----
======
 #!/usr/bin/env wish
 
 source tracker.tcl
 
 trace add variable ::wm_title write set_wm_title
 
 proc set_wm_title {name _ op} {
     if {$::wm_title != {}} {
         wm title . "HexEdit - $::wm_title"
     } else {
         wm title . "HexEdit"
     }
 }
 
 proc menu_open {} {
     global filename
     set f [tk_getOpenFile]
     if {$f != {}} {set filename $f; jump_to_offset 0 0; set ::wm_title $filename}
 }
 
 proc menu_save {} {
     global filename
     tk_messageBox -icon warning -type ok -message "Not implemented yet!" -detail "Time for looking at the code? ;-P"
 }
 
 proc menu_save_as {} {
     global filename
     tk_messageBox -icon warning -type ok -message "Not implemented yet!" -detail "Time for looking at the code? ;-P"
     #set f [tk_getSaveFile -initialfile $filename]
 }
 
 proc help_about {} {
     set e [string map {R ri O co Q de Z fe I it W ma L il} ZQRO.ZrR.I@gWL.Om]
     tk_messageBox -icon info -type ok -message "hexedit (a demo of tracker widget)\nby Federico Ferri <$e> - 2008\n\nhttp://wiki.tcl.tk/FF\n" -title "About"
 }
 
 proc help_dwim {} {
     tk_messageBox -icon question -type ok -message "Wouldn't that be nice?" -detail "I almost finished the algorithm and I'll release it soon! :)"
 }
 
 proc jump_to_offset {kb b} {
     global filename
     if ![file exists $filename] {return}
 
     set fh [open $filename r]
     seek $fh [expr {1024*$kb+$b}]
     for {set row 0} {$row < 64} {incr row} {
                 .ta setdata $row 0 [expr {16*$row+1024*$kb+$b}]
         for {set col 0} {$col < 16} {incr col} {
             set ch [read $fh 1]
             if {$ch != {} && [scan $ch %c ascii]} {
                 .t setdata $row $col $ascii
             } else {
                 .t setdata $row $col {}
             }
         }
     }
     close $fh
 }
 
 proc yset {n args} {
         uplevel 1 [linsert $args 0 .vs set]
         if {$n != 1} {uplevel 1 [list .ta yview moveto [lindex [.vs get] 0]]}
         if {$n != 2} {uplevel 1 [list .t  yview moveto [lindex [.vs get] 0]]}
         if {$n != 3} {uplevel 1 [list .tb yview moveto [lindex [.vs get] 0]]}
 }
 
 proc yview {args} {
         uplevel 1 [linsert $args 0 .ta yview]
         uplevel 1 [linsert $args 0 .t yview]
         uplevel 1 [linsert $args 0 .tb yview]
 }
 
 proc update_cursor {r c} {
         .ta moveabs $r 0
         .tb moveabs $r $c
 }
 
 proc update_sel {sr sc er ec} {
         .ta setsel $sr 0 $er 0
         .tb setsel $sr $sc $er $ec
 }
 
 proc update_data {r c d} {
         .tb setdata $r $c $d
 }
 
 set ::wm_title {}
 menu .mb
 . configure -menu .mb
 menu .mb.f -tearoff 0
 .mb.f add command -label {Open...} -command menu_open
 .mb.f add command -label {Save} -command menu_save
 .mb.f add command -label {Save as...} -command menu_save_as
 .mb.f add separator
 .mb.f add command -label {Exit} -command {exit}
 .mb add cascade -label {File} -menu .mb.f
 menu .mb.e -tearoff 0
 .mb.e add command -label {Cut} -command {.t cut}
 .mb.e add command -label {Copy} -command {.t copy}
 .mb.e add command -label {Paste} -command {.t paste}
 .mb.e add command -label {Delete} -command {.t delete}
 .mb.e add separator
 .mb.e add command -label {Select all} -command {.t select_all}
 .mb.e add command -label {Select none} -command {.t select_none}
 .mb.e add command -label {Select row} -command {.t select_row}
 .mb.e add command -label {Select column} -command {.t select_column}
 .mb add cascade -label {Edit} -menu .mb.e
 menu .mb.h -tearoff 0
 .mb.h add command -label {About...} -command help_about
 .mb.h add separator
 .mb.h add command -label {Do What I Mean} -command help_dwim
 .mb add cascade -label {Help} -menu .mb.h
 
 tracker::tracker .ta -rows 64 -cols 1 -width 80 -height 380\
     -yscrollcommand {yset 1} -state readonly
 .ta columnconfigure default -type numberhex -width 8
 tracker::tracker .t -rows 64 -cols 16 -width 460 -height 380\
     -yscrollcommand {yset 2} -selectionmethod text \
         -selectionnotify update_sel -setdatanotify update_data -cursornotify update_cursor
 .t columnconfigure default -type numberhex -width 2
 tracker::tracker .tb -rows 64 -cols 16 -width 300 -height 380\
     -yscrollcommand {yset 3} -selectionmethod text -state readonly
 .tb columnconfigure default -type numberhex -displaymethod byte -width 1
 scrollbar .vs -orient vertical -command {yview}
 set row 0
 grid .ta -row $row -column 0 -sticky news
 grid .t -row $row -column 1 -sticky news
 grid .tb -row $row -column 2 -sticky news
 grid .vs -row $row -column 10 -sticky ns
 grid columnconfigure . 0 -weight 1
 grid rowconfigure . 0 -weight 1
 incr row
 grid [frame .f] -row $row -sticky news -columnspan 2
 grid \
     [label .f.l1 -text "Jump to offset:"] \
     [spinbox .f.v1 -width 5 -from 0 -to 999999 -increment 1 -validate all] \
     [label .f.l2 -text "Kb + "] \
     [spinbox .f.v2 -width 5 -from 0 -to 1023 -increment 16 -wrap 1 -validate all] \
     [label .f.l3 -text "bytes"] \
     [button .f.b1 -text "Go!" -command {jump_to_offset [.f.v1 get] [.f.v2 get]}] \
     [label .f.l4 -text ""] \
     -row 2 -sticky news
 grid columnconfigure .f 6 -weight 1
======

<<categories>> Binary Data