API tools faq
paste
Guest User

Wish Binary Viewer

a guest
Apr 8th, 2020
5,440
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 36.93 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/env wish
  2.  
  3. # WISH Binary Viewer 2009
  4. # (the second public release of WISH Binary Viewer)
  5. # by David McClamrock <[email protected]>
  6. # Inspired by "A Little Hex Editor Widget" by George Peter Staplin
  7.  
  8. # Copyright © 2008 David H. McClamrock
  9. # Freely available under Maximum Use License for Everyone
  10. # You should have received a copy of this license with this program.
  11. # If you didn't, e-mail the author to get one.
  12.  
  13.  
  14. ##################################
  15.  
  16.  
  17. ### INITIALIZATION ###
  18.  
  19.  
  20. # WISH applications require at least Tcl and Tk 8.5:
  21.  
  22. set tclo [package vcompare [package require Tcl] 8.5]
  23. set tko [package vcompare [package require Tk] 8.5]
  24. if {$tclo < 0 || $tko < 0} {
  25.     tk_messageBox -message "This program requires Tcl and Tk 8.5 or greater" -type ok
  26.     exit
  27. }
  28. package require Ttk
  29.  
  30. # Default settings:
  31.  
  32. set topdir /usr/local
  33. set docdir [file join $topdir doc wishes]
  34. set libdir [file join $topdir lib wishes]
  35. set helpfile [file join $docdir binvuhelp_link.txt] ; # User Help Guide
  36. set licfile [file join $docdir mule_license.txt] ; # License
  37. set version "2009"
  38.  
  39. # Where program listings and configuration files go
  40. # (Replace old "~/wishes," if any, with new "~/.wishes")
  41.  
  42. set wishdir [file join $env(HOME) .wishes]
  43. set oldwishdir [file join $env(HOME) wishes]
  44. if {[file exists $wishdir] == 0} {
  45.     if {[file exists $oldwishdir] && [file type $oldwishdir] eq "directory"} {
  46.         file rename $oldwishdir $wishdir
  47.         file link $oldwishdir $wishdir
  48.     } else {
  49.         file mkdir $wishdir
  50.     }
  51. }
  52. set colordir [file join $wishdir colorschemes]
  53. if {[file exists $colordir] == 0} {
  54.     set nocolors [catch {file copy [file join $libdir colorschemes] $wishdir} outage]
  55.     if {$nocolors} {
  56.         tk_messageBox -message $outage -type ok
  57.     }
  58. }
  59.  
  60. # One or more features may work only on unix platforms (including Linux),
  61. # so identify the platform:
  62. set platforms [split [array get tcl_platform]]
  63. if {"unix" in $platforms} {
  64.     set platform unix
  65. }
  66.  
  67. # Set defaults (may be changed by configuration file--see below)
  68.  
  69. set hexies "" ; # No hex data obtained yet
  70. set curfil "" ; # No file opened yet
  71. set oldcurfil "" ; # No file previously opened either
  72. set search_for "" ; # No search criteria specified yet
  73. set wid(byte) 8 ; # Hex digits for byte offset
  74. set hexo 1 ; # Show hexadecimal representation
  75. set hexexp 1 ; # Expand hex view with spaces between bytes
  76. set hexread 32 ; # Number of hex digits per line
  77. set wid(hexo) [expr {$hexread * 3/2}] ; # Width of widget for hex digits
  78. set bino 0 ; # Don't show binary representation just now
  79. set wid(bino) 0 ; # So, no width for binary representation
  80. set decimo 0 ; # No decimal representation either
  81. set wid(decimo) 0 ; # And no width for it
  82. set texto 1 ; # Show text representation
  83. set wid(texto) 16 ; # Width of widget for text
  84. set iso88591 0 ; # Don't show standard Latin non-ASCII characters as text
  85. set showlist [list byte hex texto] ; # What's to be shown
  86. set boxlist [list .tex(byte) .tex(hex) .tex(texto)] ; # Boxes to show it
  87. set casematch nocase ; # Don't demand case matching in search
  88. set searchway forward ; # Search down, not up
  89. set expert 0 ; # Presume no expert (regular-expression) search
  90. set subchar {~} ; # Character to substitute for non-text bytes
  91. set coloron 0 ; # WISH Color Picker Plus not loaded yet
  92. set helpon 0 ; # Nor WISH User Help
  93.  
  94. # Read configuration file, if there is one
  95.  
  96. set binvufig [file join $wishdir binvufig.tcl]
  97. if {[file readable $binvufig]} {
  98.     source $binvufig
  99. }
  100.  
  101. # Procedure to save configuration:
  102.  
  103. proc savefig {} {
  104.     global binvufig
  105.     set filid [open $binvufig w]
  106.     set figlines "# WISH Binary Viewer configuration file (binvufig.tcl) \
  107.         \n\nset wid(byte) $::wid(byte) \
  108.         \nset hexo $::hexo \
  109.         \nset hexexp $::hexexp \
  110.         \nset hexread $::hexread \
  111.         \nset wid(hexo) $::wid(hexo) \
  112.         \nset bino $::bino \
  113.         \nset wid(bino) $::wid(bino) \
  114.         \nset decimo $::decimo \
  115.         \nset wid(decimo) $::wid(decimo) \
  116.         \nset texto $::texto \
  117.         \nset wid(texto) $::wid(texto) \
  118.         \nset iso88591 $::iso88591 \
  119.         \nset showlist \[list $::showlist\] \
  120.         \nset boxlist \[list $::boxlist\] \
  121.         \nset casematch $::casematch \
  122.         \nset searchway $::searchway \
  123.         \nset subchar $::subchar \
  124.         \nset current_scheme $::current_scheme"
  125.     puts -nonewline $filid $figlines
  126.     close $filid
  127. }
  128.  
  129. # Hang onto original settings in case you want them back:
  130.  
  131. set old(hex) $hexo
  132. set old(bin) $bino
  133. set old(dec) $decimo
  134. set old(texto) $texto
  135. set old(iso88591) $iso88591
  136. set old(subchar) $subchar
  137.  
  138. # Initialize lists of widgets for color display
  139. # (not all may be used by all programs):
  140.  
  141. set buttlist [list] ; # Buttons
  142. set texlist [list] ; # Text widgets
  143. set entlist [list] ; # Entry widgets
  144. set lublist [list] ; # Listboxes
  145. set spinlist [list] ; # Spinboxes
  146. set winlist [list] ; # Widgets to get window background color when disabled
  147. set headlist [list] ; # Emphasized labels
  148. set lightlist [list] ; # Light labels
  149. set checklist [list] ; # Checkbuttons and radiobuttons
  150.  
  151. # Integer range generator for "foreach"
  152. # (to do a "for" loop without ugly, awkward "for" code):
  153.  
  154. proc range {start cutoff finish {step 1}} {
  155.     # If "start" and "finish" aren't integers, do nothing:
  156.     if {[string is integer -strict $start] == 0 || [string is\
  157.         integer -strict $finish] == 0} {
  158.         error "range: Range must contain two integers"
  159.     }
  160.            
  161.     # "Step" has to be an integer too, and
  162.     # no infinite loops that go nowhere are allowed:
  163.     if {$step == 0 || [string is integer -strict $step] == 0} {
  164.         error "range: Step must be an integer other than zero"
  165.     }
  166.    
  167.     # Does the range include the last number?
  168.     switch $cutoff {
  169.         "to" {set inclu 1}
  170.         "no" {set inclu 0}
  171.         default {
  172.             error "range: Use \"to\" for an inclusive range,\
  173.             or \"no\" for a noninclusive range"
  174.         }
  175.     }
  176.        
  177.     # Is the range ascending or descending (or neither)?
  178.     set ascendo [expr $finish - $start]
  179.     if {$ascendo > -1} {
  180.         set up 1
  181.     } else {
  182.         set up 0
  183.     }
  184.    
  185.     # If range is descending and step is positive but doesn't have a "+" sign,
  186.     # change step to negative:
  187.     if {$up == 0 && $step > 0 && [string first "+" $start] != 0} {
  188.         set step [expr $step * -1]
  189.     }
  190.    
  191.     set ranger [list] ; # Initialize list variable for generated range
  192.     switch "$up $inclu" {
  193.         "1 1" {set op "<=" ; # Ascending, inclusive range}
  194.         "1 0" {set op "<" ; # Ascending, noninclusive range}
  195.         "0 1" {set op ">=" ; # Descending, inclusive range}
  196.         "0 0" {set op ">" ; # Descending, noninclusive range}
  197.     }
  198.    
  199.     # Generate a list containing the specified range of integers:
  200.     for {set i $start} "\$i $op $finish" {incr i $step} {
  201.         lappend ranger $i
  202.     }
  203.     return $ranger
  204. }
  205.  
  206. ##################################
  207.  
  208.  
  209. ### GUI ###
  210.  
  211.  
  212. ### MAIN WINDOW:
  213.  
  214. wm title . "WISH Binary Viewer"
  215. set fonto -*-courier-medium-r-normal--12-*-*-*-*-*-*
  216. label .lab(byte) -text "Byte"
  217. label .lab(hexo) -text "Hexadecimal"
  218. label .lab(bino) -text "Binary"
  219. label .lab(decimo) -text "Decimal"
  220. label .lab(texto) -text "Text"
  221. text .tex(byte) -width 8
  222. text .tex(hexo) -width $wid(hexo)
  223. text .tex(bino) -width $wid(bino)
  224. text .tex(decimo) -width $wid(decimo)
  225. text .tex(texto) -width $wid(texto)
  226. ttk::scrollbar .binbar ; # proc "gridview" (below) makes this work
  227. foreach labo [list .lab(byte) .lab(hexo) .lab(bino) .lab(decimo) .lab(texto)] {
  228.     $labo configure -pady 4 -padx 0 -relief raised
  229. }
  230. foreach texo [list .tex(byte) .tex(hexo) .tex(bino) .tex(decimo) .tex(texto)] {
  231.     $texo configure -height 32 -font $fonto -setgrid 1
  232.     lappend texlist $texo
  233.     bind $texo <FocusIn> {set foco %W}
  234. }
  235. bind . <Control-c> {tk_textCopy $foco}
  236.  
  237. label .stat -relief sunken
  238.  
  239. frame .fr
  240. button .help -text "HELP" -command binvuhelp
  241. button .ope -text "Open" -command {filopy pick}
  242. button .view -text "View" -command figbox
  243. button .copy -text "Copy" -command {tk_textCopy $foco}
  244. button .save -text "Save" -command bin_save
  245. button .search -text "Find (F2)" -command findwhat
  246. button .colodisp -text "Color Display" -command colodisp
  247. button .quit -text "Quit" -command shootdown
  248. pack .help .ope .view .copy .save .search .colodisp .quit -in .fr \
  249.     -side left -expand 1 -fill both
  250. foreach butt [list .help .ope .view .copy .save .search .colodisp .quit] {
  251.     lappend buttlist $butt
  252. }
  253.  
  254. bind . <F2> findwhat
  255.  
  256. # Procedure to get text widgets to scroll together:
  257.  
  258. proc rollon {boxes args} {
  259.     foreach box $boxes {
  260.         eval {$box yview} $args
  261.     }
  262. }
  263.  
  264. ### COLOR DISPLAY ###
  265.  
  266. # Procedure to set up GUI box for configuring color display:
  267.  
  268. proc colodisp {} {
  269.     global color red green blue whatfig whatbutt colorlist colordir \
  270.         winback winfore selback selfore buttback buttfore textback \
  271.         textfore headback headfore lightback lightfore coloron wishdir \
  272.         libdir current_scheme bogomips
  273.     if {$coloron == 0} {
  274.         source [file join $libdir wishcolorplus.tcl]
  275.         set coloron 1
  276.     }
  277.     wishcolorplus ; # This does all the work--from WISH Color Picker Plus
  278.     wm title .colo "WISH Binary Viewer : WISH Color Picker Plus"
  279. }
  280.  
  281. # Use WISH User Help for user help guide:
  282.  
  283. # Procedure for setting up user help display:
  284.  
  285. proc binvuhelp {} {
  286.     global helpon helpfile libdir
  287.     if {$helpon == 0} {
  288.         source [file join $libdir wishuhelp.tcl]
  289.         set helpon 1
  290.     }
  291.     uhelp ; # Set up user help window--from WISH User Help
  292.     wm title .uhelp "WISH Binary Viewer - User Help"
  293.     set linkup [open $helpfile r]
  294.     set helpcontents [read $linkup]
  295.     close $linkup
  296.     .uhelp.tx insert 1.0 $helpcontents
  297.     helplink .uhelp.tx; # Show links in text--from WISH User Help
  298.     .uhelp.tx mark set insert 1.0
  299.     .uhelp.tx configure -state disabled
  300. }
  301.  
  302. # Procedure to set up GUI box for configuring view:
  303.  
  304. proc figbox {} {
  305.     global hexo hexexp bino decimo texto old iso88591 subchar selco
  306.     toplevel .fig
  307.     wm title .fig "Configure View"
  308.     set old(hexo) $hexo
  309.     set old(hexexp) $hexexp
  310.     set old(bino) $bino
  311.     set old(decimo) $decimo
  312.     set old(texto) $texto
  313.     set old(iso88591) $iso88591
  314.     set old(subchar) $subchar
  315.     grid [checkbutton .fig.hex -variable hexo -text\
  316.         "Show hexadecimal codes:" -command fixcod] -sticky news
  317.     grid [radiobutton .fig.exp -variable hexexp -value 1 \
  318.         -text "Expanded (spaces between bytes)"] -sticky news
  319.     grid [radiobutton .fig.com -variable hexexp -value 0 \
  320.         -text "Compressed (no spaces)"] -sticky news
  321.     grid [checkbutton .fig.bin -variable bino \
  322.         -text "Show binary codes"] -sticky news
  323.     grid [checkbutton .fig.dec -variable decimo \
  324.         -text "Show decimal codes"] -sticky news
  325.     grid [checkbutton .fig.tex -variable texto \
  326.         -text "Show text content:" -command fixcod] -sticky news
  327.     grid [radiobutton .fig.iso -variable iso88591 -value 1 \
  328.         -text "Special characters (ISO Latin-1)"] -sticky news
  329.     grid [radiobutton .fig.ascii -variable iso88591 -value 0 \
  330.         -text "Plain (ASCII) characters only"] -sticky news
  331.     frame .fig.frub
  332.     label .fig.sub -text " Substitute for non-text:  "
  333.     entry .fig.char -bg $::textback -fg $::textfore -width 1 -textvariable subchar
  334.     pack .fig.sub .fig.char -in .fig.frub -side left -expand 1 -fill both
  335.     grid .fig.frub -sticky news
  336.     frame .fig.fr
  337.     button .fig.ok -text "OK" -default normal -relief solid -command {
  338.         destroy .fig
  339.         figview
  340.     }
  341.     button .fig.can -text "Cancel" -default normal -command {
  342.         oldcodes
  343.         destroy .fig
  344.     }
  345.     bind .fig <Key-Return> {
  346.         destroy .fig
  347.         figview
  348.     }
  349.     foreach w [list .fig.hex .fig.bin .fig.dec .fig.tex .fig.sub .fig.char] {
  350.         $w configure -font "helvetica 18 bold" 
  351.     }
  352.     pack .fig.ok .fig.can -in .fig.fr -side left -expand 1 -fill both
  353.     grid .fig.fr -sticky news
  354.     focus .fig.char
  355.    
  356.     # Color display:
  357.     foreach reg [list .fig.hex .fig.exp .fig.com .fig.bin .fig.dec .fig.tex \
  358.         .fig.iso .fig.ascii] {
  359.         $reg configure -selectcolor $::textback
  360.     }
  361.     foreach butt [list .fig.ok .fig.can] {
  362.         $butt configure -bg $::buttback -fg $::buttfore
  363.     }
  364. }
  365.  
  366. # Procedure to disable radiobuttons when no specified codes are to be displayed:
  367.  
  368. proc fixcod {} {
  369.     global whole
  370.     if {$hexo == 1} {
  371.         .fig.exp configure -state active
  372.         .fig.com configure -state active
  373.     } else {
  374.         .fig.exp configure -state disabled
  375.         .fig.com configure -state disabled
  376.     }
  377.     if {$texto == 1} {
  378.         .fig.iso configure -state active
  379.         .fig.ascii configure -state active
  380.     } else {
  381.         .fig.iso configure -state disabled
  382.         .fig.ascii configure -state disabled
  383.     }
  384. }
  385.  
  386. # Procedure to set up configuration for view window:
  387.  
  388. proc figview {} {
  389.     global hexo bino decimo texto wid hexread hexexp curfil \
  390.         newshow showlist old binnies subchar iso88591
  391.        
  392.     # Get ready to save new display variables:
  393.     array unset newshow
  394.     foreach val [list hexo bino decimo texto] {
  395.         set oldwid($val) $wid($val)
  396.         set wid($val) 0
  397.     }
  398.     set hexread 0
  399.    
  400.     # Figure out display window widths:
  401.     if {$bino == 1} {
  402.         if {$decimo == 1 && $hexo == 1} {
  403.             set wid(decimo) 16
  404.             set wid(bino) 36
  405.             set hexread 8
  406.             if {$texto == 1} {
  407.                 set wid(texto) 4
  408.             }
  409.         } else {
  410.             set wid(bino) 72
  411.             set hexread 16
  412.             if {$decimo == 1} {
  413.                 set wid(decimo) 32
  414.             }
  415.             if {$texto == 1} {
  416.                 set wid(texto) 8
  417.             }
  418.         }
  419.        
  420.     } else {
  421.         if {$decimo == 1} {
  422.             if {$hexo == 1} {
  423.                 set wid(decimo) 32
  424.                 set hexread 16
  425.                 if {$texto == 1} {
  426.                     set wid(texto) 8
  427.                 }
  428.             } else {
  429.                 set wid(decimo) 64
  430.                 set hexread 32
  431.                 if {$texto == 1} {
  432.                     set wid(texto) 16
  433.                 }
  434.             }
  435.         } else {
  436.             switch "$hexo $texto" {
  437.                 "1 1" {
  438.                     set hexread 32
  439.                     set wid(texto) 16
  440.                 }
  441.                 "1 0" {
  442.                     set hexread 64
  443.                 }
  444.                 "0 1" {
  445.                     set hexread 128
  446.                     set wid(texto) 64
  447.                 }
  448.                 default {
  449.                     tk_messageBox -message "Please select one or more of the\
  450.                         following view modes:\
  451.                         \nHexadecimal codes\
  452.                         \nBinary codes\
  453.                         \nDecimal codes\
  454.                         \nText content" -type ok
  455.                     oldcodes
  456.                     return
  457.                 }
  458.             }
  459.         }
  460.     }
  461.     if {$hexo == 1} {
  462.         if {$hexexp == 1} {
  463.             set wid(hexo) [expr {$hexread * 3/2}]
  464.         } else {
  465.             set wid(hexo) $hexread
  466.         }
  467.     }
  468.    
  469.     # Start setting up list of display windows:
  470.     set showlist [list byte]
  471.     foreach style [list bino decimo hexo texto] {
  472.         if {[set $style] == 1} {
  473.             lappend showlist $style
  474.         }
  475.     }
  476.    
  477.     # Prepare to add or reformat contents of display windows
  478.     # if file is already being displayed (variables in "whole"
  479.     # array will be temporarily set to zero if there is to be
  480.     # no change in display, e.g., "set hexo 0" if
  481.     # hexadecimal display is to remain unchanged):
  482.     if {$curfil ne ""} {
  483.         if {$hexo == 1} {
  484.             set newshow(hexo) 1
  485.             if {$old(hexo) == 1 && $wid(hexo) == $oldwid(hexo)} {
  486.                 set hexo 0
  487.             } else {
  488.                 .tex(byte) delete 1.0 end
  489.                 .tex(hexo) delete 1.0 end
  490.             }
  491.         }
  492.         if {$bino == 1} {
  493.             set newshow(bino) 1
  494.             if {$old(bino) == 1 && $wid(bino) == $oldwid(bino)} {
  495.                 set bino 0
  496.             } else {
  497.                 .tex(byte) delete 1.0 end
  498.                 .tex(bino) delete 1.0 end
  499.             }
  500.         }
  501.         if {$decimo == 1} {
  502.             set newshow(decimo) 1
  503.             if {$old(decimo) == 1 && $wid(decimo) == $oldwid(decimo)} {
  504.                 set decimo 0
  505.             } else {
  506.                 .tex(byte) delete 1.0 end
  507.                 .tex(decimo) delete 1.0 end
  508.             }
  509.         }
  510.         if {$texto == 1} {
  511.             set newshow(texto) 1
  512.             if {$old(texto) == 1 && $wid(texto) == $oldwid(texto) &&\
  513.                 $old(iso88591) == $iso88591 && $old(subchar) == $subchar} {
  514.                 set texto 0
  515.             } else {
  516.                 .tex(byte) delete 1.0 end
  517.                 .tex(texto) delete 1.0 end
  518.             }
  519.         }
  520.     }
  521.     gridview
  522. }
  523.  
  524. # Procedure to set up display:
  525.  
  526. proc gridview {} {
  527.     global byte hexo bino decimo texto wid showlist \
  528.         boxlist curfil newshow hexread foco
  529.     foreach style [list hexo bino decimo texto] {
  530.         catch {grid forget .lab($style) .tex($style)}
  531.     }
  532.     grid forget .binbar .fr
  533.     set boxlist [list]
  534.     foreach num [range 0 no [llength $showlist]] {
  535.         set ind [lindex $showlist $num]
  536.         .tex($ind) configure -width $wid($ind)
  537.         grid .lab($ind) -row 0 -column $num -sticky news
  538.         grid .tex($ind) -row 1 -column $num -sticky news
  539.         lappend lablist .lab($ind)
  540.         lappend boxlist .tex($ind)
  541.     }
  542.     grid .binbar -row 0 -column [llength $showlist] -rowspan 2 -sticky news
  543.     .binbar configure -command [list rollon $boxlist]
  544.     foreach box $boxlist {
  545.         $box configure -yscrollcommand ".binbar set"
  546.     }
  547.     grid .stat -row 2 -column 0 -columnspan \
  548.         [expr {[llength $showlist] +1}] -sticky news
  549.     grid .fr -row 3 -column 0 -columnspan \
  550.         [expr {[llength $showlist] +1}] -sticky news
  551.     grid rowconfigure . 1 -weight 1
  552.     set foco [lindex $boxlist 1]
  553.     formalines
  554.     if {[array size newshow] > 0} {
  555.         foreach name [array names newshow] {
  556.             set $name 1
  557.         }
  558.     }
  559. }
  560.  
  561. # Procedure to set up "Find" box:
  562.  
  563. proc search_find {} {
  564.     global search_for casematch searchway foco showlist \
  565.         hexo bino decimo texto selco anytries
  566.     toplevel .find
  567.     wm title .find "Find (Regular-expression Search)"
  568.     frame .find.fr0
  569.     label .find.findwhat -text "Find: " -pady 4
  570.     entry .find.enter -width 56 -bg $::textback -fg $::textfore -textvariable search_for
  571.     pack .find.findwhat .find.enter -in .find.fr0\
  572.         -side left -expand 1 -fill both
  573.     grid .find.fr0 -row 0 -column 0 -columnspan 2 -sticky news
  574.     if {$search_for ne ""} {
  575.         set searchlength [string length $search_for]
  576.         .find.enter selection range 0 $searchlength
  577.     }
  578.    
  579.     frame .find.fr1
  580.     label .find.in -text "In: "
  581.     radiobutton .find.bin -text "Binary" -variable foco -value .tex(bin)
  582.     radiobutton .find.dec -text "Decimal" -variable foco -value .tex(dec)
  583.     radiobutton .find.hex -text "Hexadecimal" -variable foco -value .tex(hexo)
  584.     radiobutton .find.texto -text "Text" -variable foco -value .tex(texto)
  585.     pack .find.in .find.bin .find.dec .find.hex .find.texto \
  586.         -in .find.fr1 -side left -expand 1 -fill both
  587.     grid .find.fr1 -row 1 -column 0 -sticky news
  588.     grid [button .find.next -text "Find (F2)" -bg $::buttback -fg $::buttfore \
  589.         -command find_text] -row 1 -column 1 -sticky news
  590.     foreach name [array names whole] {
  591.         if {[lsearch $showlist $name] == -1} {
  592.             .find.$name configure -state disabled
  593.         }
  594.     }
  595.    
  596.     frame .find.fr2
  597.     checkbutton .find.match -text "Match case" -variable casematch \
  598.         -onvalue "exact" -offvalue "nocase"
  599.     radiobutton .find.up -text "Search Up" -variable searchway \
  600.         -value "backward"
  601.     radiobutton .find.down -text "Search Down" -variable searchway \
  602.         -value "forward"
  603.     pack .find.match .find.up .find.down \
  604.         -in .find.fr2 -side left -expand 1 -fill both
  605.     grid .find.fr2 -row 2 -column 0 -sticky news
  606.     grid [button .find.done -text "Done" -bg $::buttback -fg $::buttfore \
  607.         -command {destroy .find}] -row 2 -column 1 -sticky news
  608.     set anytries 0
  609.     bind .find <F2> find_text
  610.     focus .find.enter
  611.    
  612.     # Color display:
  613.    
  614.     foreach ent [list .find.enter] {
  615.         lappend entlist $ent
  616.         $ent configure -bg $::textback -fg $::textfore
  617.     }
  618.     foreach butt [list .find.match .find.up .find.down] {
  619.         $butt configure -bg $::lightback -fg $::lightfore
  620.     }
  621.     foreach reg [list .find.bin .find.dec .find.hex .find.texto \
  622.         .find.match .find.up .find.down] {
  623.         $reg configure -selectcolor $::textback
  624.     }
  625. }
  626.  
  627.  
  628. ##################################
  629.  
  630.  
  631. ### PROCEDURES FOR ACTIONS ###
  632.  
  633. # Procedure to begin or continue search:
  634.  
  635. proc findwhat {} {
  636.     if {[winfo exists .find]} {
  637.         find_text
  638.     } else {
  639.         search_find
  640.     }
  641. }
  642.  
  643. # Procedure to open and display binary file:
  644.  
  645. proc filopy {whence} {
  646.     global curfil oldcurfil boxlist hexies binnies
  647.     if {$whence eq "pick"} {
  648.         set fil [tk_getOpenFile]
  649.         if {$fil == ""} {
  650.             return
  651.         } else {
  652.             if {$curfil ne ""} {
  653.                 set oldcurfil $curfil
  654.             }
  655.             set curfil $fil
  656.         }
  657.     }
  658.     foreach box $boxlist {
  659.         $box delete 1.0 end
  660.     }
  661.     wm title . "WISH Binary Viewer: $curfil"
  662.     .stat configure -text "Reading binary file ..."
  663.     update
  664.     set filid [open $curfil r]
  665.     fconfigure $filid -translation binary -encoding binary
  666.     set filin [read $filid]
  667.     close $filid
  668.     .stat configure -text "Scanning binary data ..."
  669.     update
  670.     binary scan $filin H* hexies
  671.     binary scan $filin B* binnies
  672.     .stat configure -text "Formatting display ... may be time-consuming for large files ..."
  673.     update
  674.     formalines
  675.     .stat configure -text "Finished."
  676.     after 1000 {
  677.         .stat configure -text ""
  678.     }
  679. }
  680.  
  681. # Procedure to save binary file:
  682.  
  683. proc bin_save {} {
  684.     set f [tk_getSaveFile]
  685.     if {"" == $f} {
  686.         return
  687.     }
  688.     set data [.tex(hexo) get 1.0 "end -1c"]
  689.     set data [string map "{ } {} {\n} {}" $data]
  690.     set fo [open $f w]
  691.     fconfigure $fo -translation binary -encoding binary
  692.     set binout [binary format H* $data]
  693.     puts -nonewline $fo $binout
  694.     close $fo
  695. }
  696.  
  697. # Procedure to format lines:
  698.  
  699. proc formalines {} {
  700.     global hexo bino decimo texto hexies hexread hexexp binnies boxlist
  701.     set hexLen [string length $hexies]
  702.     if {$hexLen < 1} {
  703.         return
  704.     }
  705.     set charCount 0
  706.     set lineCount 0
  707.     set binCount 0
  708.     set newbie ""
  709.     set newByte ""
  710.     set newHex ""
  711.     set newBin ""
  712.     set newDec ""
  713.     set newText ""
  714.     set hexhalf [expr $hexread/2]
  715.     switch "$hexo $bino $decimo $texto" {
  716.         "1 1 1 1" {
  717.            
  718.             # Hex, binary, decimal, text
  719.             for {set i 0} {$i < $hexLen} {incr i} {
  720.                 incr charCount
  721.                 set binCount [expr {$i*4}]
  722.                 append newbie [string index $hexies $i]
  723.                 append binny [string range $binnies\
  724.                     $binCount [expr {$binCount+3}]]
  725.                 if {[string length $newbie] > 1} {
  726.                     append newHex $newbie
  727.                     if {$hexexp == 1} {
  728.                         append newHex " "
  729.                     }
  730.                     append newBin "$binny "
  731.                     append newDec "[format %03d 0x$newbie] "
  732.                     append newText [textize $newbie]
  733.                     set newbie ""
  734.                     set binny ""
  735.                 }
  736.                 if {$charCount == $hexread} {
  737.                     set byteline [expr {$lineCount * $hexhalf}]
  738.                     append newByte "[format "%08x" $byteline]\n"
  739.                     append newHex \n
  740.                     append newBin \n
  741.                     append newDec \n
  742.                     append newText \n
  743.                     set charCount 0
  744.                     incr lineCount
  745.                 }
  746.             }
  747.             if {$charCount != 0} {
  748.                 set byteline [expr {$lineCount * $hexhalf}]
  749.                 append newByte "[format "%08x" $byteline]"
  750.             }
  751.             .tex(byte) insert end $newByte
  752.             .tex(hexo) insert end $newHex
  753.             .tex(bino) insert end $newBin
  754.             .tex(decimo) insert end $newDec
  755.             .tex(texto) insert end $newText
  756.         }
  757.         "1 1 1 0" {
  758.            
  759.             # Hex, binary, decimal
  760.             for {set i 0} {$i < $hexLen} {incr i} {
  761.                 incr charCount
  762.                 set binCount [expr {$i*4}]
  763.                 append newbie [string index $hexies $i]
  764.                 append binny [string range $binnies\
  765.                     $binCount [expr {$binCount+3}]]
  766.                 if {[string length $newbie] > 1} {
  767.                     append newHex $newbie
  768.                     if {$hexexp == 1} {
  769.                         append newHex " "
  770.                     }
  771.                     append newBin "$binny "
  772.                     append newDec "[format %03d 0x$newbie] "
  773.                     set newbie ""
  774.                     set binny ""
  775.                 }
  776.                 if {$charCount == $hexread} {
  777.                     set byteline [expr {$lineCount * $hexhalf}]
  778.                     append newByte "[format "%08x" $byteline]\n"
  779.                     append newHex \n
  780.                     append newBin \n
  781.                     append newDec \n
  782.                     set charCount 0
  783.                     incr lineCount
  784.                 }
  785.             }
  786.             if {$charCount != 0} {
  787.                 set byteline [expr {$lineCount * $hexhalf}]
  788.                 append newByte "[format "%08x" $byteline]"
  789.             }
  790.             .tex(byte) insert end $newByte
  791.             .tex(hexo) insert end $newHex
  792.             .tex(bino) insert end $newBin
  793.             .tex(decimo) insert end $newDec
  794.         }
  795.         "1 1 0 1" {
  796.            
  797.             # Hex, binary, text
  798.             for {set i 0} {$i < $hexLen} {incr i} {
  799.                 incr charCount
  800.                 set binCount [expr {$i*4}]
  801.                 append newbie [string index $hexies $i]
  802.                 append binny [string range $binnies\
  803.                     $binCount [expr {$binCount+3}]]
  804.                 if {[string length $newbie] > 1} {
  805.                     append newHex $newbie
  806.                     if {$hexexp == 1} {
  807.                         append newHex " "
  808.                     }
  809.                     append newBin "$binny "
  810.                     append newText [textize $newbie]
  811.                     set newbie ""
  812.                     set binny ""
  813.                 }
  814.                 if {$charCount == $hexread} {
  815.                     set byteline [expr {$lineCount * $hexhalf}]
  816.                     append newByte "[format "%08x" $byteline]\n"
  817.                     append newHex \n
  818.                     append newBin \n
  819.                     append newText \n
  820.                     set charCount 0
  821.                     incr lineCount
  822.                 }
  823.             }
  824.             if {$charCount != 0} {
  825.                 set byteline [expr {$lineCount * $hexhalf}]
  826.                 append newByte "[format "%08x" $byteline]"
  827.             }
  828.             .tex(byte) insert end $newByte
  829.             .tex(hexo) insert end $newHex
  830.             .tex(bino) insert end $newBin
  831.             .tex(texto) insert end $newText
  832.         }
  833.         "1 1 0 0" {
  834.            
  835.             # Hex, binary
  836.             for {set i 0} {$i < $hexLen} {incr i} {
  837.                 incr charCount
  838.                 set binCount [expr {$i*4}]
  839.                 append newbie [string index $hexies $i]
  840.                 append binny [string range $binnies\
  841.                     $binCount [expr {$binCount+3}]]
  842.                 if {[string length $newbie] > 1} {
  843.                     append newHex $newbie
  844.                     if {$hexexp == 1} {
  845.                         append newHex " "
  846.                     }
  847.                     append newBin "$binny "
  848.                     set newbie ""
  849.                     set binny ""
  850.                 }
  851.                 if {$charCount == $hexread} {
  852.                     set byteline [expr {$lineCount * $hexhalf}]
  853.                     append newByte "[format "%08x" $byteline]\n"
  854.                     append newHex \n
  855.                     append newBin \n
  856.                     set charCount 0
  857.                     incr lineCount
  858.                 }
  859.             }
  860.             if {$charCount != 0} {
  861.                 set byteline [expr {$lineCount * $hexhalf}]
  862.                 append newByte "[format "%08x" $byteline]"
  863.             }
  864.             .tex(byte) insert end $newByte
  865.             .tex(hexo) insert end $newHex
  866.             .tex(bino) insert end $newBin
  867.         }
  868.         "1 0 1 1" {
  869.            
  870.             # Hex, decimal, text
  871.             for {set i 0} {$i < $hexLen} {incr i} {
  872.                 incr charCount
  873.                 append newbie [string index $hexies $i]
  874.                 if {[string length $newbie] > 1} {
  875.                     append newHex $newbie
  876.                     if {$hexexp == 1} {
  877.                         append newHex " "
  878.                     }
  879.                     append newDec "[format %03d 0x$newbie] "
  880.                     append newText [textize $newbie]
  881.                     set newbie ""
  882.                 }
  883.                 if {$charCount == $hexread} {
  884.                     set byteline [expr {$lineCount * $hexhalf}]
  885.                     append newByte "[format "%08x" $byteline]\n"
  886.                     append newHex \n
  887.                     append newDec \n
  888.                     append newText \n
  889.                     set charCount 0
  890.                     incr lineCount
  891.                 }
  892.             }
  893.             if {$charCount != 0} {
  894.                 set byteline [expr {$lineCount * $hexhalf}]
  895.                 append newByte "[format "%08x" $byteline]"
  896.             }
  897.             .tex(byte) insert end $newByte
  898.             .tex(hexo) insert end $newHex
  899.             .tex(decimo) insert end $newDec
  900.             .tex(texto) insert end $newText
  901.         }
  902.         "1 0 1 0" {
  903.            
  904.             # Hex, decimal
  905.             for {set i 0} {$i < $hexLen} {incr i} {
  906.                 incr charCount
  907.                 append newbie [string index $hexies $i]
  908.                 if {[string length $newbie] > 1} {
  909.                     append newHex $newbie
  910.                     if {$hexexp == 1} {
  911.                         append newHex " "
  912.                     }
  913.                     append newDec "[format %03d 0x$newbie] "
  914.                     set newbie ""
  915.                 }
  916.                 if {$charCount == $hexread} {
  917.                     set byteline [expr {$lineCount * $hexhalf}]
  918.                     append newByte "[format "%08x" $byteline]\n"
  919.                     append newHex \n
  920.                     append newDec \n
  921.                     set charCount 0
  922.                     incr lineCount
  923.                 }
  924.             }
  925.             if {$charCount != 0} {
  926.                 set byteline [expr {$lineCount * $hexhalf}]
  927.                 append newByte "[format "%08x" $byteline]"
  928.             }
  929.             .tex(byte) insert end $newByte
  930.             .tex(hexo) insert end $newHex
  931.             .tex(decimo) insert end $newDec
  932.            
  933.         }
  934.         "1 0 0 1" {
  935.            
  936.             # Hex, text
  937.             for {set i 0} {$i < $hexLen} {incr i} {
  938.                 incr charCount
  939.                 append newbie [string index $hexies $i]
  940.                 if {[string length $newbie] > 1} {
  941.                     append newHex $newbie
  942.                     if {$hexexp == 1} {
  943.                         append newHex " "
  944.                     }
  945.                     append newText [textize $newbie]
  946.                     set newbie ""
  947.                 }
  948.                 if {$charCount == $hexread} {
  949.                     set byteline [expr {$lineCount * $hexhalf}]
  950.                     append newByte "[format "%08x" $byteline]\n"
  951.                     append newHex \n
  952.                     append newText \n
  953.                     set charCount 0
  954.                     incr lineCount
  955.                 }
  956.             }
  957.             if {$charCount != 0} {
  958.                 set byteline [expr {$lineCount * $hexhalf}]
  959.                 append newByte "[format "%08x" $byteline]"
  960.             }
  961.             .tex(byte) insert end $newByte
  962.             .tex(hexo) insert end $newHex
  963.             .tex(texto) insert end $newText
  964.         }
  965.         "1 0 0 0" {
  966.            
  967.             # Hex only
  968.             for {set i 0} {$i < $hexLen} {incr i} {
  969.                 incr charCount
  970.                 append newbie [string index $hexies $i]
  971.                 if {[string length $newbie] > 1} {
  972.                     append newHex $newbie
  973.                     if {$hexexp == 1} {
  974.                         append newHex " "
  975.                     }
  976.                     set newbie ""
  977.                 }
  978.                 if {$charCount == $hexread} {
  979.                     set charcoui 1
  980.                     set byteline [expr {$lineCount * $hexhalf}]
  981.                     append newByte "[format "%08x" $byteline]\n"
  982.                     append newHex "\n"
  983.                     set charCount 0
  984.                     incr lineCount
  985.                 }
  986.             }
  987.             if {$charCount != 0} {
  988.                 set byteline [expr {$lineCount * $hexhalf}]
  989.                 append newByte "[format "%08x" $byteline]"
  990.             }
  991.             .tex(byte) insert end $newByte
  992.             .tex(hexo) insert end $newHex
  993.         }
  994.         "0 1 1 1" {
  995.            
  996.             # Binary, decimal, text
  997.             for {set i 0} {$i < $hexLen} {incr i} {
  998.                 incr charCount
  999.                 set binCount [expr {$i*4}]
  1000.                 append newbie [string index $hexies $i]
  1001.                 append binny [string range $binnies\
  1002.                     $binCount [expr {$binCount+3}]]
  1003.                 if {[string length $newbie] > 1} {
  1004.                     append newBin "$binny "
  1005.                     append newDec "[format %03d 0x$newbie] "
  1006.                     append newText [textize $newbie]
  1007.                     set newbie ""
  1008.                     set binny ""
  1009.                 }
  1010.                 if {$charCount == $hexread} {
  1011.                     set byteline [expr {$lineCount * $hexhalf}]
  1012.                     append newByte "[format "%08x" $byteline]\n"
  1013.                     append newBin \n
  1014.                     append newDec \n
  1015.                     append newText \n
  1016.                     set charCount 0
  1017.                     incr lineCount
  1018.                 }
  1019.             }
  1020.             if {$charCount != 0} {
  1021.                 set byteline [expr {$lineCount * $hexhalf}]
  1022.                 append newByte "[format "%08x" $byteline]"
  1023.             }
  1024.             .tex(byte) insert end $newByte
  1025.             .tex(bino) insert end $newBin
  1026.             .tex(decimo) insert end $newDec
  1027.             .tex(texto) insert end $newText
  1028.         }
  1029.         "0 1 1 0" {
  1030.            
  1031.             # Binary, decimal
  1032.             for {set i 0} {$i < $hexLen} {incr i} {
  1033.                 incr charCount
  1034.                 set binCount [expr {$i*4}]
  1035.                 append newbie [string index $hexies $i]
  1036.                 append binny [string range $binnies\
  1037.                     $binCount [expr {$binCount+3}]]
  1038.                 if {[string length $newbie] > 1} {
  1039.                     append newBin "$binny "
  1040.                     append newDec "[format %03d 0x$newbie] "
  1041.                     set newbie ""
  1042.                     set binny ""
  1043.                 }
  1044.                 if {$charCount == $hexread} {
  1045.                     set byteline [expr {$lineCount * $hexhalf}]
  1046.                     append newByte "[format "%08x" $byteline]\n"
  1047.                     append newBin \n
  1048.                     append newDec \n
  1049.                     set charCount 0
  1050.                     incr lineCount
  1051.                 }
  1052.             }
  1053.             if {$charCount != 0} {
  1054.                 set byteline [expr {$lineCount * $hexhalf}]
  1055.                 append newByte "[format "%08x" $byteline]"
  1056.             }
  1057.             .tex(byte) insert end $newByte
  1058.             .tex(bino) insert end $newBin
  1059.             .tex(decimo) insert end $newDec
  1060.         }
  1061.         "0 1 0 1" {
  1062.            
  1063.             # Binary, text
  1064.             for {set i 0} {$i < $hexLen} {incr i} {
  1065.                 incr charCount
  1066.                 set binCount [expr {$i*4}]
  1067.                 append newbie [string index $hexies $i]
  1068.                 append binny [string range $binnies\
  1069.                     $binCount [expr {$binCount+3}]]
  1070.                 if {[string length $newbie] > 1} {
  1071.                     append newBin "$binny "
  1072.                     append newDec "[format %03d 0x$newbie] "
  1073.                     append newText [textize $newbie]
  1074.                     set newbie ""
  1075.                     set binny ""
  1076.                 }
  1077.                 if {$charCount == $hexread} {
  1078.                     set byteline [expr {$lineCount * $hexhalf}]
  1079.                     append newByte "[format "%08x" $byteline]\n"
  1080.                     append newBin \n
  1081.                     append newDec \n
  1082.                     append newText \n
  1083.                     set charCount 0
  1084.                     incr lineCount
  1085.                 }
  1086.             }
  1087.             if {$charCount != 0} {
  1088.                 set byteline [expr {$lineCount * $hexhalf}]
  1089.                 append newByte "[format "%08x" $byteline]"
  1090.             }
  1091.             .tex(byte) insert end $newByte
  1092.             .tex(bino) insert end $newBin
  1093.             .tex(texto) insert end $newText
  1094.         }
  1095.         "0 1 0 0" {
  1096.            
  1097.             # Binary only
  1098.             for {set i 0} {$i < $hexLen} {incr i} {
  1099.                 incr charCount
  1100.                 set binCount [expr {$i*4}]
  1101.                 append newbie [string index $hexies $i]
  1102.                 append binny [string range $binnies\
  1103.                     $binCount [expr {$binCount+3}]]
  1104.                 if {[string length $newbie] > 1} {
  1105.                     append newBin "$binny "
  1106.                     append newDec "[format %03d 0x$newbie] "
  1107.                     append newText [textize $newbie]
  1108.                     set newbie ""
  1109.                     set binny ""
  1110.                 }
  1111.                 if {$charCount == $hexread} {
  1112.                     set byteline [expr {$lineCount * $hexhalf}]
  1113.                     append newByte "[format "%08x" $byteline]\n"
  1114.                     append newBin \n
  1115.                     append newDec \n
  1116.                     append newText \n
  1117.                     set charCount 0
  1118.                     incr lineCount
  1119.                 }
  1120.             }
  1121.             if {$charCount != 0} {
  1122.                 set byteline [expr {$lineCount * $hexhalf}]
  1123.                 append newByte "[format "%08x" $byteline]"
  1124.             }
  1125.             .tex(byte) insert end $newByte
  1126.             .tex(bino) insert end $newBin
  1127.             .tex(texto) insert end $newText
  1128.         }
  1129.         "0 0 1 1" {
  1130.            
  1131.             # Decimal, text
  1132.             for {set i 0} {$i < $hexLen} {incr i} {
  1133.                 incr charCount
  1134.                 append newbie [string index $hexies $i]
  1135.                 if {[string length $newbie] > 1} {
  1136.                     append newDec "[format %03d 0x$newbie] "
  1137.                     append newText [textize $newbie]
  1138.                     set newbie ""
  1139.                 }
  1140.                 if {$charCount == $hexread} {
  1141.                     set byteline [expr {$lineCount * $hexhalf}]
  1142.                     append newByte "[format "%08x" $byteline]\n"
  1143.                     append newDec \n
  1144.                     append newText \n
  1145.                     set charCount 0
  1146.                     incr lineCount
  1147.                 }
  1148.             }
  1149.             if {$charCount != 0} {
  1150.                 set byteline [expr {$lineCount * $hexhalf}]
  1151.                 append newByte "[format "%08x" $byteline]"
  1152.             }
  1153.             .tex(byte) insert end $newByte
  1154.             .tex(decimo) insert end $newDec
  1155.             .tex(texto) insert end $newText
  1156.         }
  1157.         "0 0 1 0" {
  1158.            
  1159.             # Decimal only
  1160.             for {set i 0} {$i < $hexLen} {incr i} {
  1161.                 incr charCount
  1162.                 append newbie [string index $hexies $i]
  1163.                 if {[string length $newbie] > 1} {
  1164.                     append newDec "[format %03d 0x$newbie] "
  1165.                     set newbie ""
  1166.                 }
  1167.                 if {$charCount == $hexread} {
  1168.                     set byteline [expr {$lineCount * $hexhalf}]
  1169.                     append newByte "[format "%08x" $byteline]\n"
  1170.                     append newDec \n
  1171.                     set charCount 0
  1172.                     incr lineCount
  1173.                 }
  1174.             }
  1175.             if {$charCount != 0} {
  1176.                 set byteline [expr {$lineCount * $hexhalf}]
  1177.                 append newByte "[format "%08x" $byteline]"
  1178.             }
  1179.             .tex(byte) insert end $newByte
  1180.             .tex(decimo) insert end $newDec
  1181.         }
  1182.         "0 0 0 1" {
  1183.            
  1184.             # Text only
  1185.             for {set i 0} {$i < $hexLen} {incr i} {
  1186.                 incr charCount
  1187.                 append newbie [string index $hexies $i]
  1188.                 if {[string length $newbie] > 1} {
  1189.                     append newText [textize $newbie]
  1190.                     set newbie ""
  1191.                 }
  1192.                 if {$charCount == $hexread} {
  1193.                     set byteline [expr {$lineCount * $hexhalf}]
  1194.                     append newByte "[format "%08x" $byteline]\n"
  1195.                     append newText \n
  1196.                     set charCount 0
  1197.                     incr lineCount
  1198.                 }
  1199.             }
  1200.             if {$charCount != 0} {
  1201.                 set byteline [expr {$lineCount * $hexhalf}]
  1202.                 append newByte "[format "%08x" $byteline]"
  1203.             }
  1204.             .tex(byte) insert end $newByte
  1205.             .tex(texto) insert end $newText
  1206.         }
  1207.         default {
  1208.             # Don't do anything
  1209.         }
  1210.     }
  1211.     foreach box $boxlist {
  1212.         $box mark set insert 1.0
  1213.     }
  1214. }
  1215.  
  1216. # Procedure to get rid of spaces between bytes:
  1217.  
  1218. proc hexcomp {hex} {
  1219.     set comline [string map "{ } {}" $hex]
  1220.     return $comline
  1221. }
  1222.  
  1223. # Procedure to "textize" hex codes, if they're "textizable":
  1224.  
  1225. proc textize {byte} {
  1226.     if {[expr 0x20 <= 0x$byte] && [expr 0x$byte <= 0x7a]} {
  1227.         return [binary format H* $byte]
  1228.     } elseif {$::iso88591 == 1 && [expr 0xa0 <= 0x$byte]} {
  1229.         return [binary format H* $byte]
  1230.     } else {
  1231.         return $::subchar
  1232.     }
  1233. }
  1234.  
  1235. # Set search direction and case sensitivity, and search for match
  1236. # (Variables "present_place" and "findlength"
  1237. # are set in "proc find_text," below)
  1238.  
  1239. proc whichway {} {
  1240.     global casematch searchway search_reg present_place foco place countum
  1241.     switch "$casematch $searchway" {
  1242.         "nocase forward" {
  1243.             set place [$foco search -nocase -forward -regexp \
  1244.             -count countum $search_reg $present_place end]
  1245.         }
  1246.         "exact forward" {
  1247.             set place [$foco search -forward -regexp \
  1248.             -count countum $search_reg $present_place end]
  1249.         }
  1250.         "nocase backward" {
  1251.             set place [$foco search -nocase -backward -regexp \
  1252.             -count countum $search_reg $present_place 1.0]
  1253.         }
  1254.         "exact backward" {
  1255.             set place [$foco search -backward -regexp \
  1256.             -count countum $search_reg $present_place 1.0]
  1257.         }
  1258.     }
  1259. }
  1260.  
  1261. # Actually find some matching text:
  1262.  
  1263. proc find_text {} {
  1264.     global present_place search_for search_reg countum place \
  1265.         casematch searchway findway foco anytries countum
  1266.     focus $foco
  1267.     if {$anytries == 0} {
  1268.         set anytries 1
  1269.         set starting_place [$foco index insert]
  1270.         set present_place $starting_place
  1271.         set place $starting_place
  1272.     }
  1273.     set search_reg ""
  1274.     set splitfor [split $search_for {}]
  1275.     foreach char $splitfor {
  1276.         append search_reg "$char\{1\}\\n?"
  1277.     }
  1278.     whichway
  1279.     if {$place eq ""} {
  1280.         tk_messageBox -message "Not Found" \
  1281.             -title "Not Found" -type ok
  1282.         destroy .find
  1283.     } else {
  1284.         catch {$foco tag remove sel sel.first sel.last}
  1285.         $foco tag add sel $place "$place + $countum chars"
  1286.         $foco see $place
  1287.         if {$searchway eq "forward"} {
  1288.             $foco mark set insert "$place + $countum chars"
  1289.         } else {
  1290.             $foco mark set insert $place
  1291.         }
  1292.     }
  1293. }
  1294.  
  1295. # Procedure to get old settings back:
  1296.  
  1297. proc oldcodes {} {
  1298.     global hexo bino decimo texto hexexp old iso88591
  1299.     set hexo $old(hexo)
  1300.     set hexexp $old(hexexp)
  1301.     set bino $old(bino)
  1302.     set decimo $old(decimo)
  1303.     set texto $old(texto)
  1304.     set iso88591 $old(iso88591)
  1305. }
  1306.  
  1307. # Procedure to shut program down correctly, saving configuration:
  1308.  
  1309. proc shootdown {} {
  1310.     savefig
  1311.     exit
  1312. }
  1313.  
  1314.  
  1315. ##################################
  1316.  
  1317.  
  1318. # GET GOING:
  1319.  
  1320. # Open file from the command line, if you wish;
  1321. # otherwise, open blank windows:
  1322.  
  1323. figview
  1324. if {[info exists argv]} {
  1325.     if {[file readable [lindex $argv 0]]} {
  1326.         set curfil [lindex $argv 0]
  1327.         filopy argux
  1328.     }
  1329. }
  1330.  
  1331. # Load most recently used color scheme, if specified in configuration
  1332. # file; if not, load "AntiqueBisque" color scheme as default;
  1333. # if not that either, complain:
  1334.  
  1335. if {[info exists current_scheme]} {
  1336.     source [file join $colordir $current_scheme.tcl]
  1337. } elseif {[file readable [file join $colordir AntiqueBisque.tcl]]} {
  1338.     source [file join $colordir AntiqueBisque.tcl]
  1339. } else {
  1340.     tk_messageBox -message "Current color scheme file not found\
  1341.     in $colordir" -type ok
  1342. }
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!