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! :)
#!/bin/wish8.3
proc bind:copyClass {class newClass} {
set bindingList [bind $class]
#puts $bindingList
foreach binding $bindingList {
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 {}
}
}
proc hex:updateYview {win args} {
set pos [lindex $args 0]
set pos [lindex $args 0]
$win.hex yview moveto $pos
hex:resizeColumns $win
hex:updateASCII $win
hex:updateOffset $win
hex:updateOffset $win
eval $win.scroll set $args
}
proc hex:Button-1 {win x y} {
tkTextButton1 $win.ascii $x $y
tkTextButton1 $win.hex $x $y
$win.hex tag remove sel 0.0 end
$win.ascii 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 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 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]
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]
set line [binary format h* $line]
for {set i 0} {$i < $lineLength} {incr i} {
binary scan $line @${i}a1 ascii
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 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 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"]
#puts $lineend
set charEnd [lindex [split $lineend .] 1]
#puts $charEnd
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 hex:bind:backSpace {win} {
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 1 "hex:resizeColumns $win"
after 1 "hex:updateASCII $win"
after 1 "hex:updateOffset $win"
}
proc hex:bind:delete {win} {
$win.hex delete insert
$win.hex delete insert
after 1 "hex:resizeColumns $win"
after 1 "hex:updateASCII $win"
after 1 "hex:updateOffset $win"
}
proc hex:bind:insert {win char} {
if {[regexp {[0-9a-f]} $char]} {
$win.hex insert insert $char
$win.hex see insert
hex:resizeColumns $win
}
}
after 1 "hex:updateASCII $win"
after 1 "hex:updateOffset $win"
}
proc hex:file:save {win file} {
set data [$win.hex get 1.0 end-1c]
set data [string map {"\n" ""} $data]
set data [binary format h* $data]
file delete $file
set fo [open $file w]
fconfigure $fo -translation {binary binary} -encoding binary
puts -nonewline $fo $data
close $fo
}
proc hex:file:open {win file} {
set fi [open $file r]
fconfigure $fi -encoding binary -translation {binary binary}
set data [read $fi]
close $fi
close $fi
binary scan $data h* hex
set newHex ""
set charCount 0
for {set i 0} {$i < [string length $hex]} {incr i} {
incr charCount
append newHex [string index $hex $i]
if {$charCount == 32} {
append newHex \n
set charCount 0
}
}
}
$win.hex insert end $newHex
$win.hex insert end $newHex
hex:updateASCII $win
hex:updateOffset $win
}
proc hex:instanceCmd {win cmd args} {
#puts "instanceCmd $win $cmd $args"
#puts "instanceCmd $win $cmd $args"
if {[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
if {[info exists cmdArgs(-file)]} {
$win.hex delete 1.0 end
$win.ascii delete 1.0 end
hex:file:open $win $cmdArgs(-file)
unset cmdArgs(-file)
}
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)
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 hex:new {win args} {
if {[expr {[llength $args] & 1}] != 0} {
return -code error "Invalid number of arguments given to hex:new\(uneven number after window): $args"
}
array set cmdArgs $args
set bg royalblue
set fg black
set insertbackground black
set file ""
if {[info exists cmdArgs(-file)]} {
set file $cmdArgs(-file)
unset cmdArgs(-file)
}
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: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> "hex:Button-1 $win %x %y"
bind HexEdit$win <Delete> "hex:bind:delete $win"
bind HexEdit$win <Key> "hex:bind:insert $win %A"
bind HexEdit$win <BackSpace> "hex:bind:backSpace $win"
bind HexEditASCII$win <Button-1> "hex:Button-1 $win %x %y"
bind HexEditASCII$win <B1-Motion> [bind Text <B1-Motion>]
bind HexEditASCII$win <B1-Motion> [bind Text <B1-Motion>]
frame $win
pack [scrollbar $win.scroll -command "$win.hex yview"] -side left -fill y
pack [text $win.offset -width 2 -wrap none -fg $fg -bg $bg] -side left -fill y
pack [text $win.offset -width 2 -wrap none -fg $fg -bg $bg] -side left -fill y
bindtags $win.offset all
bindtags $win.offset all
pack [text $win.hex -width 33 -height 6 -wrap none \
-yscrollcommand "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] \
-side left -fill y
bindtags $win.hex "HexEdit$win all"
bindtags $win.ascii "HexEditASCII$win all"
#The instance command
rename $win _junk$win
proc $win {cmd args} "eval hex:instanceCmd $win \$cmd \$args"
bind $win <Configure> "
hex:resizeColumns $win
hex:updateASCII $win
hex:updateOffset $win
"
if {$file != ""} {
hex:file:open $win $file
}
return $win
}
proc file:save {win} {
set file [tk_getSaveFile]
if {$file != ""} {
hex:file:save $win $file
}
}
proc file:open {win} {
set file [tk_getOpenFile]
if {$file != ""} {
$win config -file $file -bg black -fg green -insertbackground yellow
}
}
proc main {argc argv} {
ain {argc argv} {
pack [hex:new .h] -fill both -side top -anchor w -expand 1
pack [frame .controls] -fill x -side bottom
pack [button .controls.save -text Save -command "file:save .h"] -side left
pack [button .controls.open -text Open -command "file:open .h"] -side left
}
main $argc $argvComments?
--- Category GUI