Hex Editor

SeS 12th Nov 2015

I present to you a simple Hex Editor. A poor man's IDE like tG² is not complete without one, so finally I got one created myself instead of relying on external tools for so many years.

Mind you, this is work in progress, possibly some bugs exist. I am also aware of redundant procedures, which are placeholders at the moment. Feel free to comment or add your remarks/improvements on the script and ofcourse feel free to use it in your applications while honoring the BSD license. here a screenshot of it's current state:

http://members.upc.nl/~s.serper/img/hexeditor.png

Things I like about this hex editor:

 - It can be easily instantiated as a layout object in [tG²]'s Layout Editor. 
   Wrapper will be made available in future versions as a [tG²]-plugin.
 - Dedicated namespace.
 - Simple & intuitive to control.
 - Instead of creating a tktable with thousands of equivalent cells to represent 
   the complete content of the file, I have tried to be creative by mapping the 
   filesegments on demand to visible cells of the table. Hence, I think this method
   consumes less memory and is probably faster to render by the tk-window managers.

Things to do and which will be (hopefully) available in tG² once the plugin wrapper is finished:

 - search for data patterns
 - insert/delete bytes (+ bindings for Insert & Delete keys)
 - bindings for Home, End, PageUp/Down keys to provide additional navigation methods
 - mark ASCII char of selected byte-cell (link between hex & ascii string)
 - undo/redo? (not sure yet...)
 - performance testing + bugfixing + benchmarking with various file sizes

To test it, please copy/paste the code section below into a file and source it.

KPV: I get an error on Linux due to the Window's only color: SystemDisabledText.

SeS: sorry for my late reply. I haven't tried it in Linux, so thanks for the feedback. I think a conditional selection for the color would be the simplest solution: 

if {[tk windowingsystem]=="win32"} {set color SystemDisabledText} {set color gray55}

I will adapt it in future releases, the plugin is now available in tG²'s latest version. Some of the objectives I set for this gadget are still in queue, haven't implemented undo yet and I am not satisfied with the performance of adding/deleting bytes in relative large files. But, good enough for a first release ;-)

# Copyright (C) 2015 by Sedat Serper, email : [email protected]
#
# The author  hereby grants permission to use,  copy, modify, distribute,
# and  license this  software  and its  documentation  for any  purpose,
# provided that  existing copyright notices  are retained in  all copies
# and that  this notice  is included verbatim  in any  distributions. No
# written agreement, license, or royalty  fee is required for any of the
# authorized uses.  Modifications to this software may be copyrighted by
# their authors and need not  follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO  EVENT SHALL THE AUTHOR  OR DISTRIBUTORS BE LIABLE  TO ANY PARTY
# FOR  DIRECT, INDIRECT, SPECIAL,  INCIDENTAL, OR  CONSEQUENTIAL DAMAGES
# ARISING OUT  OF THE  USE OF THIS  SOFTWARE, ITS DOCUMENTATION,  OR ANY
# DERIVATIVES  THEREOF, EVEN  IF THE  AUTHOR  HAVE BEEN  ADVISED OF  THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE  AUTHOR  AND DISTRIBUTORS  SPECIFICALLY  DISCLAIM ANY  WARRANTIES,
# INCLUDING,   BUT   NOT  LIMITED   TO,   THE   IMPLIED  WARRANTIES   OF
# MERCHANTABILITY,  FITNESS   FOR  A  PARTICULAR   PURPOSE,  AND
# NON-INFRINGEMENT.  THIS  SOFTWARE IS PROVIDED  ON AN "AS  IS" BASIS,
# AND  THE  AUTHOR  AND  DISTRIBUTORS  HAVE  NO  OBLIGATION  TO  PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

package require Tktable
package require Img
package require tile ;# not necessary for functionality, pure aesthetic reasons

set wrapper "binary_x.tcl"
set ::wrapLug($wrapper,version) "1.0"

# ------------------------------------------------------------------------------
# namespace
# ------------------------------------------------------------------------------
namespace eval ::Binary:: {
  image create photo ::Binary::downarrow -data {
  R0lGODlhDwAPAO4AAE1hhdvj+MnY/LnN+7vO/cLT/MLV/H2g1L7Q/J+10rnJ87rN/LzO+sjW+8XV
  /MXW/LzM88rZ/aC107LP+7PI9bbN+7jJ8rfN/LbO+8rY+a3J+b3O973T+9Th/Hyf09Dd/NDf/MrY
  /dHg/drm/s7b/bfK9c3b/L7R/LfT/LrU/LjL9rXJ87HG87HI87rM9LLI9K/F9LnL87rL9KzC9bPH
  9a7A1oKk1pSx2Yin2LHC1YOk036f0qi71KS4073L2rDF8rDE8rHF86rA87fG8c/X3ZSw3a7E5arA
  4cHV+8HT+8jY+8jV+8HS+7nO+6/O+7bR+7nP+7PR/M7d/cPV/eHq/tHe/cPT/c3a/MXT/Obu/Njj
  /LLN+8DQ97XI98TU98TS967I963D9rvN9bTI9rHH9r7Q+LXN+rHL+q/M+7zN+q7K+rfL+bDL+dzm
  +bvO+f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5
  BAEAAG8ALAAAAAAPAA8AAAfVgG9HNzg6BzseHgeLNkVvAQFDFgqUFhQULyxARjUBQmtNDAxuUBVb
  bBpgPxIBMwsITCcnHChPE2gaQQkBYQgFVgYGSCkoUU5qLbtkBQ8AD1MGKRMAE2cUu2MOANsOBhzb
  AGYruyUNDeBJ4BgVMawqAiEh4NsYFwMyrBsmVwIC4AP2BkDoEaDMBykRzAEgsGDAggUQeATw0kGE
  iX5LEBDYyABCjgAZRmipQiKCAAdYCiBI48JHABBURlT8UFLJgwIMFBB5kwVEhi9cNohRUaILDRht
  3gQCADs=
  }
  image create photo ::Binary::uparrow -data {
  R0lGODlhDwAPAO4AAE1hhdvj+MnY/LnN+7vO/cLT/MLV/H2g1L7Q/J+10rnJ87rN/LzO+sjW+8XV
  /MXW/LzM88rZ/aC107LP+7PI9bbN+7jJ8rfN/LbO+8rY+a3J+b3O973T+9Th/Hyf09Dd/NDf/MrY
  /dHg/drm/s7b/bfK9c3b/L7R/LfT/LrU/LjL9rXJ87HG87HI87rM9LLI9K/F9LnL87rL9KzC9bPH
  9a7A1oKk1pSx2Yin2LHC1YOk036f0qi71KS4073L2rDF8rDE8rHF86rA87fG8c/X3ZSw3a7E5arA
  4cHV+8HT+8jY+8jV+8HS+7nO+6/O+7bR+7nP+7PR/M7d/cPV/eHq/tHe/cPT/c3a/MXT/Obu/Njj
  /LLN+8DQ97XI98TU98TS967I963D9rvN9bTI9rHH9r7Q+LXN+rHL+q/M+7zN+q7K+rfL+bDL+dzm
  +bvO+f///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5
  BAEAAG8ALAAAAAAPAA8AAAfTgG9ZIBlfXBtiKiVdNDBtbwEgVCMdIh8kEUoPBQwKRAEZI1pVmAIO
  WAUIaS4+AV6VJgICSwgEtgwQOQFlH1IRDQ0ABAsDCwsQPAEbJleyAM8DFwMDED0BKgIhIc/cGNIy
  EgElwNxJ3RUx4WMO3A4GHNxmKwkBZAUPAA9TBikTABNnKNALg6CAFQMGkKRAEcWJmhb0ZixAwOTE
  CQ4onkxAoyEIPSFrmjBg4AZKhS1sNID5ES7AEAsKYlqgQOEFCyBGarw5cgOHjgM7PHg4QNRGkTeB
  AAA7
  }
  
  image create photo ::Binary::arrowMdwn -data {
  iVBORw0KGgoAAAANSUhEUgAAAA8AAAAYCAYAAAFSApf/AAAABGdBTUEAAK/INwWK6QAAABl0RVh0
  U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVcSURBVHjaYrh27drnHz9+MAAEEMuZM2cY
  2NjYEgECiOXZs2e8ra2t/wECiOHbt28Mt27d+g8QQEzfv3//t2fPHgaAAGJ+/fp1g4yMTChAADF+
  /PhR9caNG7eYmZkZ1NXVdQECiPnly5cPOTk52R4+fMgwZ86cLIAAYvj//7/e5s2bGbKzs5m+fPli
  ARBADD9//lwOMhFomRDQQA2AAGI4e/bs//fv3886derUf6AkA0AAsRw7dozh79+/q4ECqSwsLLEA
  AcT0798/hpMnT+6SlZVl2L17dw1AADHx8fExvHnzhuHp06cMmZmZxwACiOnSpUsN5ubmEcePH09j
  YmJKBAggxvPnz3/+9esXj7a29nKg46I+ffok9fjx46dAcxnk5eU7AQKI6fr16wyampoMN2/ejATq
  /g/07VMREZHMO3fugJy2FSAAACEA3v8CISEhoLS0tADDw8MAFhYWvMTExAC3t7eXJSUlpx4eHtYC
  iAVovNOuXbsYLCwsGF68eJEKlLizYsUKZqCTtYHWvAUIIGag178CnR6vp6fnA5Ro+/PnDxMw5LiB
  rp8PdE8/QAAxAhUwbNy4kQHo4qIdO3b0MTAwlE+ZMuUgkD4BxAwAAcT45MmT/6KioowgVwMVgcQY
  gEF+gYuL6xtAALGAPA8MyP/AUGEBCgLV/D0H9KI+0LEfAQKIBejH+48ePVIE6voD1HTg3bt3hkBX
  P+Hh4ZEFCCAmYCgpKisrM7x9+xaEHYSFhR8BI/gr0LrzAAHEBDSCYf/+/QxA7ySxsrK63r179wcw
  gNSBMcsFEECMQIn/V65cYZCWlmYASl578OCBlomJCQPQi6EAAcQMtKchOjqaAaia4cOHD6JWVlYM
  06dPB5kWBhBATEDVDN3d3QwxMTEPTE1NXaZOncoASjWxsbFiAAHE2NHR0QZMMZW/f/9mAAYfKPYZ
  vL291wkJCVkBBBCzpKTkXqBjPgFDyx2YghiArt0BTDh+z58/TwMIIKaUlJSPQJf129nZ6QPTHSNQ
  0BMY52/S09PVAQKIBSjID0xZ6UCdM0FhDbTrr4uLC8ihDAABxAhMXZ+BocPDz8/PALRiNZAdDRT/
  DZIEOQwKJIAxtQPoTX2QAcB8wQAM++sAAcQItPLF/fv3xRkZGRlAWEBAABQmi4HuigNqEgLGy25g
  ijKCyQOj/CvQIi+g3CGAAGI8ceJEFTB1+QJNswAGOwOSIgagAaAcArYaGFcvgbgVGBpq4uLi94Ah
  sxQggBgnT578GZioeIAGMDg6OoIzJyglABMX2BCgV+4DDW4HxlIVECuAxEBeBAbOLYAAYgTGzD6g
  7Y4gW0D+UVJSYrC2tt4LDHdvYBKSA8b9nqtXr8qB0hoIAzPIcWCqcQY65jtAADG2tLR8BvqTB6iB
  4dy5cwyguADFKtCJDF+/fgW7ABRwxsbGDMDwYQCWKAzOzs5ngDZnAgQQy+fPnxlAWQtUuoDSBVCC
  4fLly/9fvXr1H2SIvb09EzD5gdMLyMkg24EJWQqIbQACCJQN5IGmbV+9erUmyBZQ8gBqYHBzc1t7
  9OhRBWDeMQZpAtluYGDAICEhsdzDw2MR0OZjAAHEGB8fDwoUUIAuBxZREUD/g0MZZgs7Ozu4IACm
  nK3AzOBvaGj4F6g2GliccAAEEOO+ffu+Llq0qB4o0ANK2kCgDUza04BOrhcUFGxav379fyDfS0dH
  5ysosfj5+RUAY2QLkH0EIIDA2RsIDNeuXRsEjKLXQPYkUIiDnAksD2ApLA2oqRtYiLgB2SdhggAB
  xAjMowxIgBfo1Hqgxl6gX58D+RzA+D8aFBS0FciuY0ADAAEGABGVa+1QCoL8AAAAAElFTkSuQmCC
  }
  
  image create photo ::Binary::arrowMup -data {
  iVBORw0KGgoAAAANSUhEUgAAAA8AAAAYCAYAAAFSApf/AAAABGdBTUEAAK/INwWK6QAAABl0RVh0
  U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVFSURBVHjaYv7+/TsDJycnA0AAMfz9+5fv
  8ePHawACiFlXV/cSMzOzLUAAMYCkjh8/zgAQQCy5ubn/GRkZGQACiHHfvn33v3z5ogAQQMwXLlxg
  UFFRYcjKynLg4OB4ABBAjFeuXDH5+vXr6Zs3bzIADWAACCAmYWHhMwxA4OXlxfjr1y8GgABiBJm2
  bt26s0Bt+//9+1cCEEBMQMs6Tp8+/eXTp0/zgZJfAQKI6dKlS3IfPnywW7x48RU1NTUtgABi7Ojo
  +M/Nzc0AVM7w+fPnLwABxALiBAYG3mdlZVVctWoVA0AAMd64ceMLFxfXzR8/fhjx8/O/BAggxidP
  noBsZThx4sTHTZs28UdERDDcvn2bQVpaujk4OLgWIIAYz549m3zy5Mm5jx492gK0zBvkLKAPGAQF
  BVc8f/48EiCAmIAEL1DR/xcvXngDvcdgZGT0DxgADEB+hISExGeAAGK8c+cOA1D3satXr1pqamo+
  0tHRUTt16tSP+/fvMzg6Ou4HCCAWWVlZMSYmprPi4uJKwNCS+/jx4w+gTgZbW1sGYPjsAQggxlu3
  bl0D2q2pqKh4kY+PzwAY9CA3sz59+vTX+/fvvwAEEDisoKCpt7e3zcPDQ/D3799fgPzPAAHE9Pbt
  WwYgNk9PT38CNOkH0MHPgfYnWlhYGAIEEMubN29s9uzZcwdo/5XExMRDr169+q+lpWUPZJcABBDL
  sWPH5IEOOG5oaPhnwYIFoCgHufg/0HGMAAHEEhcX9xYY0H+Afmdwd3c/C4xN40OHDjFERkZeAwgg
  ZmCkHQQGKW9oaCgD0DoJoKsZxMTEGLdt2yYKEECMwEg8DRQ0AYU9KJn8//+fgZ2dHZx+AAKICRiu
  dsCYZgA6n8HJyUktPDx8LzAuGdjY2BgAAogJ6KBvIEcA7UgDJoNbDx8+dE5OTgbrBAggRqADCoHe
  +QMM+Ekg40AmgFKCgoLCCYAAYgKqPvvy5ctJILtkZGSEgX5cDLIbGAkWAAHECEyd/0Gq9fT0JIFB
  9gJkBVDnKmBqCQUIIEaQEWjAAhhiRzds2FAFZHeCBIDhDaKKgGq/AumZ/v7+YIUAAcTy7ds3uKaD
  Bw9uWbFiRSWQzQwMDyaQoLe3dzjQtutAZh9QHiRUDwyBIjs7O1uAAGKcNWvWVKDXXYAKjIESX4B5
  hgsY9GuBCjxAaRTkTGCgMhgbG19+8ODBfGACmwtU9wkYl/EAAcQIyiVAf3kABXMlJSUjnz17FnT+
  /HmGP3/+gAMbmNgYgOkHbAgoPZuZmTEAA6gdaEAVQAAxgnIxEIgCbdwDTPx6IE1AUxnCwsL+CggI
  uAND8a6Ghsb+lStXKoDUgkKShYWFITY29hpAADF2dnbeBEaMGsjvIImAgABQkDMADWKAplwwAGVO
  kK179+5lOHfuHMiCLwABBAptYWBsOgKdHQRUHAkqOEC2gwAwIq8BM88zoDdcgBmKAVjoMACLDQag
  90BemAIQQIxAU2KB/q65du2aGsgmkO3AguGWkpJSB1D8MdAgRmDKlAE6f+7+/fsZgYkQnPiAXvoC
  EEAsQkJCD4AF2zdQoACde1NeXn4C0JBKoMZ5oMQBAqBQB/kTmAkYgGUK2OmgtAcQQIw/f/5kAJVa
  QKADzMLbgSlYBsQBBRrQ9ANAZ94G5sFUUF4EuQrkdGARcx9ooTtAADECE2wH0JQMYN7jB2kCSUpJ
  SZ0H0j5A7jNQ5gEJA12zGBiNkcAsD3YNMEt8AQggUNbXAPprHtAvlsAS7SIQOwHl3sFCGTn5ggwG
  guWvX7+OAHrrC0CAAQDv+57Ct6IkSwAAAABJRU5ErkJggg==
  }

  # return text in binary (1 byte)
  proc ::Binary::Byte {v} {
    return [binary format c1 $v]
  }

  # return text in binary (2 bytes)
  proc ::Binary::Word {v} {
    return [binary format s1 $v]
  }

  # return text in binary (4 bytes)
  proc ::Binary::Dword {v} {
    return [binary format i1 $v]
  }

  # return text in Hex-byte (1 byte)
  proc ::Binary::Hbyte {v} {
    return [binary format H2 $v]
  }

  # return text in Hex-binary (2 bytes)
  proc ::Binary::Hword {v} {
    return [binary format H4 $v]
  }
  
  # returns bits in binary
  proc ::Binary::Bits {value} {
    append cb $value
    while {[string length $cb] >= 8} {
      set bits  [string range $cb 0 7]
      set cb [string range $cb 8 end]
      append txt [binary format B8 $bits]
    }
    return $txt
  }

  # save file in binary format
  proc ::Binary::writeFile {file d} {
    set p [open $file w]
    fconfigure $p -translation binary
    puts -nonewline $p $d
    close $p
  }
  
  # save file in binary format
  proc ::Binary::readFile {file} {
    set f [open $file r]
    fconfigure $f -translation binary
    while {[set r [read $f 2]]!=""} {
      binary scan $r H4 b
      if {![info exists b]} {set b [format %x [toASCII $r]]}
          append d "$b "
          unset b
    }
    close $f
    return $d
  }
  
  # --------------------------------------------------------
  # removes all cell values of table
  proc ::Binary::clearTable {} {
    variable cfg
    set i 1
    while {$i < [$cfg(editor).e cget -rows]} {
      set j 1
      while {$j < ($cfg(lastCol)-1)} {set ::Binary::val($i,$j) ""; incr j}
      incr i
    }
  }

  # --------------------------------------------------------
  # converts data of file into 1Byte hex format for all cells in given row
  proc ::Binary::toString {row} {
    variable cfg
    set tmp ""; set c 1
    while {$c < $cfg(lastCol)} {
      if {"$::Binary::val($row,$c)"==""} {set tmp "${tmp} "} {
        if {([format %u 0x$::Binary::val($row,$c)]>13) && ([format %u 0x$::Binary::val($row,$c)]<126)} {
          set tmp "$tmp[toChar [format %u 0x$::Binary::val($row,$c)]]"
        } {set tmp "${tmp}."}
      }
      incr c
    }
    return $tmp
  }
  
  # --------------------------------------------------------
  # the ascii equivalent into last row is compiled and written out
  proc ::Binary::toReadableText {{row ""}} {
    variable cfg
    if {$row!=""} { 
      set ::Binary::val($row,$cfg(lastCol)) [::Binary::toString $row]
    } {
      ser r 1
      while {$r<[$cfg(editor).e cget -rows]} {
        set ::Binary::val($row,$cfg(lastCol)) [::Binary::toString $r]
        incr r
      }
    }
  }
  
  # --------------------------------------------------------
  # this proc performs the actual displaying of the values into table
  proc ::Binary::displaySelBlock {{dir ""} {reload 0}} {
    variable cfg

    set z [expr $cfg(startCell)]
    if {$dir!=""} {if {[expr $z + 8*$dir]>=0} {set z [expr $z + 8*$dir]}}
    if {($cfg(startCell)==$z) && [info exists ::Binary::val(1,1)] && !$reload && !$::Binary::cfg(update)} {return}
    set cfg(startCell) $z
    
    update ;# otherwise blckCnt sets to 1
    set nrRows [$cfg(editor).e cget -rows]
    set blckCnt [expr ($nrRows-1) * 8]
    set tmp [lindex $cfg(data) end]
    switch [string length $tmp] {
      "1" - "3" {set tmp "${tmp}0"}
      default {set tmp ""} 
    }
    if {$tmp!=""} {set cfg(data) [lreplace $cfg(data) end end $tmp]}
    set cfg(data) [string toupper $cfg(data)] 
    ::Binary::clearTable
    set i 1
    foreach word $cfg(data) {
      set j 0
      while {$j < ($cfg(lastCol)-2)} {
        set ::Binary::val($i,[expr $j+1]) [string range [lindex $cfg(data) $z] 0 1]
        set ::Binary::val($i,[expr $j+2]) [string range [lindex $cfg(data) $z] 2 3]
        incr z
        incr j 2
      }

      ::Binary::writeAdress $i $z
      ::Binary::toReadableText $i
      incr i
      if {$i>=$nrRows} {break}
    }

    if {$i<$nrRows} {
      #cleanup unused space
      
    }
  }
  
  # --------------------------------------------------------
  # writes address into column 0 according to latest pointer
  proc ::Binary::writeAdress {r v} {
    variable cfg
    set v [format %x [expr 2*$v-16]]
    while {[string length $v]<[string length $cfg(maxAddr)]} {set v "0$v"}
    set ::Binary::val($r,0) [string toupper $v]
  }
  
  # --------------------------------------------------------
  # set bindings to custom laebls to perform as buttons
  proc ::Binary::setBindings {} {
    variable cfg
    
    foreach w {up0 up1} {
      bind $cfg(editor).ctrls.scroll.$w <ButtonPress-1>   {::Binary::scroll -1 %W}
      bind $cfg(editor).ctrls.scroll.$w <ButtonRelease-1> {::Binary::unpress %W}
      bind $cfg(editor).ctrls.scroll.$w <Leave>           {::Binary::unpress %W}
    }
    
    foreach w {dw0 dw1} {
      bind $cfg(editor).ctrls.scroll.$w <ButtonPress-1>   {::Binary::scroll  1 %W} 
      bind $cfg(editor).ctrls.scroll.$w <ButtonRelease-1> {::Binary::unpress %W}
      bind $cfg(editor).ctrls.scroll.$w <Leave>           {::Binary::unpress %W}
    }
    
    bind $cfg(editor).e <ButtonRelease-1> {::Binary::selAddress}
    foreach w "$cfg(editor).ctrls.butts.ca.e1 $cfg(editor).ctrls.butts.ca.fr1.e $cfg(editor).ctrls.butts.ca.fr2.e" {
      bind $w <FocusIn> {focus -force $::Binary::cfg(parent)}
    }
    
    bind $cfg(parent) <Configure> {+;
      set ::Binary::cfg(update) 1 
    }
    
    bind $cfg(editor).e <Motion> {+;
      if {$::Binary::cfg(update)} {::Binary::displaySelBlock; set ::Binary::cfg(update) 0} {
        set pntr [$::Binary::cfg(editor).e index @%x,%y]
        if {$::Binary::cfg(currCell) != $pntr} {
          if {[string length $::Binary::val($::Binary::cfg(currCell))]==1} {
            set ::Binary::val($::Binary::cfg(currCell)) "0$::Binary::val($::Binary::cfg(currCell))"
            ::Binary::updateBuffer
          }
        }
      }
    }
    
    bind $cfg(editor).ctrls.butts.gt.e <FocusIn> {
      $::Binary::cfg(editor).ctrls.butts.gt.e selection range 0 end
    }
    
    bind $cfg(editor).ctrls.butts.gt.e <KeyPress> {if {"%k"=="13"} {::Binary::goto}}
    
    bind Table <MouseWheel> {+; ::Binary::wheel %D}
    
    bind $cfg(editor).e <KeyPress>        {if {("%k"=="86") && ("%K"=="v")} {break}} ;# overrule paster functionality
   
    wm protocol [winfo toplevel $cfg(parent)] WM_DELETE_WINDOW "[wm protocol [winfo toplevel $cfg(parent)] WM_DELETE_WINDOW]; ::Binary::exitHandle"
  }

  # --------------------------------------------------------
  # governs the mouse wheel functionality
  proc ::Binary::wheel {D} {
    variable cfg
    $cfg(editor).e selection clear all
    if {$D<0} {
      set w $cfg(editor).ctrls.scroll.dw1
      ::Binary::scroll 1 $w 1
      $w config -relief raised
    } {
      set w $cfg(editor).ctrls.scroll.up1
      ::Binary::scroll -1 $w 1
      $w config -relief raised
    }
  }
  
  # --------------------------------------------------------
  # to scroll the table in direction 'dir'
  proc ::Binary::scroll {dir w {once 0}} {
    variable cfg
    if {([file extension $w]==".dw1") || ([file extension $w]==".up1")} {set dir [expr $dir * ([$cfg(editor).e cget -rows]-1)]}
    if {([expr $cfg(startCell) + 8*$dir]>0) || (([expr $cfg(startCell) + 8*$dir]==0) && ($::Binary::val(1,0)!=$cfg(startAddr)))} {
      if {!$once} {$w config -relief sunken}
      set ::Binary::cfg(bpress) 1
      ::Binary::displaySelBlock $dir
      ::Binary::selAddress
      if {!$once} {
        after 100
        update
        while {$::Binary::cfg(bpress)} {::Binary::displaySelBlock $dir; ::Binary::selAddress; after $cfg(delay); update; incr cfg(delay) -1; if {$cfg(delay)<0} {set cfg(delay) 0}}
      }
      set ::Binary::cfg(bpress) 0
    }
  }

  # --------------------------------------------------------
  # restores relief of labels
  proc ::Binary::unpress {w} {
    variable cfg
    set ::Binary::cfg(bpress) 0
    $w config -relief raised
    set cfg(delay) 50
  }
  
  # --------------------------------------------------------
  # shows details on active cell
  proc ::Binary::selAddress {} {
    variable cfg
    if {[info exists ::tk::table::Priv(tablePrev)] && ($::tk::table::Priv(tablePrev)!="")} {
      if {[catch {set val $::Binary::val($::tk::table::Priv(tablePrev))}]} {return}
      if {$val==""} {return}
      set cfg(currCell) $::tk::table::Priv(tablePrev)
      set i [split $::tk::table::Priv(tablePrev) ,]
      set MSB [string trimleft $::Binary::val([lindex $i 0],0) 0]
      set LSB [lindex $i 1]
      if {$LSB>=$cfg(lastCol)} {return}
      if {$MSB==""} {set MSB 0}
      set addr [expr [format %u 0x$MSB] + $LSB - 1]
      set ::Binary::cfg(addr) $addr
      set ::Binary::cfg(8b) [format %u 0x$val]
      
      if {[expr [lindex $i 1]+1]>16} {
        set 16b_LSB 1
        set 16b_MSB [expr [lindex $i 0]+1]
      } {
        set 16b_LSB [expr [lindex $i 1]+1]
        set 16b_MSB [expr [lindex $i 0]]
      }
      set ::Binary::cfg(16b) ""
      if {[catch {
        if {$::Binary::val($16b_MSB,$16b_LSB)!=""} {
          set ::Binary::cfg(16b) [format %u 0x$val$::Binary::val($16b_MSB,$16b_LSB)]
      }}]} {
        set ::Binary::cfg(16b) $::Binary::cfg(8b)
      }
        
    }
    return
  }
  
  # --------------------------------------------------------
  # load file
  proc ::Binary::load {f} {
    variable cfg
    if {$cfg(dbChanged)} {
      set ret [::Binary::saveChanges]
      if {$ret=="yes"} {::Binary::save2file}
      if {$ret=="cancel"} {return}
    }
    $cfg(parent) configure -cursor watch; update
      
    if {[file exists $f]} {
      if {[file size $f]>[format %u 0x$cfg(maxAddr)]} {
        $cfg(parent) configure -cursor ""
        tk_messageBox -parent $cfg(parent) -message "WARNING: filesize exceeds limit." -title "file not loaded" -icon warning -type ok
        return
      }
      set cfg(file) $f
      set st normal
      set cfg(data) [::Binary::readFile $cfg(file)]
      $cfg(editor).ctrls.butts.fn configure -text "file: [file tail $cfg(file)]"
      if {[catch {set s [file size $cfg(file)]}]} {set s 0}
    } {
      tk_messageBox -parent $cfg(parent) -message "WARNING: file [file tail $cfg(file)] not found?" -title "file not loaded" -icon warning -type ok
      set st disabled
      set s 0
      $cfg(editor).ctrls.butts.fn configure -text "<untitled>"
    }
    $cfg(editor).ctrls.butts.b0 configure -state $st
    $cfg(editor).ctrls.butts.fs.s configure -text $s
    set cfg(startCell) 0
    set cfg(dbChanged) 0
    ::Binary::displaySelBlock "" 1
    $cfg(editor).e activate 1,1
    $cfg(editor).e selection clear all
    set ::tk::table::Priv(tablePrev) 1,1
    ::Binary::selAddress
    $cfg(parent) configure -cursor ""
  }

  
  # --------------------------------------------------------
  # updates data buffer
  proc ::Binary::updateBuffer {} {
    variable cfg
    if {[info exists ::tk::table::Priv(tablePrev)] && ($::tk::table::Priv(tablePrev)!="")} {
      if {[catch {set val $::Binary::val($::tk::table::Priv(tablePrev))}]} {return 0}
      if {[string length $val]<2} {return 0}
      set cfg(dbChanged) 1
      set addr [expr $::Binary::cfg(addr) / 2]
      
      set LSB [expr [lindex [split $::tk::table::Priv(tablePrev) ,] 1] - 1]
      if {[lindex [split [expr $LSB/2.0] .] end]==0} {
        set unchanged [string range [lindex $cfg(data) $addr] 2 3]
        set cfg(data) [lreplace $cfg(data) $addr $addr $::Binary::val($::tk::table::Priv(tablePrev))$unchanged]
      } {
        set unchanged [string range [lindex $cfg(data) $addr] 0 1]
        set cfg(data) [lreplace $cfg(data) $addr $addr $unchanged$::Binary::val($::tk::table::Priv(tablePrev))]
      }
      ::Binary::toReadableText [lindex [split $::tk::table::Priv(tablePrev) ,] 0]
    }
    return 0
  }

  # --------------------------------------------------------
  # checks if change occured before exit
  proc ::Binary::save2file {} {
    variable cfg
    $cfg(parent) configure -cursor watch; update
    foreach d $cfg(data) {append o [::Binary::Hword $d]}
    
    if {[string length [lindex $cfg(data) end]]==2} {
      set o [string range $o 0 end-2]
      append o [::Binary::Hbyte [lindex $cfg(data) end]]
    }
    
    if {[catch {::Binary::writeFile $cfg(file) $o}]} {
      $cfg(parent) configure -cursor ""
      tk_messageBox -parent $cfg(parent) -message "ERROR: failed to write to file?" -title "Failed to write to file" -icon error -type ok
      return 0
    }
    unset o
    set cfg(dbChanged) 0
    $cfg(parent) configure -cursor ""
    return 1
  }
  
  # --------------------------------------------------------
  # save before reload/exit
  proc ::Binary::saveChanges {} {
    variable cfg
    return [tk_messageBox -parent $cfg(parent) -message "Would you like to save the changes?" -title "Changes to db detected" -icon question -type yesnocancel]
  }
  
  # --------------------------------------------------------
  # checks if change occured before exit
  proc ::Binary::exitHandle {} {
    variable cfg
    if {$cfg(dbChanged)} {
      set ret [::Binary::saveChanges] 
      if {"$ret"=="yes"} {
        if {![::Binary::save2file]} {
          return
        } {
          unset cfg(data)
          destroy $cfg(parent)
        }
      }
      if {"$ret"=="cancel"} {return}
    }
    catch {unset cfg(data)}
    destroy $cfg(parent)
  }

  # --------------------------------------------------------
  # checks cellinput for validity
  proc ::Binary::checkVal {S s} {
    variable cfg
    
    if {"$s"==""} {set ::Binary::val($::tk::table::Priv(tablePrev)) ""; return 0} ;# adding new bytes disabled
    
    if {$S==""} {set ::Binary::val($::tk::table::Priv(tablePrev)) 00; return [::Binary::updateBuffer]}
    if {[catch {set x [format %u 0x$S]}]} {return 0}
    
    if {[string length $S]>2} {
      set n [string range $S end end]
      foreach c [split $S ""] {
        if {[lsearch [split $s ""] $c]<0} {set n $c; break}
      }
      set ::Binary::val($::tk::table::Priv(tablePrev)) [string toupper $n]
      return [::Binary::updateBuffer]
    }
    
    set ::Binary::val($::tk::table::Priv(tablePrev)) [string toupper $S]
    return [::Binary::updateBuffer]
  }
  
  # --------------------------------------------------------
  # checks cellinput for validity
  proc ::Binary::goto {} {
    variable cfg

    if {[string trim $cfg(goto)]==""} {return}
    $cfg(editor).e selection clear all
    set tstart [format %u 0x[string range $::Binary::val(1,0) 0 end-1]]
    if {[string trim $cfg(goto)]=="end"} {
      set end [expr [llength $::Binary::cfg(data)]*2]
      set row  [format %x [expr $end - 2]]
      set cell [expr [format %u 0x[string range $end end end]] - 1]
      set end [format %u 0x[string range [format %x $end] 0 end-1]]
      ::Binary::displaySelBlock [expr $end - $tstart - [$cfg(editor).e cget -rows] + 2]
      
      set i 1
      while {($i<[$cfg(editor).e cget -rows]) && ([string trimleft $::Binary::val($i,0) 0]!=$row)} {incr i}
      $cfg(editor).e activate $i,$cell
      set ::tk::table::Priv(tablePrev) $i,$cell
      ::Binary::selAddress
    } {
      if {[isInteger $cfg(goto)]} {
        if {[string first "0x" $cfg(goto)]<0} {set end 0x[format %x $cfg(goto)]} {set end $cfg(goto)}
        if {[string length $end]<4} {set end 0x00}
        ::Binary::displaySelBlock [expr [format %u [string range $end 0 end-1]] - $tstart]
        set cell [expr [format %u 0x[string range $end end end]] + 1]
        $cfg(editor).e activate 1,$cell
        set ::tk::table::Priv(tablePrev) 1,$cell
        ::Binary::selAddress
      } {
        tk_messageBox -parent $cfg(parent) -message "Invalid entry\n\nShould be an integer or 0x<n> where\n<n> should be a hex address." -title "Invalid address" -icon info -type ok
      }
    }
    focus -force $cfg(editor).e
  }
  
  # --------------------------------------------------------
  # the editor interface
  proc ::Binary::hexEdit {file {tParent ""} {maxAddr "FFFFFF"}} {
    variable cfg
    
    set cfg(file) $file
    set cfg(update) 0
    if {[package provide tile]==""} {set tl ""} {set tl "::ttk::"}
    if {($tParent=="") || ($tParent==".")} {
      set cfg(parent) .; set cfg(editor) .hexedit
    } {
      set cfg(parent) $tParent; set cfg(editor) $cfg(parent).hexedit
      if {![winfo exists $cfg(parent)]} {puts "parent $cfg(parent) does not exists!"; return}
    }
    
    if {[winfo exists $cfg(editor)]} {raise $cfg(parent); focus -force $cfg(parent); return}
    set cfg(data) "" ;# this holds the actual hex data of the file
    set cfg(selBlock)  0
    set cfg(startCell) 0
    set cfg(startAddr) "000000"
    set cfg(maxAddr)   $maxAddr
    set cfg(dbChanged) 0
    set cfg(currCell)  1,1
    
    pack [${tl}labelframe $cfg(editor) -text "Hex Editor v$::wrapLug($::wrapper,version)"] -expand 1 -fill both -side left
    
    catch {unset ::Binary::val}
    array set ::Binary::t {
      rows        15
      cols        18
      array        ::Binary::val
    }
    set cfg(lastCol) [expr $::Binary::t(cols)-1]
    table $cfg(editor).e \
      -rows $::Binary::t(rows) \
      -cols $::Binary::t(cols) \
      -variable $::Binary::t(array) \
      -width 20 \
      -maxwidth 560 \
      -height 120 \
      -font {arial 10} \
      -titlerows 1 \
      -titlecols 1 \
      -selectmode single \
      -selecttitles 0 \
      -colstretchmode none \
      -rowstretchmode fill \
      -resizeborders none \
      -colwidth 3 \
      -drawmode fast \
      -relief flat \
      -bg white \
      -validate 1 \
      -validatecommand {::Binary::checkVal %S %s} \
      -rowseparator "\n" \
      -colseparator "\n"
    pack $cfg(editor).e -side left -fill both -expand 1
    $cfg(editor).e tag configure sel -fg blue
    $cfg(editor).e tag configure title -bg gray80 -fg gray40 -font {arial 10 bold}
    $cfg(editor).e tag configure active -bg darkblue -fg white
    $cfg(editor).e width 0 10
    $cfg(editor).e width $cfg(lastCol) 20
    set ::Binary::val(0,0) Address
    set ::Binary::val(0,$cfg(lastCol)) "ASCII equivalent"
    set j 1; foreach i {0 1 2 3 4 5 6 7 8 9 A B C D E F} {set ::Binary::val(0,$j) $i; incr j}

    $cfg(editor).e tag coltag ascii $cfg(lastCol)
    $cfg(editor).e tag configure ascii -fg gray60 -justify left -font {{courier new} 9}
    
    pack [frame $cfg(editor).ctrls] -side right -fill both -expand 1
    
    pack [frame $cfg(editor).ctrls.scroll -bg SystemDisabledText] -side left -expand 0 -fill y
    pack [label $cfg(editor).ctrls.scroll.up0 -relief raised -width 12 -height 10 -image ::Binary::uparrow] -side top -anchor n
    pack [label $cfg(editor).ctrls.scroll.up1 -relief raised -width 12 -height 110 -image ::Binary::arrowMup] -side top -anchor n
    pack [label $cfg(editor).ctrls.scroll.dw0 -relief raised -width 12 -height 10 -image ::Binary::downarrow] -side bottom -anchor s
    pack [label $cfg(editor).ctrls.scroll.dw1 -relief raised -width 12 -height 110 -image ::Binary::arrowMdwn] -side bottom -anchor s 
    
    pack [frame $cfg(editor).ctrls.butts] -side right -expand 1 -fill both
    pack [${tl}label $cfg(editor).ctrls.butts.fn -justify center] -side top -fill x -expand 0 -anchor center -pady 2 -padx 2
    if {[file exists $cfg(file)]} {
      set st normal
      set cfg(data) [::Binary::readFile $cfg(file)]
      $cfg(editor).ctrls.butts.fn configure -text "file: [file tail $cfg(file)]"
    } {
      set st disabled
      $cfg(editor).ctrls.butts.fn configure -text "<untitled>"
    }
    
    pack [${tl}labelframe $cfg(editor).ctrls.butts.fs -text "File size (bytes)"] -side top -fill x -anchor n -pady 2 -padx 2
    if {[catch {set s [file size $cfg(file)]}]} {set s 0}
    pack [${tl}label $cfg(editor).ctrls.butts.fs.s -text $s] -side right -fill x -anchor n -pady 2

    pack [${tl}button $cfg(editor).ctrls.butts.b0 -text {Reload file} -command {::Binary::load $::Binary::cfg(file)} -state $st] -side top -fill x -expand 0 -anchor n -pady 2 -padx 2
    pack [${tl}button $cfg(editor).ctrls.butts.b1 -text {Save file} -command {::Binary::save2file}] -side top -fill x -anchor n -pady 2 -padx 2
    
    pack [${tl}labelframe $cfg(editor).ctrls.butts.ca -text "Selected Address (dec)"] -side top -fill x -anchor n -pady 2 -padx 2
    pack [${tl}entry $cfg(editor).ctrls.butts.ca.e1 -justify right -width 10 -textvariable ::Binary::cfg(addr)] -side top -fill x -anchor n -pady 2 -padx 2
    
    foreach i {{1 8} {2 16}} {
      pack [frame $cfg(editor).ctrls.butts.ca.fr[lindex $i 0] -width 12] -side top -fill x -anchor n -pady 2 -padx 2
      pack [${tl}label $cfg(editor).ctrls.butts.ca.fr[lindex $i 0].l -text "value ([lindex $i 1]bit)"] -side left -fill x -anchor n -pady 2
      pack [${tl}entry $cfg(editor).ctrls.butts.ca.fr[lindex $i 0].e -justify right -width 12 -textvariable ::Binary::cfg([lindex $i 1]b)] -side right -fill x -anchor n -pady 2
    }
    
    pack [${tl}labelframe $cfg(editor).ctrls.butts.gt -text "Go to..."] -side bottom -fill x -anchor n -pady 2 -padx 2
    pack [${tl}button $cfg(editor).ctrls.butts.gt.b1 -width 2 -text Go -command {::Binary::goto}] -side left -fill x -anchor n -pady 2 -padx 2
    pack [${tl}entry $cfg(editor).ctrls.butts.gt.e -justify right -width 20 -textvariable ::Binary::cfg(goto)] -side right -expand 1 -fill x -anchor n -pady 2
    set ::Binary::cfg(goto) end
    
    ::Binary::setBindings
    ::Binary::displaySelBlock
    $cfg(editor).e activate 1,1
    set ::tk::table::Priv(tablePrev) 1,1
    ::Binary::selAddress
    focus -force $cfg(editor).e
  }
  
} ;# namespace

# ------------------------------------------------------------------------------
# from tG2's generic_tcl.tcl:
proc luniq {L} {
  set t {}
  foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}}
  return $t
}
proc toASCII {char} {scan $char %c value; return $value}
proc toChar {value} {return [format %c $value]}
proc isInteger {theString} {string is integer -strict $theString}


# ------------------------------------------------------------------------------
# tested on a wish.exe v8.4.19, Windows 10
# ------------------------------------------------------------------------------
set file2edit [file dirname [info script]]/_dummy_.txt
catch {file copy [info script] $file2edit} 
::Binary::hexEdit $file2edit
Category GUICategory Widget
Updated 2015-12-09 15:15:11