static const char code[] = "\n\
if {[info commands package] == \"\"} {\n\
error \"version mismatch: library\\nscripts expect Tcl version 7.5b1 or later but the loaded version is\\nonly [info patchlevel]\"\n\
}\n\
package require -exact Tcl 8.0\n\
\n\
\n\
if {![info exists auto_path]} {\n\
if [catch {set auto_path $env(TCLLIBPATH)}] {\n\
set auto_path \"\"\n\
}\n\
}\n\
if {[lsearch -exact $auto_path [info library]] < 0} {\n\
lappend auto_path [info library]\n\
}\n\
catch {\n\
foreach __dir $tcl_pkgPath {\n\
if {[lsearch -exact $auto_path $__dir] < 0} {\n\
lappend auto_path $__dir\n\
}\n\
}\n\
unset __dir\n\
}\n\
\n\
\n\
package unknown tclPkgUnknown\n\
\n\
\n\
if {[info commands exec] == \"\"} {\n\
\n\
\n\
set auto_noexec 1\n\
}\n\
set errorCode \"\"\n\
set errorInfo \"\"\n\
\n\
\n\
if {[info commands tclLog] == \"\"} {\n\
proc tclLog {string} {\n\
catch {puts stderr $string}\n\
}\n\
}\n\
\n\
\n\
\n\
\n\
proc unknown args {\n\
global auto_noexec auto_noload env unknown_pending tcl_interactive\n\
global errorCode errorInfo\n\
\n\
\n\
set savedErrorCode $errorCode\n\
set savedErrorInfo $errorInfo\n\
set name [lindex $args 0]\n\
if ![info exists auto_noload] {\n\
if [info exists unknown_pending($name)] {\n\
return -code error \"self-referential recursion in \\\"unknown\\\" for command \\\"$name\\\"\";\n\
}\n\
set unknown_pending($name) pending;\n\
set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]\n\
unset unknown_pending($name);\n\
if {$ret != 0} {\n\
return -code $ret -errorcode $errorCode \\\n\
\"error while autoloading \\\"$name\\\": $msg\"\n\
}\n\
if ![array size unknown_pending] {\n\
unset unknown_pending\n\
}\n\
if $msg {\n\
set errorCode $savedErrorCode\n\
set errorInfo $savedErrorInfo\n\
set code [catch {uplevel 1 $args} msg]\n\
if {$code ==  1} {\n\
\n\
set new [split $errorInfo \\n]\n\
set new [join [lrange $new 0 [expr [llength $new] - 6]] \\n]\n\
return -code error -errorcode $errorCode \\\n\
-errorinfo $new $msg\n\
} else {\n\
return -code $code $msg\n\
}\n\
}\n\
}\n\
\n\
if {([info level] == 1) && ([info script] == \"\") \\\n\
&& [info exists tcl_interactive] && $tcl_interactive} {\n\
if ![info exists auto_noexec] {\n\
set new [auto_execok $name]\n\
if {$new != \"\"} {\n\
set errorCode $savedErrorCode\n\
set errorInfo $savedErrorInfo\n\
set redir \"\"\n\
if {[info commands console] == \"\"} {\n\
set redir \">&@stdout <@stdin\"\n\
}\n\
return [uplevel exec $redir $new [lrange $args 1 end]]\n\
}\n\
}\n\
set errorCode $savedErrorCode\n\
set errorInfo $savedErrorInfo\n\
if {$name == \"!!\"} {\n\
set newcmd [history event]\n\
} elseif {[regexp {^!(.+)$} $name dummy event]} {\n\
set newcmd [history event $event]\n\
} elseif {[regexp {^\\^([^^]*)\\^([^^]*)\\^?$} $name dummy old new]} {\n\
set newcmd [history event -1]\n\
catch {regsub -all -- $old $newcmd $new newcmd}\n\
}\n\
if [info exists newcmd] {\n\
tclLog $newcmd\n\
history change $newcmd 0\n\
return [uplevel $newcmd]\n\
}\n\
\n\
set ret [catch {set cmds [info commands $name*]} msg]\n\
if {[string compare $name \"::\"] == 0} {\n\
set name \"\"\n\
}\n\
if {$ret != 0} {\n\
return -code $ret -errorcode $errorCode \\\n\
\"error in unknown while checking if \\\"$name\\\" is a unique command abbreviation: $msg\"\n\
}\n\
if {[llength $cmds] == 1} {\n\
return [uplevel [lreplace $args 0 0 $cmds]]\n\
}\n\
if {[llength $cmds] != 0} {\n\
if {$name == \"\"} {\n\
return -code error \"empty command name \\\"\\\"\"\n\
} else {\n\
return -code error \\\n\
\"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n\
}\n\
}\n\
}\n\
return -code error \"invalid command name \\\"$name\\\"\"\n\
}\n\
\n\
\n\
proc auto_load {cmd {namespace {}}} {\n\
global auto_index auto_oldpath auto_path env errorInfo errorCode\n\
\n\
if {[string length $namespace] == 0} {\n\
set namespace [uplevel {namespace current}]\n\
}\n\
set nameList [auto_qualify $cmd $namespace]\n\
lappend nameList $cmd\n\
foreach name $nameList {\n\
if [info exists auto_index($name)] {\n\
uplevel #0 $auto_index($name)\n\
return [expr {[info commands $name] != \"\"}]\n\
}\n\
}\n\
if ![info exists auto_path] {\n\
return 0\n\
}\n\
if [info exists auto_oldpath] {\n\
if {$auto_oldpath == $auto_path} {\n\
return 0\n\
}\n\
}\n\
set auto_oldpath $auto_path\n\
\n\
\n\
set issafe [interp issafe]\n\
for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {\n\
set dir [lindex $auto_path $i]\n\
set f \"\"\n\
if {$issafe} {\n\
catch {source [file join $dir tclIndex]}\n\
} elseif [catch {set f [open [file join $dir tclIndex]]}] {\n\
continue\n\
} else {\n\
set error [catch {\n\
set id [gets $f]\n\
if {$id == \"# Tcl autoload index file, version 2.0\"} {\n\
eval [read $f]\n\
} elseif {$id == \\\n\
\"# Tcl autoload index file: each line identifies a Tcl\"} {\n\
while {[gets $f line] >= 0} {\n\
if {([string index $line 0] == \"#\")\n\
|| ([llength $line] != 2)} {\n\
continue\n\
}\n\
set name [lindex $line 0]\n\
set auto_index($name) \\\n\
\"source [file join $dir [lindex $line 1]]\"\n\
}\n\
} else {\n\
error \\\n\
\"[file join $dir tclIndex] isn't a proper Tcl index file\"\n\
}\n\
} msg]\n\
if {$f != \"\"} {\n\
close $f\n\
}\n\
if $error {\n\
error $msg $errorInfo $errorCode\n\
}\n\
}\n\
}\n\
foreach name $nameList {\n\
if [info exists auto_index($name)] {\n\
uplevel #0 $auto_index($name)\n\
if {[info commands $name] != \"\"} {\n\
return 1\n\
}\n\
}\n\
}\n\
return 0\n\
}\n\
\n\
\n\
proc auto_qualify {cmd namespace} {\n\
\n\
set n [regsub -all {::+} $cmd :: cmd]\n\
\n\
\n\
\n\
if {[regexp {^::(.*)$} $cmd x tail]} {\n\
if {$n > 1} {\n\
return [list $cmd]\n\
} else {\n\
return [list $tail]\n\
}\n\
}\n\
\n\
\n\
if {$n == 0} {\n\
if {[string compare $namespace ::] == 0} {\n\
return [list $cmd]\n\
} else {\n\
return [list ${namespace}::$cmd $cmd]\n\
}\n\
} else {\n\
if {[string compare $namespace ::] == 0} {\n\
return [list ::$cmd]\n\
} else {\n\
return [list ${namespace}::$cmd ::$cmd]\n\
}\n\
}\n\
}\n\
\n\
if {[string compare $tcl_platform(platform) windows] == 0} {\n\
\n\
\n\
proc auto_execok name {\n\
global auto_execs env tcl_platform\n\
\n\
if [info exists auto_execs($name)] {\n\
return $auto_execs($name)\n\
}\n\
set auto_execs($name) \"\"\n\
\n\
if {[lsearch -exact {cls copy date del erase dir echo mkdir md rename \n\
ren rmdir rd time type ver vol} $name] != -1} {\n\
return [set auto_execs($name) [list $env(COMSPEC) /c $name]]\n\
}\n\
\n\
if {[llength [file split $name]] != 1} {\n\
foreach ext {{} .com .exe .bat} {\n\
set file ${name}${ext}\n\
if {[file exists $file] && ![file isdirectory $file]} {\n\
return [set auto_execs($name) [list $file]]\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
set path \"[file dirname [info nameof]];.;\"\n\
if {[info exists env(WINDIR)]} {\n\
set windir $env(WINDIR) \n\
}\n\
if {[info exists windir]} {\n\
if {$tcl_platform(os) == \"Windows NT\"} {\n\
append path \"$windir/system32;\"\n\
}\n\
append path \"$windir/system;$windir;\"\n\
}\n\
\n\
if {[info exists env(PATH)]} {\n\
append path $env(PATH)\n\
}\n\
\n\
foreach dir [split $path {;}] {\n\
if {$dir == \"\"} {\n\
set dir .\n\
}\n\
foreach ext {{} .com .exe .bat} {\n\
set file [file join $dir ${name}${ext}]\n\
if {[file exists $file] && ![file isdirectory $file]} {\n\
return [set auto_execs($name) [list $file]]\n\
}\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
} else {\n\
\n\
\n\
proc auto_execok name {\n\
global auto_execs env\n\
\n\
if [info exists auto_execs($name)] {\n\
return $auto_execs($name)\n\
}\n\
set auto_execs($name) \"\"\n\
if {[llength [file split $name]] != 1} {\n\
if {[file executable $name] && ![file isdirectory $name]} {\n\
set auto_execs($name) [list $name]\n\
}\n\
return $auto_execs($name)\n\
}\n\
foreach dir [split $env(PATH) :] {\n\
if {$dir == \"\"} {\n\
set dir .\n\
}\n\
set file [file join $dir $name]\n\
if {[file executable $file] && ![file isdirectory $file]} {\n\
set auto_execs($name) [list $file]\n\
return $auto_execs($name)\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
}\n\
\n\
proc auto_reset {} {\n\
global auto_execs auto_index auto_oldpath\n\
foreach p [info procs] {\n\
if {[info exists auto_index($p)] && ![string match auto_* $p]\n\
&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup\n\
tclMacPkgSearch tclPkgUnknown} $p] < 0)} {\n\
rename $p {}\n\
}\n\
}\n\
catch {unset auto_execs}\n\
catch {unset auto_index}\n\
catch {unset auto_oldpath}\n\
}\n\
\n\
\n\
proc auto_mkindex {dir args} {\n\
global errorCode errorInfo\n\
set oldDir [pwd]\n\
cd $dir\n\
set dir [pwd]\n\
append index \"# Tcl autoload index file, version 2.0\\n\"\n\
append index \"# This file is generated by the \\\"auto_mkindex\\\" command\\n\"\n\
append index \"# and sourced to set up indexing information for one or\\n\"\n\
append index \"# more commands.  Typically each line is a command that\\n\"\n\
append index \"# sets an element in the auto_index array, where the\\n\"\n\
append index \"# element name is the name of a command and the value is\\n\"\n\
append index \"# a script that loads the command.\\n\\n\"\n\
if {$args == \"\"} {\n\
set args *.tcl\n\
}\n\
foreach file [eval glob $args] {\n\
set f \"\"\n\
set error [catch {\n\
set f [open $file]\n\
while {[gets $f line] >= 0} {\n\
if [regexp {^proc[ 	]+([^ 	]*)} $line match procName] {\n\
set procName [lindex [auto_qualify $procName \"::\"] 0]\n\
append index \"set [list auto_index($procName)]\"\n\
append index \" \\[list source \\[file join \\$dir [list $file]\\]\\]\\n\"\n\
}\n\
}\n\
close $f\n\
} msg]\n\
if $error {\n\
set code $errorCode\n\
set info $errorInfo\n\
catch {close $f}\n\
cd $oldDir\n\
error $msg $info $code\n\
}\n\
}\n\
set f \"\"\n\
set error [catch {\n\
set f [open tclIndex w]\n\
puts $f $index nonewline\n\
close $f\n\
cd $oldDir\n\
} msg]\n\
if $error {\n\
set code $errorCode\n\
set info $errorInfo\n\
catch {close $f}\n\
cd $oldDir\n\
error $msg $info $code\n\
}\n\
}\n\
\n\
\n\
proc pkg_mkIndex {dir args} {\n\
global errorCode errorInfo\n\
if {[llength $args] == 0} {\n\
return -code error \"wrong # args: should be\\\n\
\\\"pkg_mkIndex dir pattern ?pattern ...?\\\"\";\n\
}\n\
append index \"# Tcl package index file, version 1.0\\n\"\n\
append index \"# This file is generated by the \\\"pkg_mkIndex\\\" command\\n\"\n\
append index \"# and sourced either when an application starts up or\\n\"\n\
append index \"# by a \\\"package unknown\\\" script.  It invokes the\\n\"\n\
append index \"# \\\"package ifneeded\\\" command to set up package-related\\n\"\n\
append index \"# information so that packages will be loaded automatically\\n\"\n\
append index \"# in response to \\\"package require\\\" commands.  When this\\n\"\n\
append index \"# script is sourced, the variable \\$dir must contain the\\n\"\n\
append index \"# full path name of this file's directory.\\n\"\n\
set oldDir [pwd]\n\
cd $dir\n\
foreach file [eval glob $args] {\n\
\n\
set c [interp create]\n\
\n\
\n\
foreach pkg [info loaded] {\n\
if {[lindex $pkg 1] == \"Tk\"} {\n\
$c eval {set argv {-geometry +0+0}}\n\
load [lindex $pkg 0] Tk $c\n\
break\n\
}\n\
}\n\
$c eval [list set file $file]\n\
if [catch {\n\
$c eval {\n\
proc dummy args {}\n\
rename package package-orig\n\
proc package {what args} {\n\
switch -- $what {\n\
require { return ; # ignore transitive requires }\n\
default { eval package-orig {$what} $args }\n\
}\n\
}\n\
proc pkgGetAllNamespaces {{root {}}} {\n\
set list $root\n\
foreach ns [namespace children $root] {\n\
eval lappend list [pkgGetAllNamespaces $ns]\n\
}\n\
return $list\n\
}\n\
package unknown dummy\n\
set origCmds [info commands]\n\
set dir \"\"		;# in case file is pkgIndex.tcl\n\
set pkgs \"\"\n\
\n\
\n\
if {[string compare [file extension $file] \\\n\
[info sharedlibextension]] == 0} {\n\
\n\
\n\
load [file join . $file]\n\
set type load\n\
} else {\n\
source $file\n\
set type source\n\
}\n\
foreach ns [pkgGetAllNamespaces] {\n\
namespace import ${ns}::*\n\
}\n\
foreach i [info commands] {\n\
set cmds($i) 1\n\
}\n\
foreach i $origCmds {\n\
catch {unset cmds($i)}\n\
\n\
}\n\
foreach i [array names cmds] {\n\
set absolute [namespace origin $i]\n\
if {[string compare ::$i $absolute] != 0} {\n\
set cmds($absolute) 1\n\
unset cmds($i)\n\
}\n\
}\n\
foreach i [package names] {\n\
if {([string compare [package provide $i] \"\"] != 0)\n\
&& ([string compare $i Tcl] != 0)\n\
&& ([string compare $i Tk] != 0)} {\n\
lappend pkgs [list $i [package provide $i]]\n\
}\n\
}\n\
}\n\
} msg] {\n\
tclLog \"error while loading or sourcing $file: $msg\"\n\
}\n\
foreach pkg [$c eval set pkgs] {\n\
lappend files($pkg) [list $file [$c eval set type] \\\n\
[lsort [$c eval array names cmds]]]\n\
}\n\
interp delete $c\n\
}\n\
foreach pkg [lsort [array names files]] {\n\
append index \"\\npackage ifneeded $pkg\\\n\
\\[list tclPkgSetup \\$dir [lrange $pkg 0 0] [lrange $pkg 1 1]\\\n\
[list $files($pkg)]\\]\"\n\
}\n\
set f [open pkgIndex.tcl w]\n\
puts $f $index\n\
close $f\n\
cd $oldDir\n\
}\n\
\n\
\n\
proc tclPkgSetup {dir pkg version files} {\n\
global auto_index\n\
\n\
package provide $pkg $version\n\
foreach fileInfo $files {\n\
set f [lindex $fileInfo 0]\n\
set type [lindex $fileInfo 1]\n\
foreach cmd [lindex $fileInfo 2] {\n\
if {$type == \"load\"} {\n\
set auto_index($cmd) [list load [file join $dir $f] $pkg]\n\
} else {\n\
set auto_index($cmd) [list source [file join $dir $f]]\n\
} \n\
}\n\
}\n\
}\n\
\n\
\n\
proc tclMacPkgSearch {dir} {\n\
foreach x [glob -nocomplain [file join $dir *.shlb]] {\n\
if [file isfile $x] {\n\
set res [resource open $x]\n\
foreach y [resource list TEXT $res] {\n\
if {$y == \"pkgIndex\"} {source -rsrc pkgIndex}\n\
}\n\
catch {resource close $res}\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tclPkgUnknown {name version {exact {}}} {\n\
global auto_path tcl_platform env\n\
\n\
if ![info exists auto_path] {\n\
return\n\
}\n\
for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {\n\
catch {\n\
foreach file [glob -nocomplain [file join [lindex $auto_path $i] \\\n\
* pkgIndex.tcl]] {\n\
set dir [file dirname $file]\n\
if [catch {source $file} msg] {\n\
tclLog \"error reading package index file $file: $msg\"\n\
}\n\
}\n\
}\n\
set dir [lindex $auto_path $i]\n\
set file [file join $dir pkgIndex.tcl]\n\
if {[interp issafe] || [file readable $file]} {\n\
if {[catch {source $file} msg] && ![interp issafe]}  {\n\
tclLog \"error reading package index file $file: $msg\"\n\
}\n\
}\n\
if {(![interp issafe]) && ($tcl_platform(platform) == \"macintosh\")} {\n\
set dir [lindex $auto_path $i]\n\
tclMacPkgSearch $dir\n\
foreach x [glob -nocomplain [file join $dir *]] {\n\
if [file isdirectory $x] {\n\
set dir $x\n\
tclMacPkgSearch $dir\n\
}\n\
}\n\
}\n\
}\n\
}\n\
\n\
\n\
namespace eval tcl {\n\
variable history\n\
if ![info exists history] {\n\
array set history {\n\
nextid	0\n\
keep	20\n\
oldest	-20\n\
}\n\
}\n\
}\n\
\n\
\n\
proc history {args} {\n\
set len [llength $args]\n\
if {$len == 0} {\n\
return [tcl::HistInfo]\n\
}\n\
set key [lindex $args 0]\n\
set options \"add, change, clear, event, info, keep, nextid, or redo\"\n\
switch -glob -- $key {\n\
a* { # history add\n\
\n\
if {$len > 3} {\n\
return -code error \"wrong # args: should be \\\"history add event ?exec?\\\"\"\n\
}\n\
if {![string match $key* add]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
if {$len == 3} {\n\
set arg [lindex $args 2]\n\
if {! ([string match e* $arg] && [string match $arg* exec])} {\n\
return -code error \"bad argument \\\"$arg\\\": should be \\\"exec\\\"\"\n\
}\n\
}\n\
return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]\n\
}\n\
ch* { # history change\n\
\n\
if {($len > 3) || ($len < 2)} {\n\
return -code error \"wrong # args: should be \\\"history change newValue ?event?\\\"\"\n\
}\n\
if {![string match $key* change]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
if {$len == 2} {\n\
set event 0\n\
} else {\n\
set event [lindex $args 2]\n\
}\n\
\n\
return [tcl::HistChange [lindex $args 1] $event]\n\
}\n\
cl* { # history clear\n\
\n\
if {($len > 1)} {\n\
return -code error \"wrong # args: should be \\\"history clear\\\"\"\n\
}\n\
if {![string match $key* clear]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [tcl::HistClear]\n\
}\n\
e* { # history event\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history event ?event?\\\"\"\n\
}\n\
if {![string match $key* event]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
if {$len == 1} {\n\
set event -1\n\
} else {\n\
set event [lindex $args 1]\n\
}\n\
return [tcl::HistEvent $event]\n\
}\n\
i* { # history info\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history info ?count?\\\"\"\n\
}\n\
if {![string match $key* info]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [tcl::HistInfo [lindex $args 1]]\n\
}\n\
k* { # history keep\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history keep ?count?\\\"\"\n\
}\n\
if {$len == 1} {\n\
return [tcl::HistKeep]\n\
} else {\n\
set limit [lindex $args 1]\n\
if {[catch {expr $limit}] || ($limit < 0)} {\n\
return -code error \"illegal keep count \\\"$limit\\\"\"\n\
}\n\
return [tcl::HistKeep $limit]\n\
}\n\
}\n\
n* { # history nextid\n\
\n\
if {$len > 1} {\n\
return -code error \"wrong # args: should be \\\"history nextid\\\"\"\n\
}\n\
if {![string match $key* nextid]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [expr $tcl::history(nextid) + 1]\n\
}\n\
r* { # history redo\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history redo ?event?\\\"\"\n\
}\n\
if {![string match $key* redo]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [tcl::HistRedo [lindex $args 1]]\n\
}\n\
default {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistAdd {command {exec {}}} {\n\
variable history\n\
set i [incr history(nextid)]\n\
set history($i) $command\n\
set j [incr history(oldest)]\n\
if {[info exists history($j)]} {unset history($j)}\n\
if {[string match e* $exec]} {\n\
return [uplevel #0 $command]\n\
} else {\n\
return {}\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistKeep {{limit {}}} {\n\
variable history\n\
if {[string length $limit] == 0} {\n\
return $history(keep)\n\
} else {\n\
set oldold $history(oldest)\n\
set history(oldest) [expr $history(nextid) - $limit]\n\
for {} {$oldold <= $history(oldest)} {incr oldold} {\n\
if {[info exists history($oldold)]} {unset history($oldold)}\n\
}\n\
set history(keep) $limit\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistClear {} {\n\
variable history\n\
set keep $history(keep)\n\
unset history\n\
array set history [list \\\n\
nextid	0	\\\n\
keep	$keep	\\\n\
oldest	-$keep	\\\n\
]\n\
}\n\
\n\
\n\
proc tcl::HistInfo {{num {}}} {\n\
variable history\n\
if {$num == {}} {\n\
set num [expr $history(keep) + 1]\n\
}\n\
set result {}\n\
set newline \"\"\n\
for {set i [expr $history(nextid) - $num + 1]} \\\n\
{$i <= $history(nextid)} {incr i} {\n\
if ![info exists history($i)] {\n\
continue\n\
}\n\
set cmd [string trimright $history($i) \\ \\n]\n\
regsub -all \\n $cmd \"\\n\\t\" cmd\n\
append result $newline[format \"%6d  %s\" $i $cmd]\n\
set newline \\n\n\
}\n\
return $result\n\
}\n\
\n\
\n\
proc tcl::HistRedo {{event -1}} {\n\
variable history\n\
if {[string length $event] == 0} {\n\
set event -1\n\
}\n\
set i [HistIndex $event]\n\
if {$i == $history(nextid)} {\n\
return -code error \"cannot redo the current event\"\n\
}\n\
set cmd $history($i)\n\
HistChange $cmd 0\n\
uplevel #0 $cmd\n\
}\n\
\n\
\n\
proc tcl::HistIndex {event} {\n\
variable history\n\
if {[catch {expr $event}]} {\n\
for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {\n\
if {[string match $event* $history($i)]} {\n\
return $i;\n\
}\n\
if {[string match $event $history($i)]} {\n\
return $i;\n\
}\n\
}\n\
return -code error \"no event matches \\\"$event\\\"\"\n\
} elseif {$event <= 0} {\n\
set i [expr $history(nextid) + $event]\n\
} else {\n\
set i $event\n\
}\n\
if {$i <= $history(oldest)} {\n\
return -code error \"event \\\"$event\\\" is too far in the past\"\n\
}\n\
if {$i > $history(nextid)} {\n\
return -code error \"event \\\"$event\\\" hasn't occured yet\"\n\
}\n\
return $i\n\
}\n\
\n\
\n\
proc tcl::HistEvent {event} {\n\
variable history\n\
set i [HistIndex $event]\n\
if {[info exists history($i)]} {\n\
return [string trimright $history($i) \\ \\n]\n\
} else {\n\
return \"\";\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistChange {cmd {event 0}} {\n\
variable history\n\
set i [HistIndex $event]\n\
set history($i) $cmd\n\
}\n\
\n\
\n\
if {$tcl_platform(platform) == \"windows\"} {\n\
set tcl_wordchars \"\\[^ \\t\\n\\]\"\n\
set tcl_nonwordchars \"\\[ \\t\\n\\]\"\n\
} else {\n\
set tcl_wordchars {[a-zA-Z0-9_]}\n\
set tcl_nonwordchars {[^a-zA-Z0-9_]}\n\
}\n\
\n\
\n\
proc tcl_wordBreakAfter {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
set str [string range $str $start end]\n\
if [regexp -indices \"$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars\" $str result] {\n\
return [expr [lindex $result 1] + $start]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_wordBreakBefore {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if {[string compare $start end] == 0} {\n\
set start [string length $str]\n\
}\n\
if [regexp -indices \"^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)\" [string range $str 0 $start] result] {\n\
return [lindex $result 1]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_endOfWord {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if [regexp -indices \"$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars\" \\\n\
[string range $str $start end] result] {\n\
return [expr [lindex $result 1] + $start]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_startOfNextWord {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if [regexp -indices \"$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars\" \\\n\
[string range $str $start end] result] {\n\
return [expr [lindex $result 1] + $start]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_startOfPreviousWord {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if {[string compare $start end] == 0} {\n\
set start [string length $str]\n\
}\n\
if [regexp -indices \\\n\
\"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\\$\" \\\n\
[string range $str 0 [expr $start - 1]] result word] {\n\
return [lindex $word 0]\n\
}\n\
return -1\n\
}\n\
\n\
package provide http 2.0	;# This uses Tcl namespaces\n\
\n\
namespace eval http {\n\
variable http\n\
\n\
array set http {\n\
-accept */*\n\
-proxyhost {}\n\
-proxyport {}\n\
-useragent {Tcl http client package 2.0}\n\
-proxyfilter http::ProxyRequired\n\
}\n\
\n\
variable formMap\n\
set alphanumeric	a-zA-Z0-9\n\
\n\
for {set i 1} {$i <= 256} {incr i} {\n\
set c [format %c $i]\n\
if {![string match \\[$alphanumeric\\] $c]} {\n\
set formMap($c) %[format %.2x $i]\n\
}\n\
}\n\
array set formMap {\n\
\" \" +   \\n %0d%0a\n\
}\n\
\n\
namespace export geturl config reset wait formatQuery \n\
}\n\
\n\
\n\
proc http::config {args} {\n\
variable http\n\
set options [lsort [array names http -*]]\n\
set usage [join $options \", \"]\n\
if {[llength $args] == 0} {\n\
set result {}\n\
foreach name $options {\n\
lappend result $name $http($name)\n\
}\n\
return $result\n\
}\n\
regsub -all -- - $options {} options\n\
set pat ^-([join $options |])$\n\
if {[llength $args] == 1} {\n\
set flag [lindex $args 0]\n\
if {[regexp -- $pat $flag]} {\n\
return $http($flag)\n\
} else {\n\
return -code error \"Unknown option $flag, must be: $usage\"\n\
}\n\
} else {\n\
foreach {flag value} $args {\n\
if [regexp -- $pat $flag] {\n\
set http($flag) $value\n\
} else {\n\
return -code error \"Unknown option $flag, must be: $usage\"\n\
}\n\
}\n\
}\n\
}\n\
\n\
proc http::Finish { token {errormsg \"\"} } {\n\
variable $token\n\
upvar 0 $token state\n\
global errorInfo errorCode\n\
if {[string length $errormsg] != 0} {\n\
set state(error) [list $errormsg $errorInfo $errorCode]\n\
set state(status) error\n\
}\n\
catch {close $state(sock)}\n\
catch {after cancel $state(after)}\n\
if {[info exists state(-command)]} {\n\
if {[catch {eval $state(-command) {$token}} err]} {\n\
if {[string length $errormsg] == 0} {\n\
set state(error) [list $err $errorInfo $errorCode]\n\
set state(status) error\n\
}\n\
}\n\
unset state(-command)\n\
}\n\
}\n\
\n\
\n\
proc http::reset { token {why reset} } {\n\
variable $token\n\
upvar 0 $token state\n\
set state(status) $why\n\
catch {fileevent $state(sock) readable {}}\n\
Finish $token\n\
if {[info exists state(error)]} {\n\
set errorlist $state(error)\n\
unset state(error)\n\
eval error $errorlist\n\
}\n\
}\n\
\n\
\n\
\n\
proc http::geturl { url args } {\n\
variable http\n\
if ![info exists http(uid)] {\n\
set http(uid) 0\n\
}\n\
set token [namespace current]::[incr http(uid)]\n\
variable $token\n\
upvar 0 $token state\n\
reset $token\n\
array set state {\n\
-blocksize 	8192\n\
-validate 	0\n\
-headers 	{}\n\
-timeout 	0\n\
state		header\n\
meta		{}\n\
currentsize	0\n\
totalsize	0\n\
type            text/html\n\
body            {}\n\
status		\"\"\n\
}\n\
set options {-blocksize -channel -command -handler -headers \\\n\
-progress -query -validate -timeout}\n\
set usage [join $options \", \"]\n\
regsub -all -- - $options {} options\n\
set pat ^-([join $options |])$\n\
foreach {flag value} $args {\n\
if [regexp $pat $flag] {\n\
if {[info exists state($flag)] && \\\n\
[regexp {^[0-9]+$} $state($flag)] && \\\n\
![regexp {^[0-9]+$} $value]} {\n\
return -code error \"Bad value for $flag ($value), must be integer\"\n\
}\n\
set state($flag) $value\n\
} else {\n\
return -code error \"Unknown option $flag, can be: $usage\"\n\
}\n\
}\n\
if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \\\n\
x proto host y port srvurl]} {\n\
error \"Unsupported URL: $url\"\n\
}\n\
if {[string length $port] == 0} {\n\
set port 80\n\
}\n\
if {[string length $srvurl] == 0} {\n\
set srvurl /\n\
}\n\
if {[string length $proto] == 0} {\n\
set url http://$url\n\
}\n\
set state(url) $url\n\
if {![catch {$http(-proxyfilter) $host} proxy]} {\n\
set phost [lindex $proxy 0]\n\
set pport [lindex $proxy 1]\n\
}\n\
if {$state(-timeout) > 0} {\n\
set state(after) [after $state(-timeout) [list http::reset $token timeout]]\n\
}\n\
if {[info exists phost] && [string length $phost]} {\n\
set srvurl $url\n\
set s [socket $phost $pport]\n\
} else {\n\
set s [socket $host $port]\n\
}\n\
set state(sock) $s\n\
\n\
\n\
fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)\n\
\n\
\n\
catch {fconfigure $s -blocking off}\n\
set len 0\n\
set how GET\n\
if {[info exists state(-query)]} {\n\
set len [string length $state(-query)]\n\
if {$len > 0} {\n\
set how POST\n\
}\n\
} elseif {$state(-validate)} {\n\
set how HEAD\n\
}\n\
puts $s \"$how $srvurl HTTP/1.0\"\n\
puts $s \"Accept: $http(-accept)\"\n\
puts $s \"Host: $host\"\n\
puts $s \"User-Agent: $http(-useragent)\"\n\
foreach {key value} $state(-headers) {\n\
regsub -all \\[\\n\\r\\]  $value {} value\n\
set key [string trim $key]\n\
if {[string length $key]} {\n\
puts $s \"$key: $value\"\n\
}\n\
}\n\
if {$len > 0} {\n\
puts $s \"Content-Length: $len\"\n\
puts $s \"Content-Type: application/x-www-form-urlencoded\"\n\
puts $s \"\"\n\
fconfigure $s -translation {auto binary}\n\
puts $s $state(-query)\n\
} else {\n\
puts $s \"\"\n\
}\n\
flush $s\n\
fileevent $s readable [list http::Event $token]\n\
if {! [info exists state(-command)]} {\n\
wait $token\n\
}\n\
return $token\n\
}\n\
\n\
\n\
proc http::data {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(body)\n\
}\n\
proc http::status {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(status)\n\
}\n\
proc http::code {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(http)\n\
}\n\
proc http::size {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(currentsize)\n\
}\n\
\n\
proc http::Event {token} {\n\
variable $token\n\
upvar 0 $token state\n\
set s $state(sock)\n\
\n\
if [::eof $s] then {\n\
Eof $token\n\
return\n\
}\n\
if {$state(state) == \"header\"} {\n\
set n [gets $s line]\n\
if {$n == 0} {\n\
set state(state) body\n\
if ![regexp -nocase ^text $state(type)] {\n\
fconfigure $s -translation binary\n\
if {[info exists state(-channel)]} {\n\
fconfigure $state(-channel) -translation binary\n\
}\n\
}\n\
if {[info exists state(-channel)] &&\n\
![info exists state(-handler)]} {\n\
fileevent $s readable {}\n\
CopyStart $s $token\n\
}\n\
} elseif {$n > 0} {\n\
if [regexp -nocase {^content-type:(.+)$} $line x type] {\n\
set state(type) [string trim $type]\n\
}\n\
if [regexp -nocase {^content-length:(.+)$} $line x length] {\n\
set state(totalsize) [string trim $length]\n\
}\n\
if [regexp -nocase {^([^:]+):(.+)$} $line x key value] {\n\
lappend state(meta) $key $value\n\
} elseif {[regexp ^HTTP $line]} {\n\
set state(http) $line\n\
}\n\
}\n\
} else {\n\
if [catch {\n\
if {[info exists state(-handler)]} {\n\
set n [eval $state(-handler) {$s $token}]\n\
} else {\n\
set block [read $s $state(-blocksize)]\n\
set n [string length $block]\n\
if {$n >= 0} {\n\
append state(body) $block\n\
}\n\
}\n\
if {$n >= 0} {\n\
incr state(currentsize) $n\n\
}\n\
} err] {\n\
Finish $token $err\n\
} else {\n\
if [info exists state(-progress)] {\n\
eval $state(-progress) {$token $state(totalsize) $state(currentsize)}\n\
}\n\
}\n\
}\n\
}\n\
proc http::CopyStart {s token} {\n\
variable $token\n\
upvar 0 $token state\n\
if [catch {\n\
fcopy $s $state(-channel) -size $state(-blocksize) -command \\\n\
[list http::CopyDone $token]\n\
} err] {\n\
Finish $token $err\n\
}\n\
}\n\
proc http::CopyDone {token count {error {}}} {\n\
variable $token\n\
upvar 0 $token state\n\
set s $state(sock)\n\
incr state(currentsize) $count\n\
if [info exists state(-progress)] {\n\
eval $state(-progress) {$token $state(totalsize) $state(currentsize)}\n\
}\n\
if {([string length $error] != 0)} {\n\
Finish $token $error\n\
} elseif {[::eof $s]} {\n\
Eof $token\n\
} else {\n\
CopyStart $s $token\n\
}\n\
}\n\
proc http::Eof {token} {\n\
variable $token\n\
upvar 0 $token state\n\
if {$state(state) == \"header\"} {\n\
set state(status) eof\n\
} else {\n\
set state(status) ok\n\
}\n\
set state(state) eof\n\
Finish $token\n\
}\n\
\n\
\n\
proc http::wait {token} {\n\
variable $token\n\
upvar 0 $token state\n\
\n\
if {![info exists state(status)] || [string length $state(status)] == 0} {\n\
vwait $token\\(status)\n\
}\n\
if {[info exists state(error)]} {\n\
set errorlist $state(error)\n\
unset state(error)\n\
eval error $errorlist\n\
}\n\
return $state(status)\n\
}\n\
\n\
\n\
proc http::formatQuery {args} {\n\
set result \"\"\n\
set sep \"\"\n\
foreach i $args {\n\
append result  $sep [mapReply $i]\n\
if {$sep != \"=\"} {\n\
set sep =\n\
} else {\n\
set sep &\n\
}\n\
}\n\
return $result\n\
}\n\
\n\
\n\
proc http::mapReply {string} {\n\
variable formMap\n\
set alphanumeric	a-zA-Z0-9\n\
regsub -all \\[^$alphanumeric\\] $string {$formMap(&)} string\n\
regsub -all \\n $string {\\\\n} string\n\
regsub -all \\t $string {\\\\t} string\n\
regsub -all {[][{})\\\\]\\)} $string {\\\\&} string\n\
return [subst $string]\n\
}\n\
\n\
proc http::ProxyRequired {host} {\n\
variable http\n\
if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {\n\
if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {\n\
set http(-proxyport) 8080\n\
}\n\
return [list $http(-proxyhost) $http(-proxyport)]\n\
} else {\n\
return {}\n\
}\n\
}\n\
";
#include "tclcl.h"
EmbeddedTcl et_tcl(code);