[GPS] Tue Mar 5, 2002 - This hex editor widget supports insertion and deletion of hex characters.  It displays the byte offset on the left, and the ASCII representation (if applicable) on the right.  It displays 16 bytes per line.

Enjoy!  :)
----
'''Update''': Jan 3, 2003

[Michel Salvagniac] pointed out to me that the code on this page didn't work.  Somehow I made a mistake when inserting the code.  You can find the code here: http://www.xmission.com/~georgeps/malephiso/hex.tcl  I have replaced the code that was here with a working version.

I also added a screenshot below.
----
[http://www.xmission.com/~georgeps/malephiso/hex.png]

  #!/bin/wish8.3
  
  proc bind:copyClass {class newClass} {
    foreach binding [bind $class] {
      bind $newClass $binding [bind $class $binding]
    }
  }
  
  proc bind:removeAllBut {class bindList} {
    foreach binding $bindList {
      array set tmprab "<${binding}> 0"
    }
  
    foreach binding [bind $class] {
      if {[info exists tmprab($binding)]} {
        continue
      }
      bind $class $binding {}
    }
  
    array unset tmprab
  }
  
  proc widget:hex:updateYview {win args} {
    set pos [lindex $args 0]
    
    $win.hex yview moveto $pos
    widget:hex:resizeColumns $win
    widget:hex:updateASCII $win
    widget:hex:updateOffset $win
    
    puts "scroll set args: $args"
    eval $win.scroll set $args
  }
  
  proc widget:hex:event:Button-1 {win x y} {
    set pos [$win.hex index @$x,$y]
    $win.hex mark set insert $pos
    $win.hex mark set anchor insert
    focus $win.hex
  
    $win.hex tag remove sel 0.0 end
    $win.ascii tag remove sel 0.0 end
    
    set cur [$win.hex index insert]
    set splitIndex [split $cur .]
  
    set line [lindex $splitIndex 0]
    set curChar [lindex $splitIndex 1]
    #puts stderr $curChar
  
    if {[expr {$curChar & 1}]} {
      set curChar [expr {$curChar - 1}]
    }
  
    if {$curChar > 0} {
      set curChar [expr {$curChar / 2}]
    }
    
    set hexLine [$win.hex index @0,0]
    #puts "cur $cur"
    set offset [expr {int($line - $hexLine + 1.0)}]
    
    set cur "$offset.$curChar"
    set end [$win.ascii index "$cur + 1 chars"]
    $win.ascii tag add sel $cur $end
  }
  
  proc widget:hex:ascii:event:Button-1 {win x y} {
    set pos [$win.ascii index @$x,$y]
    $win.ascii mark set insert $pos
    $win.ascii mark set anchor insert
    focus $win.ascii
  
    $win.hex tag remove sel 0.0 end
    $win.ascii tag remove sel 0.0 end
    
    set cur [$win.hex index insert]
  }
  
  proc widget:hex:updateASCII {win} {
    set start [$win.hex index @0,0]
    set end [$win.hex index @0,[winfo height $win.hex]]
  
    set end [expr {double($end + 1.0)}]
    #puts "$start $end"
  
    set data [split [$win.hex get $start $end] \n]
    
    $win.ascii delete 1.0 end
    foreach line $data {
      set lineLength [expr {[string length $line] / 2}]
      set line [binary format H* $line]
      
      for {set i 0} {$i < $lineLength} {incr i} {
        binary scan $line @${i}a1 ascii
        
        if {[string is alnum $ascii]} {
          $win.ascii insert end $ascii
        } else {
          $win.ascii insert end .
        }
      }
      $win.ascii insert end \n
    }
  }
  
  
  proc widget:hex:updateOffset {win} {
    set viewFirst [$win.hex index @0,0]
    set viewLast [$win.hex index @0,[winfo height $win.hex]]
  
    set viewFirstLine [lindex [split $viewFirst .] 0]
    set viewLastLine [lindex [split $viewLast .] 0]
  
    incr viewFirstLine -1
  
    $win.offset delete 1.0 end
  
    for {set i $viewFirstLine} {$i < $viewLastLine} {incr i} {
      set offset [expr {$i * 16}]
      $win.offset insert end $offset\n
    }
  
    $win.offset config -width [string length $offset]
  }
  
  proc widget:hex:resizeColumns {win} {
    set start [$win.hex index @0,0]
    set end [$win.hex index @0,[winfo height $win.hex]]
  
    set viewStartLine [lindex [split $start .] 0]
    set viewEndLine [lindex [split $end .] 0]
  
    #puts "viewStartLine $viewStartLine"
    #puts "viewEndLine $viewEndLine"
  
    for {set i $viewStartLine} {$i <= $viewEndLine} {incr i} {
      set lineend [$win.hex index "$i.0 lineend"]
      set charEnd [lindex [split $lineend .] 1]
      
      if {$charEnd < 32} {
        $win.hex delete $lineend
      } elseif {$charEnd > 32} {
        #delete the \n
        $win.hex delete "$i.$charEnd"
        $win.hex insert "$i.32" \n
      }
    } 
  }
  
  proc widget:hex:event:backSpace {win} {
    set cur [$win.hex index insert]
    if {[regexp {[0-9]+\.0} $cur]} {
      return
    }
  
    if {[string compare [$win.hex tag nextrange sel 1.0 end] ""]} {
      $win.hex delete sel.first sel.last
    } elseif {[$win.hex compare insert != 1.0]} {
      $win.hex delete insert-1c
      $win.hex see insert
    }
    
    after idle [list widget:hex:resizeColumns $win]
    after idle [list widget:hex:updateASCII $win]
    after idle [list widget:hex:updateOffset $win]
  }
  
  proc widget:hex:event:delete {win} {
  
    if {[catch {$win.hex delete sel.first sel.last}]} {
      $win.hex delete insert 
    }
    
    after idle [list widget:hex:resizeColumns $win]
    after idle [list widget:hex:updateASCII $win]
    after idle [list widget:hex:updateOffset $win]
  }
  
  proc widget:hex:event:insert {win char} {
    if {![regexp {[0-9a-f]} $char]} {
      return
    }
  
    $win.hex insert insert $char
    $win.hex see insert
    widget:hex:resizeColumns $win
    after idle [list widget:hex:updateASCII $win]
    after idle [list widget:hex:updateOffset $win]
  }
  
  proc widget:hex:instanceCmd {win cmd args} {
    #puts "instanceCmd $win $cmd $args"
  
    if {$cmd == "insert"} {
      if {[llength $args] != 1} {
        return -code error "insert called with more than one argument: $args"
      }
    
      set data [lindex $args 0]
      binary scan $data H* hex
    
      set newHex ""
      set charCount 0
      set hexLen [string length $hex]
      for {set i 0} {$i < $hexLen} {incr i} {
        incr charCount
        append newHex [string index $hex $i]
        if {$charCount == 32} {
          append newHex \n
          set charCount 0
        }
      }
  
      $win.hex insert end $newHex
      
      widget:hex:updateASCII $win
      widget:hex:updateOffset $win
  
    } elseif {$cmd == "clear"} {
      if {[llength $args] != 0} {
        return -code error "clear was called with arguments and doesn't accept any arguments: $args"
      }
      $win.offset delete 1.0 end
      $win.hex delete 1.0 end
      $win.ascii delete 1.0 end
  
    } elseif {$cmd == "get"} {
      if {[llength $args] != 0} {
        return -code error "get was called with arguments and doesn't accept any arguments: $args"
      }
  
      set data [$win.hex get 1.0 end-1c]
      set data [string map {"\n" ""} $data]
      set data [binary format H* $data]
      return $data
  
    } elseif {[string match "conf*" $cmd]} {
      if {[expr {[llength $args] & 1}] != 0} {
        return -code error "Invalid number of arguments given to $win\
  (uneven number): $args"
      }
      array set cmdArgs $args
  
      foreach flag {foreground background} short {fg bg} {
        if {[info exists cmdArgs(-$flag)]} {
          $win.offset config -$short $cmdArgs(-$flag)
          $win.hex config -$short $cmdArgs(-$flag)
          $win.ascii config -$short $cmdArgs(-$flag)
          unset cmdArgs(-$flag)
        } 
  
        if {[info exists cmdArgs(-$short)]} {
          $win.offset config -$short $cmdArgs(-$short)
          $win.hex config -$short $cmdArgs(-$short)
          $win.ascii config -$short $cmdArgs(-$short)
          unset cmdArgs(-$short)
        }
      }
      
      if {[info exists cmdArgs(-insertbackground)]} {
        $win.hex config -insertbackground $cmdArgs(-insertbackground)
        $win.ascii config -insertbackground $cmdArgs(-insertbackground)
        unset cmdArgs(-insertbackground)
      }
      
      if {[array size cmdArgs] > 0} {
        return -code error "1 or more arguments were not understood: [array get cmdArgs]"
      }
    } elseif {$cmd == "cget"} {
      set flag [lindex $args 0]
      switch -- $flag {
        -bg -
        -background {
          return [$win.hex cget -bg]
        }
  
        -fg -
        -foreground {
          return [$win.hex cget -fg]
        }
  
        -insertbackground {
          return [$win.hex cget -insertbackground]
        }
        
        default {
          return -code error "unknown flag given to cget: $flag"
        }
      }
    }
  }
  
  proc widget:hex {win args} {
  
    if {[expr {[llength $args] & 1}] != 0} {
      return -code error "Invalid number of arguments given to widget:hex\
  (uneven number after window): $args"
    }
  
    array set cmdArgs $args
    text .__temp
    set bg [.__temp cget -bg]
    set fg [.__temp cget -fg]
    set insertbackground  [.__temp cget -insertbackground]
    puts $insertbackground
    destroy .__temp
  
    foreach flag {foreground background} short {fg bg} {
      if {[info exists cmdArgs(-$flag)]} {
        set $short [set cmdArgs(-$flag)]
        unset cmdArgs(-$flag)
      } 
  
      if {[info exists cmdArgs(-$short)]} {
        set $short [set cmdArgs(-$short)]
        unset cmdArgs(-$short)
      }
    }
  
    if {[info exists cmdArgs(-insertbackground)]} {
      set insertbackground $cmdArgs(-insertbackground)
    }
  
    if {[array size cmdArgs] > 0} {
      return -code error "1 or more arguments were not understood: [array get cmdArgs]"
    }
  
    bind:copyClass Text HexEdit$win
    
    bind:removeAllBut HexEdit$win [list Key-Left Key-Right \
      Key-Up Key-Down Key-Next Key-Prior B1-Motion Button-2 B2-Motion]
  
    bind HexEdit$win <Button-1> [list widget:hex:event:Button-1 $win %x %y]
    bind HexEdit$win <Delete> [list widget:hex:event:delete $win]
    bind HexEdit$win <Key> [list widget:hex:event:insert $win %A]
    bind HexEdit$win <BackSpace> [list widget:hex:event:backSpace $win]
  
    bind HexEditASCII$win <Button-1> [list widget:hex:ascii:event:Button-1 $win %x %y]
    bind HexEditASCII$win <B1-Motion> [bind Text <B1-Motion>]
    
    frame $win
    pack [scrollbar $win.scroll -command [list $win.hex yview]] -side left -fill y
    pack [text $win.offset -width 2 -height 6 -wrap none -fg $fg -bg $bg] -side left -fill y
    
    bindtags $win.offset all
    
    pack [text $win.hex -width 33 -height 6 -wrap none \
      -yscrollcommand [list widget:hex:updateYview $win] -fg $fg -bg $bg \
      -insertbackground $insertbackground] -side left -fill y
    pack [text $win.ascii -width 17 -height 6 -wrap none -fg $fg -bg $bg \
      -insertbackground $insertbackground] -side left -fill y
  
    bindtags $win.hex [list HexEdit$win all]
    bindtags $win.ascii [list HexEditASCII$win all]
  
    bind $win <Configure> {widget:hex:updateYview %W [%W.hex yview]}
    
    
    #The instance command
    rename $win _junk$win
  
    interp alias {} $win {} widget:hex:instanceCmd $win
    
    bind $win <Configure> "
      widget:hex:resizeColumns $win
      widget:hex:updateASCII $win
      widget:hex:updateOffset $win
    "
  
    return  $win
  }
  
  proc file:open {win inFile} {
    $win clear
    set fi [open $inFile r]
    fconfigure $fi -translation binary -encoding binary
    set data [read $fi]
    close $fi
  
    $win insert $data
  }
  
  proc file:save {win} {
  
    set f [tk_getSaveFile]
  
    if {"" == $f} {
      return
    }
    
    set data [$win get]
    
    set fo [open $f w]
    fconfigure $fo -translation binary -encoding binary
    puts -nonewline $fo $data
    close $fo
  }
  
  proc file:choose {win} {
    set f [tk_getOpenFile]
  
    if {"" == $f} {
      return
    }  
  
    file:open $win $f
  }
  
  proc main {argc argv} {
    #source bind.tcl
    #source cscrollbar.tcl
    pack [widget:hex .h] -fill both -side top -anchor w -expand 1
    .h config -bg black -fg cyan -insertbackground yellow
    pack [frame .f] -side bottom -fill x
    pack [button .f.b -text Save -command [list file:save .h]] -side left
    pack [button .f.load -text Load -command [list file:choose .h]] -side left
  }
  main $argc $argv
  
----

[kroc] 25/03/2004 - I've done a slightly modified starkit of this: http://www.kroc.tk/tclkit/TkHexedit.kit
  
----
Comments?

[TV] I don't dislike WM... It looks neat, I didn't try it out or really scan the code, but it allways appears to me that certain things in tcl ''should'' be possible in less code, like one command gives you a standard text processor ,not knowing wether that's reasonable to say about this as example.

[AM] I looked at the starkit - the problem I have is that the font is proportional. It makes viewing the file rather awkward! (This was on Windows XP)
----
[Category GUI]