home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / multimedia / pgcedit / pgcedit.exe / freewrapCmds.tcl < prev   
Text File  |  2004-03-06  |  21KB  |  617 lines
  1. # freeWrap is Copyright (c) 1998-2001 by Dennis R. LaBelle (labelled@nycap.rr.com)
  2. # All Rights Reserved.
  3. #
  4. # This software is provided 'as-is', without any express or implied warranty. In no
  5. # event will the authors be held liable for any damages arising from the use of 
  6. # this software. 
  7. #
  8. # Permission is granted to anyone to use this software for any purpose, including
  9. # commercial applications, and to alter it and redistribute it freely, subject to
  10. # the following restrictions:
  11. #
  12. # 1. The origin of this software must not be misrepresented; you must not claim 
  13. #    that you wrote the original software. If you use this software in a product, an
  14. #    acknowledgment in the product documentation would be appreciated but is not
  15. #    required.
  16. #
  17. # 2. Altered source versions must be plainly marked as such, and must not be
  18. #    misrepresented as being the original software. 
  19. #
  20. # 3. This notice may not be removed or altered from any source distribution.
  21. #
  22. # This TCL/TK script provides the freeWrap namespace commands.
  23. #
  24. # Revision history:
  25. #
  26. # Revison  Date           Author             Description
  27. # -------  -------------  -----------------  --------------------------------------------
  28. #   5.0    Dec. 31, 2001  Dennis R. LaBelle  1) Extracted freeWrap namespace items to
  29. #                                               this separate file.
  30. #                                            2) Added ::freewrap::reconnect procedure to
  31. #                                               reattach archives to the freeWrap stub
  32. #                                            3) Replaced the TCL "source" command in order
  33. #                                               to handle freeWrap encrypted scripts.
  34. #                                            4) Original "source" command renamed to
  35. #                                               ::freewrap::source
  36. #                                            5) Added ::freewrap::getStubSize procedure.
  37. #                                            6) Added ::freewrap::encrypted variable.
  38. #                                            7) Added replacement for glob command using
  39. #                                               some source code from Dave Bodenstab
  40.  
  41. #   5.1    Jan. 26, 2002 Dennis R. LaBelle   1) Adjusted setting of auto_path variable.
  42. #                                            2) Fixed error in ::freewrap::getStubSize
  43. #                                               that occurred since file names are no
  44. #                                               longer converted to lower case.
  45. #                                            3) Replaced the TCL "info" command in order
  46. #                                               to handle the "info script" command for
  47. #                                               wrapped files.
  48.  
  49. #   5.2    June  2, 2002 Dennis R. LaBelle   1) Removed replacement glob command.
  50. #                                            2) Fixed unpack procedure to prevent addition
  51. #                                               of newline character at end of unpacked file.
  52. #                                            3) Removed reroot procedure. Correct root directory
  53. #                                               is now established in main.c file.
  54. #                                            4) Adjusted setting of auto_path variable to include
  55. #                                               /blt directory when running BLT version.
  56.  
  57. #   5.3    Aug. 17, 2002 Dennis R. LaBelle   1) Added errormsg variable to ::freewrap namespace. Modified
  58. #                                               ::freewrap::unpack proc to set this variable if file cannot
  59. #                                               be written to the destination.
  60. #
  61. #   5.4    Nov. 23, 2002 Dennis R. LaBelle   1) ::freewrap::unpack proc now sets the timestamp of the copied
  62. #                                               file to that of the wrapped copy.
  63. #
  64. #   5.6    Dec.  2, 2003 Dennis R. LaBelle   1) Removed freeWrap version of "source" command as a result of
  65. #                                               removing source code encryption feature.
  66.  
  67. # create ::freeWrap namespace
  68. #
  69. namespace eval ::freewrap:: {
  70. variable patchLevel {5.61}     ;# Current freeWrap revision level
  71. variable progname {}          ;# Official freeWrap program name
  72. variable scriptFile {}        ;# Name of executing script file when freeWrap's SOURCE replacement procedure is used.
  73. variable errormsg {}          ;# Last freeWrap error message.
  74.  
  75. proc normalizePath { filename} {
  76. # Return absolute path with . and .. resolved
  77. global tcl_platform
  78.  
  79. if {$tcl_platform(platform) == "windows"} {
  80.     if {[string index $filename 1] == {:}} {
  81.       set newpath [string range $filename 2 end]
  82.      } { set newpath $filename }
  83.    } { set newpath $filename }
  84.  
  85. return $newpath
  86. }
  87.  
  88.  
  89. proc isSameRev { filename} {
  90. # Checks whether the specified file contains a copy of the same freeWrap
  91. # revision as the currently executing program.
  92. #
  93. # Returns: 0, if file is not a copy
  94. #      1, if file is a copy
  95. #
  96. set rtnval 0
  97.  
  98. if {$filename != ""} {
  99.    if {![catch {::zvfs::mount $filename /fwtestsameas}]} {
  100.       # retrieve the information for the specified file.
  101.       set fwRev unknown
  102.       set stubsize 0
  103.       if {[::zvfs::exists /fwtestsameas/_freewrap_init.txt]} {
  104.     set fin [open /fwtestsameas/_freewrap_init.txt r]
  105.     gets $fin line
  106.     gets $fin fwRev
  107.     gets $fin stubsize
  108.     close $fin
  109.     unset fin
  110.         }
  111.       ::zvfs::unmount $filename
  112.  
  113.       # retrieve the information for the currently running program
  114.       set fwRevCur current
  115.       set stubsizeCur 0
  116.       if {[::zvfs::exists /_freewrap_init.txt]} {
  117.     set fin [open /_freewrap_init.txt r]
  118.     gets $fin line
  119.     gets $fin fwRevCur
  120.     gets $fin stubsizeCur
  121.     close $fin
  122.     unset fin
  123.         }
  124.        if { ($fwRev == $fwRevCur) && ($stubsize == $stubsizeCur) } { set rtnval 1 }
  125.       }
  126.    }
  127. return $rtnval
  128. }
  129.  
  130.  
  131. proc unpack {path {destdir {}}} {
  132. # Unpack a file from ZVFS into a native location.
  133. #
  134. # path    = ZVFS path of file to unpack
  135. # destdir = optional destination directory for unpacked file.
  136. #
  137. # Returns: on success, the name of the native file
  138. #          on failure, an empty string
  139. #
  140. global env
  141. global tcl_platform
  142. variable errormsg
  143.  
  144. set filename {}
  145. if {[file exists $path]} {
  146.     if {$destdir == {}} {
  147.       if {$tcl_platform(platform) == "windows"} {
  148.         set destdir [file attributes $env(TEMP) -longname]
  149.          } { set destdir /usr/tmp }
  150.      }
  151.     if {![file isdirectory $destdir]} { return {}}
  152.     set dest [file join $destdir [file tail $path]]
  153.     if {[file exists $dest]} {
  154.         # The file has already been copied once.
  155.         set filename $dest
  156.      } {
  157.         # copy the file to its temporary location
  158.         set fin [open $path r]
  159.         if {[catch {open $dest w} fout]} {
  160.             set errormsg $fout
  161.             close $fin
  162.            } {
  163.              fconfigure $fin -translation binary -buffersize 500000 -encoding binary
  164.              fconfigure $fout -translation binary -buffersize 500000 -encoding binary
  165.              set ext [file extension $path]
  166.              puts -nonewline $fout [read $fin]
  167.              close $fin
  168.              close $fout
  169.              set filename $dest
  170.              catch {file mtime $dest [file mtime $path]}
  171.              }
  172.        }
  173.    }
  174. return $filename
  175. }
  176.  
  177.  
  178. proc iswrapped {filename} {
  179. # Determine whether a file is a freeWrap application
  180. #
  181. # Returns:    1, if file is a freeWrap application
  182. #           0, if file is NOT a freeWrap application
  183.  
  184. set rtnval 0
  185.  
  186. # get name of the running application
  187. set execname [info nameofexecutable]
  188. if {[file type $execname] == "link"} {
  189.     set execname [file readlink $execname]
  190.    }
  191.  
  192. # Is the user asking about the current application?
  193. if {$filename == $execname} {
  194.     set rtnval 1
  195.    } {
  196.     # mount the file
  197.     if {![catch {::zvfs::mount $filename /fwtemp_mount} result]} {
  198.         if {[::zvfs::exists /fwtemp_mount/_freewrap_init.txt]} { set rtnval 1 }
  199.         ::zvfs::unmount $filename
  200.        }
  201.      }
  202. return $rtnval
  203. }
  204.  
  205.  
  206. proc getStubSize {{stubname {}}} {
  207. # Retrieve the size of the freeWrap stub associated with file stubname.
  208. #
  209. # Returns: the size of the stub in bytes or 0, if the stub size cannot be determined or the file does not exist.
  210. global tcl_platform
  211.           
  212. set rtnval 0
  213.  
  214. # get name of currently executing program
  215. set execname [info nameofexecutable]
  216. if {[file type $execname] == "link"} {
  217.     set execname [file readlink $execname]
  218.    }
  219. set execExt [string tolower [file extension $execname]]
  220.  
  221. if {$stubname == {}} {
  222.     # return the stub size for the currently executing program.
  223.     if {[::zvfs::exists /_freewrap_init.txt]} {
  224.       set fin [open /_freewrap_init.txt r]
  225.       gets $fin line
  226.       gets $fin line
  227.       gets $fin line
  228.       close $fin
  229.       unset fin
  230.       if {$line != {}} {
  231.         # simply return the currently stored value
  232.         return $line
  233.          }
  234.      }
  235.     set stubname $execname
  236.  
  237.    } elseif {![file exists $stubname]} { return 0 }
  238.  
  239. # Open file an try to find the start of the ZIP archive.
  240. if {![catch {open $stubname r} fin]} {
  241.     fconfigure $fin -translation binary
  242.     set data [read $fin 5000000]
  243.     close $fin
  244.  
  245.     # Create signature string in a form that will not be read as another signature.
  246.     set signature "PK"
  247.     append signature "\03\04"
  248.     set tailchar "\00"
  249.  
  250.     # Search for signature.
  251.     # Find correct instance of the signature.
  252.     set slen [string length $data]
  253.     set pos 0
  254.     set passno 0
  255.     while {$pos < $slen} {
  256.              set pos [string first $signature $data $pos]
  257.              if {$pos == -1} {
  258.                  set pos $slen
  259.                } {
  260.                    set nextpos $pos
  261.                    incr nextpos 5
  262.                    set nextchar [string index $data $nextpos]
  263.                    if {$nextchar == $tailchar} {
  264.                        set rtnval $pos
  265.                        set pos $slen
  266.                       } { incr pos 4 }
  267.                  }
  268.            }
  269.    }
  270. return $rtnval
  271. }
  272.  
  273.  
  274. proc reconnect {src dest} {
  275. # Copy the specified mounted source file to the specified destination file name.
  276. # Reattach the freeWrap stub to the beginning of the destination file.
  277. #
  278. # Returns: 0, on success
  279. #          1, on failure
  280.  
  281. global tcl_platform
  282.  
  283. set rtnval 1
  284. set stubsize 0
  285. # get name of currently executing program
  286. set execname [info nameofexecutable]
  287. if {[file type $execname] == "link"} {
  288.     set execname [file readlink $execname]
  289.    }
  290.  
  291. # Extract ZIP executable so we can run it.
  292. if {$tcl_platform(platform) == "unix"} {
  293.     # under UNIX, our file must have an extension of .zip in order to readjust
  294.     # the preamble (i.e use the zip -A option)
  295.     set wdest ${dest}.zip
  296.     set zipProgram [unpack /zip] 
  297.     file attributes $zipProgram -permissions 0700 
  298.    } {
  299.     set wdest $dest
  300.     set zipProgram [unpack /zip.exe]
  301.       }
  302.  
  303. set stubsize [getStubSize]
  304. if {$stubsize > 0} {
  305.     if {![catch {open $wdest w} fout]} {
  306.       # get name of currently executing program
  307.       set execname [info nameofexecutable]
  308.       if {[file type $execname] == "link"} {
  309.         set execname [file readlink $execname]
  310.          }
  311.  
  312.       # copy the freeWrap stub
  313.       if {![catch {open $execname r} fin]} {
  314.         fconfigure $fin -translation binary -buffersize 500000 -encoding binary
  315.         fconfigure $fout -translation binary -buffersize 500000 -encoding binary
  316.         fcopy $fin $fout -size $stubsize
  317.         close $fin
  318.         if {[catch {open $src r} fin]} {
  319.             puts $fin
  320.             close $fout
  321.             file delete -force $dest
  322.            } {
  323.             fconfigure $fin -translation binary -buffersize 500000 -encoding binary
  324.             puts -nonewline $fout [read $fin]
  325.             close $fout
  326.             catch {exec $zipProgram -A $wdest} result
  327.             if {$wdest != $dest} {
  328.                 # under UNIX, rename file to final name and mark it
  329.                 # as executable
  330.                 file rename -force $wdest $dest
  331.                 file attributes $dest -permissions 0700
  332.                }
  333.             set rtnval 0
  334.              }
  335.          } { puts $fin }
  336.      } { puts $fout }
  337.    }
  338.  
  339. return $rtnval
  340. }
  341.  
  342.  
  343. # File extension association procedures for Windows.
  344. # 
  345. # These procedures are based upon (with minor modifications) the ms_shell_setup package by 
  346. # Earl Johnson whose Copyright notice follows.
  347.  
  348.   # This is a simple wrapper arround the registry commands provided by the standard TCL
  349.   # installation on Windows.
  350.  
  351.   # By using this library you advoid some details of the registry use, but not all.  Remember
  352.   # to treat your registry with caution!
  353.  
  354.   #
  355.   # Copyright (c) 1999
  356.   # Earl Johhnson
  357.   # earl-johnson@juno.com
  358.   # http://www.erols.com/earl-johnson
  359.   #
  360.   # Permission to use, copy, modify, distribute and sell this software
  361.   # and its documentation for any purpose is hereby granted without fee,
  362.   # provided that the above copyright notice appear in all copies and
  363.   # that both that copyright notice and this permission notice appear
  364.   # in supporting documentation.  Earl Johnson makes no
  365.   # representations about the suitability of this software for any
  366.   # purpose.  It is provided "as is" without express or implied warranty.
  367.   #
  368.  
  369. if {$tcl_platform(platform) == "windows"} { package require registry }
  370.  
  371. # Check whether a key exists for an extension
  372. # Example: shell_assoc_exist .txt => 1
  373. # Example: shell_assoc_exist .NEVER => 0
  374. proc shell_assoc_exist {extension} {
  375.     if {[catch {registry get "HKEY_CLASSES_ROOT\\$extension" ""}]} {set ret 0} {set ret 1}
  376.     return $ret
  377. }
  378.  
  379. # Show whether a file type exists
  380. # Example: shell_fileType_exist txtfile => 1
  381. # Example: shell_fileType_exist NEVER => 0
  382. proc shell_fileType_exist {fileType} {
  383.     if {[catch {registry get "HKEY_CLASSES_ROOT\\$fileType" ""}]} {set ret 0} {set ret 1}
  384.     return $ret
  385. }
  386.  
  387. # Creates a file extension and associates it with fileType.
  388. # Example: shell_fileExtension_setup .txt txtfile
  389. # Remove connection between extension and fileType
  390. # Example: shell_fileExtension_setup .txt ""
  391. proc shell_fileExtension_setup {extension fileType} {
  392.   registry set "HKEY_CLASSES_ROOT\\$extension" "" $fileType
  393. }
  394.  
  395. # Creates a fileType
  396. # Example: shell_fileType_setup txtfile "Text Document"
  397. proc shell_fileType_setup {fileType title} {
  398.   registry set "HKEY_CLASSES_ROOT\\$fileType" "" $title
  399. }
  400.  
  401. # Creates a open command on left click.
  402. # Allows sets action for double click.
  403. # Example: shell_fileType_open txtfile "C:\WINDOWS\NOTEPAD.EXE %1"
  404. # Please note the %1 for passing in file name
  405. proc shell_fileType_open {fileType openCommand} {
  406.    registry set "HKEY_CLASSES_ROOT\\$fileType\\Shell\\open\\command" "" $openCommand"
  407. }
  408.  
  409. # Creates a print command on left click.
  410. # Example: shell_fileType_print txtfile "C:\WINDOWS\NOTEPAD.EXE /p %1"
  411. # Please note the %1 for passing in file name
  412. proc shell_fileType_print {fileType printCommand} {
  413.    registry set "HKEY_CLASSES_ROOT\\$fileType\\Shell\\print\\command" "" $printCommand
  414. }
  415.  
  416. # Sets an icon for a fileType
  417. # Example: shell_fileType_icon txtfile "C:\WINDOWS\SYSTEM\shell32.dll,-152"
  418. # Please note the C:\WINDOWS\SYSTEM\shell32.dll,-152
  419. # We can give a name.ico file or a dll or exe file here.
  420. # If a dll or exe file is used the index for resource
  421. # inside it that gives the icon must be given.
  422. proc shell_fileType_icon {fileType icon} {
  423.    registry set "HKEY_CLASSES_ROOT\\$fileType\\DefaultIcon" "" $icon
  424. }
  425.  
  426. # Sets the quick view for a fileType
  427. proc shell_fileType_quickView {fileType quickViewCmd} {
  428.    registry set "HKEY_CLASSES_ROOT\\$fileType\\QuickView" "" $quickViewCmd
  429. }
  430.  
  431. # This adds any command you like to a fileType
  432. # Example: shell_fileType_addAny_cmd scrfile config "%1"
  433. proc shell_fileType_addAny_cmd {fileType cmdName cmd} {
  434.    registry set "HKEY_CLASSES_ROOT\\[set fileType]\\Shell\\$cmdName\\command" "" $cmd
  435. }
  436.  
  437. # Uses some string instead of actual command on right mouse menu.
  438. proc shell_fileType_setMenuName {fileType cmdName str} {
  439.    registry set "HKEY_CLASSES_ROOT\\$fileType\\Shell\\$cmdName" "" $str
  440. }
  441.  
  442. # Show or not show the extension on the fileType
  443. # Example: shell_fileType_showExt txtfile
  444. proc shell_fileType_showExt {fileType {yesOrNo t}} {
  445.    if {$yesOrNo} {
  446.       registry set "HKEY_CLASSES_ROOT\\$fileType" "AlwaysShowExt" ""
  447.    } {
  448.       registry delete "HKEY_CLASSES_ROOT\\$fileType" "AlwaysShowExt"
  449.      }
  450. }
  451.  
  452. # Over-ride the windows ordering of commands on right click
  453. # Example: shell_fileType_setCmdOrder txtfile {print open}
  454. proc shell_fileType_setCmdOrder {fileType cmds} {
  455.    set str ""
  456.    foreach cmd $cmds {
  457.         append str "$cmd, "
  458.        }
  459.    set slen [string length $str]
  460.    if {$slen > 0} {
  461.      incr slen -3
  462.      set str [string range $str 0 $slen]
  463.      registry set "HKEY_CLASSES_ROOT\\$fileType\\Shell" "" $str
  464.     }
  465. }
  466.  
  467. # Never show extension on fileType
  468. # Example: shell_fileType_neverShowExt txtfile
  469. proc shell_fileType_neverShowExt {fileType {yesOrNo t}} {
  470.    registry set "HKEY_CLASSES_ROOT\\[set fileType]" "NeverShowExt" ""
  471.    if {$yesOrNo} {
  472.       registry set "HKEY_CLASSES_ROOT\\[set fileType]" "NeverShowExt" ""
  473.    } {
  474.       registry delete "HKEY_CLASSES_ROOT\\[set fileType]" "NeverShowExt"
  475.      }
  476. }
  477.  
  478. # Gets all the commands assocated with a extension
  479. # Example: shell_getCmds file.txt => {open print}
  480. proc shell_getCmds {file} {
  481.   set extension [file extension $file]
  482.   if {[catch {set fileType [registry get "HKEY_CLASSES_ROOT\\$extension" ""]} err_str]} {
  483.     puts $err_str; return; # No assocation or fileType
  484.      }
  485.   if {[catch {set cmds [registry keys "HKEY_CLASSES_ROOT\\$fileType\\shell"]} err_str]} {
  486.     puts $err_str return ; # No commands assocated with file Type
  487.      }
  488.   return $cmds
  489. }
  490.  
  491. # Gets the implimentation of command given a file extension
  492. # Example: shell_getCmd_imp test.txt open => C:\WINDOWS\NOTEPAD.EXE %1
  493. proc shell_getCmd_imp {file cmd} {
  494.   set extension [file extension $file]
  495.   if {[catch {set fileType [registry get "HKEY_CLASSES_ROOT\\$extension" ""]} err_str]} {
  496.     puts $err_str; return; # No assocation or fileType
  497.      }
  498.   if {[catch {set imp [registry get "HKEY_CLASSES_ROOT\\$fileType\\shell\\$cmd\\command" ""]} err_str]} {
  499.     puts $err_str return ; # No commands assocated with file Type
  500.      }
  501.   set ret $imp
  502.   return $ret
  503. }
  504.  
  505. # End of file extension association procedures for Windows.
  506.  
  507. # Export ::freewrap procedures
  508. set name {}
  509. set shortname {}
  510. foreach name [info commands ::freewrap::*] {
  511.       set shortname [string range $name 12 end]
  512.       if {[string equal -length 6 $shortname "shell_"]} {
  513.         # shell_ commands can only be used on Windows platforms
  514.         if {$tcl_platform(platform) == "windows"} {
  515.             namespace export $shortname
  516.            } { rename $name {} }
  517.          } { namespace export $shortname }
  518.     }
  519. unset name
  520. unset shortname
  521. }
  522.  
  523. #
  524. # end of ::freeWrap namespace definitions
  525.  
  526. proc newInfo {args} {
  527.     if {$args == {script} && $args != {}} {
  528.         return [lindex $::freewrap::scriptFile end]
  529.        } {
  530.         set cmd "::freewrap::infocmd $args"
  531.             set rc [catch {uplevel 1 $cmd} err]
  532.             if {$rc == 1} {
  533.               set ei [split ${::errorInfo} \n]
  534.               set eilen [llength $ei]
  535.               incr eilen -3
  536.               set line [lindex $ei $eilen]
  537.               incr eilen -1
  538.               set ::errorInfo [join [lrange $ei 0 $eilen] \n]
  539.               #regsub {.*body line ([0-9]*).*} $line {\1} line
  540.               #append ::errorInfo "\n    (file \"$filename\" line $line)"
  541.             } elseif {$rc == 2} { set rc 0 }
  542.             return -code $rc -errorinfo ${::errorInfo} -errorcode ${::errorCode} $err
  543.          }
  544. }
  545.  
  546.  
  547. # Establish proper freeWrap program name for the operating system
  548. # The extname variable is set from the main.c or tclAppInit.c code.
  549. switch $tcl_platform(platform) {
  550.       "unix"    { set ::freewrap::progname "freewrap$extname" }
  551.       "windows"    { set ::freewrap::progname "freewrap[string toupper $extname].exe" }
  552.        default    {
  553.               if {[info exists tk_patchLevel]} {
  554.                         tk_messageBox -parent . -icon warning -type ok -title "freeWrap$extname" -message "Sorry. freeWrap$extname is only supported on Unix and Windows."
  555.                        } { puts "freeWrap$extname: Sorry. freeWrap$extname is only supported on Unix and Windows." }
  556.                     exit 4
  557.             }
  558.      }
  559.  
  560.  
  561. # re-define the INFO command
  562. rename info ::freewrap::infocmd;rename newInfo info
  563.  
  564. # Adjust auto_path variable. Strip out unwanted default paths.
  565. global auto_path
  566. global blt_library
  567.  
  568. set newpath {}
  569. foreach path $auto_path {
  570.     set prefix [string range $path 0 3]
  571.     if {$prefix == {/tcl} || $prefix == {/tk}} {
  572.         lappend newpath $path
  573.        }
  574.       }
  575. set auto_path $newpath
  576. if {$extname == {blt}} {
  577.     lappend auto_path {/blt}
  578.     set blt_library {/blt}
  579.    }
  580.  
  581. # remove variables that are no longer necessary
  582. unset newpath
  583. unset path
  584. unset prefix
  585. unset extname
  586.  
  587. # Load the main application script.
  588. if {[::zvfs::exists /_freewrap_init.txt]} {
  589.     set fin [open /_freewrap_init.txt r]
  590.     gets $fin mainfile
  591.     close $fin
  592.     unset fin
  593.         set mainfile [string trim $mainfile]
  594.       if {[string index $mainfile 1] == {:}} { set mainfile [string range $mainfile 2 end] }
  595.         if {[string index $mainfile 0] != {/}} { set mainfile /$mainfile }
  596.         if {$mainfile != {freewrap.tcl}} { set tcl_interactive 0 }
  597.         if {[catch {source $mainfile} rtnval]} {
  598.             catch {console show}
  599.             puts "Error sourcing $mainfile: $rtnval"
  600.            } {
  601.               if {[info exists mainfile]} {
  602.             if {[file tail $mainfile] == "freewrap.tcl"} {
  603.                 _freewrap_main
  604.                 rename _freewrap_main ""
  605.                }
  606.             unset mainfile
  607.              }
  608.               if {![info exists tk_patchLevel] && $tcl_interactive == 0} {
  609.             exit 0
  610.              }
  611.              }
  612.    } {
  613.       catch {console show}
  614.       puts "freeWrap configuration file (_freewrap_init.txt) not found.\nUnable to determine which script to run."
  615.      }
  616.  
  617.