Version 6 of A Little Hex Editor Widget
Updated 2003-01-05 00:53:29GPS 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.
#!/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 $argvComments?