An example Tk application using Tk and BWidgets that shows a comparison between two binary files and shows the differences between them.

----

 #! /bin/sh
 # bindiff.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
 #
 # Show a side by side comparison of two binary files with the differences
 # highlighted
 #
 # This could probably use more work, but it does the job I required it for.
 # Differences are highlighted in red.
 #
 # usage:
 #  bindiff fileA fileB
 #
 # 16 Jan 2004: Patch provided by Paul Kienzle for different length files.
 #
 # $Id: 8545,v 1.2 2004-01-16 07:00:22 jcw Exp $
 # \
 exec wish "$0" ${1+"$@"}
 
 package require Tk
 package require BWidget
 
 set filename0 {}
 set filename1 {}
 set txt {}
 set progress 0
 set top {}
 
 set menu {
     "&File" {} {} 0 {
         { command    "&Left..."  {}  "Select the left hand side file" {} -command Menu::left }
         { command    "&Right..." {}  "Select the right hand side file" {} -command Menu::right }
         { separator }
         { command    "&Compare"  {}  "Show the differences in the view window" {} -command Menu::compare}
         { command     "E&xit"    {}  "Exit the application" {} -command Menu::exitApplication }
     }
     "&Options" {} {} 0 {
         { command     "&Font..." {}  "Select a new font"    {} -command Menu::fontSelect }
         { checkbutton "&Console" {}  "Show console"  {}  -variable Menu::console -command Menu::toggleConsole}
     }
     "&Help" {} {} 0 {
     }
 }
 
 namespace eval Menu {
     variable console 0
     proc toggleConsole {} {
        variable console
        if {$console} { console hide } else {console show }
     }
     proc exitApplication {} {
         destroy $::top
     }
     proc fontSelect {} {
         global txt top
         set font [SelectFont .sel]
         font configure fdiff -family [lindex $font 0] -size [lindex $font 1] -weight [lindex $font 2]
     }
     proc left {} {
         global txt top
         set name [tk_getOpenFile -parent $top -title "Select left hand file"]
         if {$name != {}} {
             set ::filename0 $name
             $txt delete 0.0 end
         }
     }
     proc right {} {
         global txt top
         set name [tk_getOpenFile -parent $top -title "Select right hand file"]
         if {$name != {}} {
              set ::filename1 $name
              $txt delete 0.0 end
         }
     }
     proc compare {} {
         if {[file exists $::filename0] && [file exists $::filename1]} {
             cmp $::filename0 $::filename1
         } else {
             tk_messageBox -icon error -type ok -title "Cannot compare" -message "Select two files for comparison."
         }
     }
 }
 
 proc gui {dlg} {
     global txt top
 
     set top $dlg
 
     wm title $dlg "Binary diff"
     if {$dlg == "."} { set dlg ""}
 
     font create fdiff -family {Courier New} -size 8 -weight normal
 
     set mw [MainFrame $dlg.main -menu $::menu -progressvar ::progress -progressmax 100]
     $mw showstatusbar progression
 
     set f1 [frame $mw.f1]
     set l0 [label $f1.l0 -font fdiff -width 10 -text "Filename:"]
     set l1 [label $f1.l1 -font fdiff -width 49 -textvariable ::filename0]
     set l2 [label $f1.l2 -font fdiff -width 49 -textvariable ::filename1]
     set l3 [label $f1.l3 -font fdiff -width 34 -textvariable ::filename0]
     pack $l0 $l1 $l2 $l3 -side left
     pack $f1 -side top -fill x
 
     set txt [text $dlg.txt -font fdiff]
     $txt tag configure diff -background red
 
     set sw [ScrolledWindow $mw.view]
     $sw setwidget $txt
     pack $sw -side top -fill both -expand 1 -anchor n
     pack $mw -side top -fill both -expand 1 -anchor n
 
     return $dlg
 }
 
 proc cmp {file0 file1} {
     global txt top
     set taglist {}
 
     set dlg $top
     if {$dlg == "."} {set dlg ""}
     set cursors [list $txt [$txt cget -cursor] $top [$top cget -cursor]]
     #$txt configure -cursor wait
     #$top configure -cursor wait
 
     ${dlg}.main configure -progressmax [file size $file0]
     set ::progress 0
 
     set f0 [open $file0 r]
     set f1 [open $file1 r]
 
     set ::filename0 $file0
     set ::filename1 $file1
 
     fconfigure $f0 -translation binary
     fconfigure $f1 -translation binary
 
     set off 0
     set chunk 16
     set linecount 1
     while {![eof $f0] || ![eof $f1]} {
         set d0 [read $f0 $chunk]
         set d1 [read $f1 $chunk]
 
         binary scan $d0 c* c0
         binary scan $d1 c* c1
 
         set line "[format 0x%06x $off] "
         foreach v $c0 { append line [format { %02x} [expr {$v & 0xFF}]] }
         append line [string repeat "   " [expr {$chunk-[string length $d0]}]]
         append line "  "
         foreach v $c1 { append line [format { %02x} [expr {$v & 0xFF}]] }
         append line [string repeat "   " [expr {$chunk-[string length $d1]}]]
         append line "  "
         foreach v $c0 {
             set cv [expr {$v & 0xFF}]
             if {$cv < 32} { set cv 46 }
             append line [format { %c} $cv]
         }
         append line "\n"
         #set lineno [lindex [split [$txt index current] .] 0]
         #if {$lineno != $linecount} {puts ">> $lineno != $linecount"}
         $txt insert end $line
 
         set n 9
         set diff 0
         foreach v0 $c0 v1 $c1 {
             if {$diff == 0 && $v0 != $v1} {
                 lappend taglist "$linecount.[expr {$n + 1}]"
                 set diff 1
             } elseif {$diff == 1 && $v0 == $v1} {
                 lappend taglist "$linecount.$n"
                 set diff 0
             }
             incr n 3
         }
         if {$diff == 1} {
             lappend taglist "$linecount.$n"
         }
         incr off $chunk        
         if {$linecount % 50 == 0} {
             set ::progress $off
             if {[llength $taglist] > 0} {
                 eval [list $txt tag add diff] $taglist
                 set taglist {}
             }
         }
         incr linecount
     }
 
     close $f0
     close $f1
 
     if {[llength $taglist] > 0} {
         eval [list $txt tag add diff] $taglist
         set taglist {}
     }
     #foreach {w c} $cursors { $w configure -cursor $c }
     return $taglist
 }
 
 if {!$::tcl_interactive} {
     gui .
     if {[llength $argv] == 2} {
         eval [list cmp] $argv
     }
     tkwait window .
 }

----

[[ [Category Application] ]]