The code below is not mine, but it's a little hexadecimal editor. I don't remember who wrote it!!! I get the surprise to find my name here, I've not created this page, but if it exists... ---- [D. McC]: George Peter Staplin ([GPS]) wrote it, except I just changed the initial "pound-bang" line so it no longer reads "#!/bin/wish8.3". ---- #!/usr/bin/env wish package require Tk 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 [list widget:hex:event:Button-1 $win %x %y] bind HexEdit$win [list widget:hex:event:delete $win] bind HexEdit$win [list widget:hex:event:insert $win %A] bind HexEdit$win [list widget:hex:event:backSpace $win] bind HexEditASCII$win [list widget:hex:ascii:event:Button-1 $win %x %y] bind HexEditASCII$win [bind Text ] 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 {widget:hex:updateYview %W [%W.hex yview]} #The instance command rename $win _junk$win interp alias {} $win {} widget:hex:instanceCmd $win bind $win " 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 <> Person | Application