/* $Header$ */

#define MODULE_APPINIT

#include <tcl.h>

#include "appinit.h"
#include "build_config.h"
#include "extninit.h"
#include "msgstrs.h"


#define INTERFACE 1
#if INTERFACE
#define ET_TCLARGS ClientData clientData,Tcl_Interp*interp,int argc,char**argv
#define ET_OBJARGS ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj*CONST objv[]
#endif
#define ET_ENABLE_OBJ 0
#define ET_ENABLE_TK 1
#define ET_AUTO_FORK 0
#define ET_STANDALONE 0
#define ET_N_BUILTIN_SCRIPT 31
#define ET_VERSION "3.10"
#define ET_HAVE_APPINIT 0
#define ET_HAVE_PREINIT 0
#define ET_HAVE_MAIN 1
#define ET_HAVE_CUSTOM_MAINLOOP 0
#define ET_EXTENSION 0
#define ET_SHROUD_KEY 0
#define ET_READ_STDIN 0
#define ET_CONSOLE 1
static struct {
  char *zName;
  int (*xProc)(ET_TCLARGS);
} Et_CmdSet[] = {
{0, 0}};
static char Et_zFile0[] = 
"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"
"tcl_findLibrary pkg_compareExtension\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"
"proc tcl_findLibrary {basename version patch initScript enVarName varName} {\n"
"upvar #0 $varName the_library\n"
"global env errorInfo\n"
"set dirs {}\n"
"set errors {}\n"
"if {[info exist the_library] && [string compare $the_library {}]} {\n"
"lappend dirs $the_library\n"
"} else {\n"
"if {[info exists env($enVarName)]} {\n"
"lappend dirs $env($enVarName)\n"
"}\n"
"lappend dirs [file join [file dirname [info library]] \\\n"
"\011\011$basename$version]\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"lappend dirs [file join $parentDir lib $basename$version]\n"
"lappend dirs [file join $grandParentDir lib $basename$version]\n"
"lappend dirs [file join $parentDir library]\n"
"lappend dirs [file join $grandParentDir library]\n"
"if {![regexp {.*[ab][0-9]*} $patch ver]} {\n"
"set ver $version\n"
"}\n"
"lappend dirs [file join $grandParentDir $basename$ver library]\n"
"lappend dirs [file join [file dirname $grandParentDir] $basename$ver library]\n"
"}\n"
"foreach i $dirs {\n"
"set the_library $i\n"
"set file [file join $i $initScript]\n"
"if {[interp issafe] || [file exists $file]} {\n"
"if {![catch {uplevel #0 [list source $file]} msg]} {\n"
"return\n"
"} else {\n"
"append errors \"$file: $msg\\n$errorInfo\\n\"\n"
"}\n"
"}\n"
"}\n"
"set msg \"Can't find a usable $initScript in the following directories: \\n\"\n"
"append msg \"    $dirs\\n\\n\"\n"
"append msg \"$errors\\n\\n\"\n"
"append msg \"This probably means that $basename wasn't installed properly.\\n\"\n"
"error $msg\n"
"}\n"
"if {[interp issafe]} {\n"
"return\011;# Stop sourcing the file here\n"
"}\n"
"proc auto_mkindex {dir args} {\n"
"global errorCode errorInfo\n"
"if {[interp issafe]} {\n"
"error \"can't generate index within safe interpreter\"\n"
"}\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"
"auto_mkindex_parser::init\n"
"foreach file [eval glob $args] {\n"
"if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {\n"
"append index $msg\n"
"} else {\n"
"set code $errorCode\n"
"set info $errorInfo\n"
"cd $oldDir\n"
"error $msg $info $code\n"
"}\n"
"}\n"
"auto_mkindex_parser::cleanup\n"
"set fid [open \"tclIndex\" w]\n"
"puts -nonewline $fid $index\n"
"close $fid\n"
"cd $oldDir\n"
"}\n"
"proc auto_mkindex_old {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 {[string equal $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[ \011]+([^ \011]*)} $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 -nonewline $f $index\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"
"namespace eval auto_mkindex_parser {\n"
"variable parser \"\"          ;# parser used to build index\n"
"variable index \"\"           ;# maintains index as it is built\n"
"variable scriptFile \"\"      ;# name of file being processed\n"
"variable contextStack \"\"    ;# stack of namespace scopes\n"
"variable imports \"\"         ;# keeps track of all imported cmds\n"
"variable initCommands \"\"    ;# list of commands that create aliases\n"
"proc init {} {\n"
"variable parser\n"
"variable initCommands\n"
"if {![interp issafe]} {\n"
"set parser [interp create -safe]\n"
"$parser hide info\n"
"$parser hide rename\n"
"$parser hide proc\n"
"$parser hide namespace\n"
"$parser hide eval\n"
"$parser hide puts\n"
"$parser invokehidden namespace delete ::\n"
"$parser invokehidden proc unknown {args} {}\n"
"$parser expose namespace\n"
"$parser invokehidden rename namespace _%@namespace\n"
"$parser expose eval\n"
"$parser invokehidden rename eval _%@eval\n"
"foreach cmd $initCommands {\n"
"eval $cmd\n"
"}\n"
"}\n"
"}\n"
"proc cleanup {} {\n"
"variable parser\n"
"interp delete $parser\n"
"unset parser\n"
"}\n"
"}\n"
"proc auto_mkindex_parser::mkindex {file} {\n"
"variable parser\n"
"variable index\n"
"variable scriptFile\n"
"variable contextStack\n"
"variable imports\n"
"set scriptFile $file\n"
"set fid [open $file]\n"
"set contents [read $fid]\n"
"close $fid\n"
"regsub -all {\\$} $contents \"\\0\" contents\n"
"set index \"\"\n"
"set contextStack \"\"\n"
"set imports \"\"\n"
"$parser eval $contents\n"
"foreach name $imports {\n"
"catch {$parser eval [list _%@namespace forget $name]}\n"
"}\n"
"return $index\n"
"}\n"
"proc auto_mkindex_parser::hook {cmd} {\n"
"variable initCommands\n"
"lappend initCommands $cmd\n"
"}\n"
"proc auto_mkindex_parser::slavehook {cmd} {\n"
"variable initCommands\n"
"lappend initCommands \"\\$parser eval [list $cmd]\"\n"
"}\n"
"proc auto_mkindex_parser::command {name arglist body} {\n"
"hook [list auto_mkindex_parser::commandInit $name $arglist $body]\n"
"}\n"
"proc auto_mkindex_parser::commandInit {name arglist body} {\n"
"variable parser\n"
"set ns [namespace qualifiers $name]\n"
"set tail [namespace tail $name]\n"
"if {[string equal $ns \"\"]} {\n"
"set fakeName \"[namespace current]::_%@fake_$tail\"\n"
"} else {\n"
"set fakeName \"_%@fake_$name\"\n"
"regsub -all {::} $fakeName \"_\" fakeName\n"
"set fakeName \"[namespace current]::$fakeName\"\n"
"}\n"
"proc $fakeName $arglist $body\n"
"if {[regexp {::} $name]} {\n"
"set exportCmd [list _%@namespace export [namespace tail $name]]\n"
"$parser eval [list _%@namespace eval $ns $exportCmd]\n"
"set alias [namespace tail $fakeName]\n"
"$parser invokehidden proc $name {args} \"_%@eval {$alias} \\$args\"\n"
"$parser alias $alias $fakeName\n"
"} else {\n"
"$parser alias $name $fakeName\n"
"}\n"
"return\n"
"}\n"
"proc auto_mkindex_parser::fullname {name} {\n"
"variable contextStack\n"
"if {![string match ::* $name]} {\n"
"foreach ns $contextStack {\n"
"set name \"${ns}::$name\"\n"
"if {[string match ::* $name]} {\n"
"break\n"
"}\n"
"}\n"
"}\n"
"if {[string equal [namespace qualifiers $name] \"\"]} {\n"
"set name [namespace tail $name]\n"
"} elseif {![string match ::* $name]} {\n"
"set name \"::$name\"\n"
"}\n"
"regsub -all \"\\0\" $name \"\\$\" name\n"
"return $name\n"
"}\n"
"auto_mkindex_parser::command proc {name args} {\n"
"variable index\n"
"variable scriptFile\n"
"append index [list set auto_index([fullname $name])] \\\n"
"\011    [format { [list source [file join $dir %s]]} \\\n"
"\011    [file split $scriptFile]] \"\\n\"\n"
"}\n"
"auto_mkindex_parser::hook {\n"
"if {![catch {package require tbcload}]} {\n"
"if {[llength [info commands tbcload::bcproc]] == 0} {\n"
"auto_load tbcload::bcproc\n"
"}\n"
"load {} tbcload $auto_mkindex_parser::parser\n"
"auto_mkindex_parser::commandInit tbcload::bcproc {name args} {\n"
"variable index\n"
"variable scriptFile\n"
"append index [list set auto_index([fullname $name])] \\\n"
"\011\011    [format { [list source [file join $dir %s]]} \\\n"
"\011\011    [file split $scriptFile]] \"\\n\"\n"
"}\n"
"}\n"
"}\n"
"auto_mkindex_parser::command namespace {op args} {\n"
"switch -- $op {\n"
"eval {\n"
"variable parser\n"
"variable contextStack\n"
"set name [lindex $args 0]\n"
"set args [lrange $args 1 end]\n"
"set contextStack [linsert $contextStack 0 $name]\n"
"$parser eval [list _%@namespace eval $name] $args\n"
"set contextStack [lrange $contextStack 1 end]\n"
"}\n"
"import {\n"
"variable parser\n"
"variable imports\n"
"foreach pattern $args {\n"
"if {[string compare $pattern \"-force\"]} {\n"
"lappend imports $pattern\n"
"}\n"
"}\n"
"catch {$parser eval \"_%@namespace import $args\"}\n"
"}\n"
"}\n"
"}\n"
"return\n"
;
static char Et_zFile1[] = 
"namespace eval tcl {\n"
"variable history\n"
"if {![info exists history]} {\n"
"array set history {\n"
"nextid\0110\n"
"keep\01120\n"
"oldest\011-20\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"
"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"
"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"
"return [tcl::HistChange [lindex $args 1] $event]\n"
"}\n"
"cl* { # history clear\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"
"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"
"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"
"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"
"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"
"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"
"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"
"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"
"proc tcl::HistClear {} {\n"
"variable history\n"
"set keep $history(keep)\n"
"unset history\n"
"array set history [list \\\n"
"\011nextid\0110\011\\\n"
"\011keep\011$keep\011\\\n"
"\011oldest\011-$keep\011\\\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"
"\011    {$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"
"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"
"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"
"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"
"proc tcl::HistChange {cmd {event 0}} {\n"
"variable history\n"
"set i [HistIndex $event]\n"
"set history($i) $cmd\n"
"}\n"
;
static char Et_zFile2[] = 
"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.3\n"
"if {![info exists auto_path]} {\n"
"if {[info exist env(TCLLIBPATH)]} {\n"
"set auto_path $env(TCLLIBPATH)\n"
"} else {\n"
"set auto_path \"\"\n"
"}\n"
"}\n"
"if {[string compare [info library] {}]} {\n"
"foreach __dir [list [info library] [file dirname [info library]]] {\n"
"if {[lsearch -exact $auto_path $__dir] < 0} {\n"
"lappend auto_path $__dir\n"
"}\n"
"}\n"
"}\n"
"set __dir [file join [file dirname [file dirname \\\n"
"\011[info nameofexecutable]]] lib]\n"
"if {[lsearch -exact $auto_path $__dir] < 0} {\n"
"lappend auto_path $__dir\n"
"}\n"
"if {[info exist tcl_pkgPath]} {\n"
"foreach __dir $tcl_pkgPath {\n"
"if {[lsearch -exact $auto_path $__dir] < 0} {\n"
"lappend auto_path $__dir\n"
"}\n"
"}\n"
"}\n"
"if {[info exists __dir]} {\n"
"unset __dir\n"
"}\n"
"if {(![interp issafe]) && [string equal $tcl_platform(platform) \"windows\"]} {\n"
"namespace eval tcl {\n"
"proc envTraceProc {lo n1 n2 op} {\n"
"set x $::env($n2)\n"
"set ::env($lo) $x\n"
"set ::env([string toupper $lo]) $x\n"
"}\n"
"}\n"
"foreach p [array names env] {\n"
"set u [string toupper $p]\n"
"if {[string compare $u $p]} {\n"
"switch -- $u {\n"
"COMSPEC -\n"
"PATH {\n"
"if {![info exists env($u)]} {\n"
"set env($u) $env($p)\n"
"}\n"
"trace variable env($p) w [list tcl::envTraceProc $p]\n"
"trace variable env($u) w [list tcl::envTraceProc $p]\n"
"}\n"
"}\n"
"}\n"
"}\n"
"if {[info exists p]} {\n"
"unset p\n"
"}\n"
"if {[info exists u]} {\n"
"unset u\n"
"}\n"
"if {![info exists env(COMSPEC)]} {\n"
"if {[string equal $tcl_platform(os) \"Windows NT\"]} {\n"
"set env(COMSPEC) cmd.exe\n"
"} else {\n"
"set env(COMSPEC) command.com\n"
"}\n"
"}\n"
"}\n"
"package unknown tclPkgUnknown\n"
"if {[llength [info commands exec]] == 0} {\n"
"set auto_noexec 1\n"
"}\n"
"set errorCode \"\"\n"
"set errorInfo \"\"\n"
"if {[llength [info commands tclLog]] == 0} {\n"
"proc tclLog {string} {\n"
"catch {puts stderr $string}\n"
"}\n"
"}\n"
"proc unknown args {\n"
"global auto_noexec auto_noload env unknown_pending tcl_interactive\n"
"global errorCode errorInfo\n"
"set cmd [lindex $args 0]\n"
"if {[regexp \"^namespace\\[ \\t\\n\\]+inscope\" $cmd] && [llength $cmd] == 4} {\n"
"set arglist [lrange $args 1 end]\n"
"set ret [catch {uplevel $cmd $arglist} result]\n"
"if {$ret == 0} {\n"
"return $result\n"
"} else {\n"
"return -code $ret -errorcode $errorCode $result\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"
"append errorInfo \"\\n    (autoloading \\\"$name\\\")\"\n"
"return -code $ret -errorcode $errorCode -errorinfo $errorInfo $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"
"set new [split $errorInfo \\n]\n"
"set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \\n]\n"
"return -code error -errorcode $errorCode \\\n"
"\011\011\011-errorinfo $new $msg\n"
"} else {\n"
"return -code $code $msg\n"
"}\n"
"}\n"
"}\n"
"if {([info level] == 1) && [string equal [info script] \"\"] \\\n"
"\011    && [info exists tcl_interactive] && $tcl_interactive} {\n"
"if {![info exists auto_noexec]} {\n"
"set new [auto_execok $name]\n"
"if {[string compare {} $new]} {\n"
"set errorCode $savedErrorCode\n"
"set errorInfo $savedErrorInfo\n"
"set redir \"\"\n"
"if {[string equal [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 {[string equal $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"
"set ret [catch {set cmds [info commands $name*]} msg]\n"
"if {[string equal $name \"::\"]} {\n"
"set name \"\"\n"
"}\n"
"if {$ret != 0} {\n"
"return -code $ret -errorcode $errorCode \\\n"
"\011\011\"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]} {\n"
"if {[string equal $name \"\"]} {\n"
"return -code error \"empty command name \\\"\\\"\"\n"
"} else {\n"
"return -code error \\\n"
"\011\011\011\"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n"
"}\n"
"}\n"
"}\n"
"return -code error \"invalid command name \\\"$name\\\"\"\n"
"}\n"
"proc auto_load {cmd {namespace {}}} {\n"
"global auto_index auto_oldpath auto_path\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 {![auto_load_index]} {\n"
"return 0\n"
"}\n"
"foreach name $nameList {\n"
"if {[info exists auto_index($name)]} {\n"
"uplevel #0 $auto_index($name)\n"
"if { ![string equal [namespace which -command $name] \"\"] } {\n"
"return 1\n"
"}\n"
"}\n"
"}\n"
"return 0\n"
"}\n"
"proc auto_load_index {} {\n"
"global auto_index auto_oldpath auto_path errorInfo errorCode\n"
"if {[info exists auto_oldpath] && \\\n"
"\011    [string equal $auto_oldpath $auto_path]} {\n"
"return 0\n"
"}\n"
"set auto_oldpath $auto_path\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 {[string equal $id \\\n"
"\011\011\011\"# Tcl autoload index file, version 2.0\"]} {\n"
"eval [read $f]\n"
"} elseif {[string equal $id \"# Tcl autoload index file: each line identifies a Tcl\"]} {\n"
"while {[gets $f line] >= 0} {\n"
"if {[string equal [string index $line 0] \"#\"] \\\n"
"\011\011\011\011|| ([llength $line] != 2)} {\n"
"continue\n"
"}\n"
"set name [lindex $line 0]\n"
"set auto_index($name) \\\n"
"\011\011\011\011\"source [file join $dir [lindex $line 1]]\"\n"
"}\n"
"} else {\n"
"error \"[file join $dir tclIndex] isn't a proper Tcl index file\"\n"
"}\n"
"} msg]\n"
"if {[string compare $f \"\"]} {\n"
"close $f\n"
"}\n"
"if {$error} {\n"
"error $msg $errorInfo $errorCode\n"
"}\n"
"}\n"
"}\n"
"return 1\n"
"}\n"
"proc auto_qualify {cmd namespace} {\n"
"set n [regsub -all {::+} $cmd :: cmd]\n"
"if {[regexp {^::(.*)$} $cmd x tail]} {\n"
"if {$n > 1} {\n"
"return [list $cmd]\n"
"} else {\n"
"return [list $tail]\n"
"}\n"
"}\n"
"if {$n == 0} {\n"
"if {[string equal $namespace ::]} {\n"
"return [list $cmd]\n"
"} else {\n"
"return [list ${namespace}::$cmd $cmd]\n"
"}\n"
"} elseif {[string equal $namespace ::]} {\n"
"return [list ::$cmd]\n"
"} else {\n"
"return [list ${namespace}::$cmd ::$cmd]\n"
"}\n"
"}\n"
"proc auto_import {pattern} {\n"
"global auto_index\n"
"set ns [uplevel namespace current]\n"
"set patternList [auto_qualify $pattern $ns]\n"
"auto_load_index\n"
"foreach pattern $patternList {\n"
"foreach name [array names auto_index] {\n"
"if {[string match $pattern $name] && \\\n"
"\011\011    [string equal \"\" [info commands $name]]} {\n"
"uplevel #0 $auto_index($name)\n"
"}\n"
"}\n"
"}\n"
"}\n"
"if {[string equal windows $tcl_platform(platform)]} {\n"
"proc auto_execok name {\n"
"global auto_execs env tcl_platform\n"
"if {[info exists auto_execs($name)]} {\n"
"return $auto_execs($name)\n"
"}\n"
"set auto_execs($name) \"\"\n"
"set shellBuiltins [list cls copy date del erase dir echo mkdir \\\n"
"\011    md rename ren rmdir rd time type ver vol]\n"
"if {[string equal $tcl_platform(os) \"Windows NT\"]} {\n"
"lappend shellBuiltins \"start\"\n"
"}\n"
"if {[lsearch -exact $shellBuiltins $name] != -1} {\n"
"return [set auto_execs($name) [list $env(COMSPEC) /c $name]]\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"
"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 {[string equal $tcl_platform(os) \"Windows NT\"]} {\n"
"append path \"$windir/system32;\"\n"
"}\n"
"append path \"$windir/system;$windir;\"\n"
"}\n"
"foreach var {PATH Path path} {\n"
"if {[info exists env($var)]} {\n"
"append path \";$env($var)\"\n"
"}\n"
"}\n"
"foreach dir [split $path {;}] {\n"
"if {[info exists checked($dir)] || [string equal {} $dir]} { continue }\n"
"set checked($dir) {}\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"
"} else {\n"
"proc auto_execok name {\n"
"global auto_execs env\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 {[string equal $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"
;
static char Et_zFile3[] = 
"namespace eval ::pkg {\n"
"}\n"
"proc pkg_compareExtension { fileName {ext {}} } {\n"
"global tcl_platform\n"
"if {[string length $ext] == 0} {\n"
"set ext [info sharedlibextension]\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"windows\"]} {\n"
"return [string equal -nocase [file extension $fileName] $ext]\n"
"} else {\n"
"return [string equal [file extension $fileName] $ext]\n"
"}\n"
"}\n"
"proc pkg_mkIndex {args} {\n"
"global errorCode errorInfo\n"
"set usage {\"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?\"};\n"
"set argCount [llength $args]\n"
"if {$argCount < 1} {\n"
"return -code error \"wrong # args: should be\\n$usage\"\n"
"}\n"
"set more \"\"\n"
"set direct 1\n"
"set doVerbose 0\n"
"set loadPat \"\"\n"
"for {set idx 0} {$idx < $argCount} {incr idx} {\n"
"set flag [lindex $args $idx]\n"
"switch -glob -- $flag {\n"
"-- {\n"
"incr idx\n"
"break\n"
"}\n"
"-verbose {\n"
"set doVerbose 1\n"
"}\n"
"-lazy {\n"
"set direct 0\n"
"append more \" -lazy\"\n"
"}\n"
"-direct {\n"
"append more \" -direct\"\n"
"}\n"
"-load {\n"
"incr idx\n"
"set loadPat [lindex $args $idx]\n"
"append more \" -load $loadPat\"\n"
"}\n"
"-* {\n"
"return -code error \"unknown flag $flag: should be\\n$usage\"\n"
"}\n"
"default {\n"
"break\n"
"}\n"
"}\n"
"}\n"
"set dir [lindex $args $idx]\n"
"set patternList [lrange $args [expr {$idx + 1}] end]\n"
"if {[llength $patternList] == 0} {\n"
"set patternList [list \"*.tcl\" \"*[info sharedlibextension]\"]\n"
"}\n"
"set oldDir [pwd]\n"
"cd $dir\n"
"if {[catch {eval glob $patternList} fileList]} {\n"
"global errorCode errorInfo\n"
"cd $oldDir\n"
"return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList\n"
"}\n"
"foreach file $fileList {\n"
"if {[string equal $file \"pkgIndex.tcl\"]} {\n"
"continue\n"
"}\n"
"cd $oldDir\n"
"set c [interp create]\n"
"foreach pkg [info loaded] {\n"
"if {! [string match $loadPat [lindex $pkg 1]]} {\n"
"continue\n"
"}\n"
"if {[catch {\n"
"load [lindex $pkg 0] [lindex $pkg 1] $c\n"
"} err]} {\n"
"if {$doVerbose} {\n"
"tclLog \"warning: load [lindex $pkg 0] [lindex $pkg 1]\\nfailed with: $err\"\n"
"}\n"
"} elseif {$doVerbose} {\n"
"tclLog \"loaded [lindex $pkg 0] [lindex $pkg 1]\"\n"
"}\n"
"if {[string equal [lindex $pkg 1] \"Tk\"]} {\n"
"$c eval [list wm withdraw .]\n"
"}\n"
"}\n"
"cd $dir\n"
"$c eval {\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 tclPkgUnknown args {}\n"
"package unknown tclPkgUnknown\n"
"proc unknown {args} {}\n"
"proc auto_import {args} {}\n"
"namespace eval ::tcl {\n"
"variable file\011\011;# Current file being processed\n"
"variable direct\011\011;# -direct flag value\n"
"variable x\011\011;# Loop variable\n"
"variable debug\011\011;# For debugging\n"
"variable type\011\011;# \"load\" or \"source\", for -direct\n"
"variable namespaces\011;# Existing namespaces (e.g., ::tcl)\n"
"variable packages\011;# Existing packages (e.g., Tcl)\n"
"variable origCmds\011;# Existing commands\n"
"variable newCmds\011;# Newly created commands\n"
"variable newPkgs {}\011;# Newly created packages\n"
"}\n"
"}\n"
"$c eval [list set ::tcl::file $file]\n"
"$c eval [list set ::tcl::direct $direct]\n"
"foreach p {pkg_compareExtension} {\n"
"$c eval [list proc $p [info args $p] [info body $p]]\n"
"}\n"
"if {[catch {\n"
"$c eval {\n"
"set ::tcl::debug \"loading or sourcing\"\n"
"proc ::tcl::GetAllNamespaces {{root ::}} {\n"
"set list $root\n"
"foreach ns [namespace children $root] {\n"
"eval lappend list [::tcl::GetAllNamespaces $ns]\n"
"}\n"
"return $list\n"
"}\n"
"foreach ::tcl::x [::tcl::GetAllNamespaces] {\n"
"set ::tcl::namespaces($::tcl::x) 1\n"
"}\n"
"foreach ::tcl::x [package names] {\n"
"set ::tcl::packages($::tcl::x) 1\n"
"}\n"
"set ::tcl::origCmds [info commands]\n"
"if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {\n"
"set ::tcl::debug loading\n"
"load [file join . $::tcl::file]\n"
"set ::tcl::type load\n"
"} else {\n"
"set ::tcl::debug sourcing\n"
"source $::tcl::file\n"
"set ::tcl::type source\n"
"}\n"
"if { !$::tcl::direct } {\n"
"foreach ::tcl::x [::tcl::GetAllNamespaces] {\n"
"if {! [info exists ::tcl::namespaces($::tcl::x)]} {\n"
"namespace import -force ${::tcl::x}::*\n"
"}\n"
"foreach ::tcl::x [info commands] {\n"
"set ::tcl::newCmds($::tcl::x) 1\n"
"}\n"
"foreach ::tcl::x $::tcl::origCmds {\n"
"catch {unset ::tcl::newCmds($::tcl::x)}\n"
"}\n"
"foreach ::tcl::x [array names ::tcl::newCmds] {\n"
"set ::tcl::abs [namespace origin $::tcl::x]\n"
"set ::tcl::abs \\\n"
"\011\011\011\011    [lindex [auto_qualify $::tcl::abs ::] 0]\n"
"if {[string compare $::tcl::x $::tcl::abs]} {\n"
"set ::tcl::newCmds($::tcl::abs) 1\n"
"unset ::tcl::newCmds($::tcl::x)\n"
"}\n"
"}\n"
"}\n"
"}\n"
"foreach ::tcl::x [package names] {\n"
"if {[string compare [package provide $::tcl::x] \"\"] \\\n"
"\011\011\011    && ![info exists ::tcl::packages($::tcl::x)]} {\n"
"lappend ::tcl::newPkgs \\\n"
"\011\011\011    [list $::tcl::x [package provide $::tcl::x]]\n"
"}\n"
"}\n"
"}\n"
"} msg] == 1} {\n"
"set what [$c eval set ::tcl::debug]\n"
"if {$doVerbose} {\n"
"tclLog \"warning: error while $what $file: $msg\"\n"
"}\n"
"} else {\n"
"set type [$c eval set ::tcl::type]\n"
"set cmds [lsort [$c eval array names ::tcl::newCmds]]\n"
"set pkgs [$c eval set ::tcl::newPkgs]\n"
"if {[llength $pkgs] > 1} {\n"
"tclLog \"warning: \\\"$file\\\" provides more than one package ($pkgs)\"\n"
"}\n"
"foreach pkg $pkgs {\n"
"lappend files($pkg) [list $file $type $cmds]\n"
"}\n"
"if {$doVerbose} {\n"
"tclLog \"processed $file\"\n"
"}\n"
"interp delete $c\n"
"}\n"
"}\n"
"append index \"# Tcl package index file, version 1.1\\n\"\n"
"append index \"# This file is generated by the \\\"pkg_mkIndex$more\\\" 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"
"foreach pkg [lsort [array names files]] {\n"
"set cmd {}\n"
"foreach {name version} $pkg {\n"
"break\n"
"}\n"
"lappend cmd ::pkg::create -name $name -version $version\n"
"foreach spec $files($pkg) {\n"
"foreach {file type procs} $spec {\n"
"if { $direct } {\n"
"set procs {}\n"
"}\n"
"lappend cmd \"-$type\" [list $file $procs]\n"
"}\n"
"}\n"
"append index \"\\n[eval $cmd]\"\n"
"}\n"
"set f [open pkgIndex.tcl w]\n"
"puts $f $index\n"
"close $f\n"
"cd $oldDir\n"
"}\n"
"proc tclPkgSetup {dir pkg version files} {\n"
"global auto_index\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 {[string equal $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"
"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 {[string equal $y \"pkgIndex\"]} {source -rsrc pkgIndex}\n"
"}\n"
"catch {resource close $res}\n"
"}\n"
"}\n"
"}\n"
"proc tclPkgUnknown {name version {exact {}}} {\n"
"global auto_path tcl_platform env\n"
"if {![info exists auto_path]} {\n"
"return\n"
"}\n"
"set old_path [set use_path $auto_path]\n"
"while {[llength $use_path]} {\n"
"set dir [lindex $use_path end]\n"
"catch {\n"
"foreach file [glob -nocomplain [file join $dir * pkgIndex.tcl]] {\n"
"set dir [file dirname $file]\n"
"if {[file readable $file] && ![info exists procdDirs($dir)]} {\n"
"if {[catch {source $file} msg]} {\n"
"tclLog \"error reading package index file $file: $msg\"\n"
"} else {\n"
"set procdDirs($dir) 1\n"
"}\n"
"}\n"
"}\n"
"}\n"
"set dir [lindex $use_path end]\n"
"set file [file join $dir pkgIndex.tcl]\n"
"if {([interp issafe] || [file readable $file]) && \\\n"
"\011\011![info exists procdDirs($dir)]} {\n"
"if {[catch {source $file} msg] && ![interp issafe]}  {\n"
"tclLog \"error reading package index file $file: $msg\"\n"
"} else {\n"
"set procdDirs($dir) 1\n"
"}\n"
"}\n"
"if {(![interp issafe]) && \\\n"
"\011\011[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"set dir [lindex $use_path end]\n"
"if {![info exists procdDirs($dir)]} {\n"
"tclMacPkgSearch $dir\n"
"set procdDirs($dir) 1\n"
"}\n"
"foreach x [glob -nocomplain [file join $dir *]] {\n"
"if {[file isdirectory $x] && ![info exists procdDirs($x)]} {\n"
"set dir $x\n"
"tclMacPkgSearch $dir\n"
"set procdDirs($dir) 1\n"
"}\n"
"}\n"
"}\n"
"set use_path [lrange $use_path 0 end-1]\n"
"if {[string compare $old_path $auto_path]} {\n"
"foreach dir $auto_path {\n"
"lappend use_path $dir\n"
"}\n"
"set old_path $auto_path\n"
"}\n"
"}\n"
"}\n"
"proc ::pkg::create {args} {\n"
"append err(usage) \"[lindex [info level 0] 0] \"\n"
"append err(usage) \"-name packageName -version packageVersion\"\n"
"append err(usage) \"?-load {filename ?{procs}?}? ... \"\n"
"append err(usage) \"?-source {filename ?{procs}?}? ...\"\n"
"set err(wrongNumArgs) \"wrong # args: should be \\\"$err(usage)\\\"\"\n"
"set err(valueMissing) \"value for \\\"%s\\\" missing: should be \\\"$err(usage)\\\"\"\n"
"set err(unknownOpt)   \"unknown option \\\"%s\\\": should be \\\"$err(usage)\\\"\"\n"
"set err(noLoadOrSource) \"at least one of -load and -source must be given\"\n"
"set len [llength $args]\n"
"if { $len < 6 } {\n"
"error $err(wrongNumArgs)\n"
"}\n"
"set opts(-name)\011\011{}\n"
"set opts(-version)\011\011{}\n"
"set opts(-source)\011\011{}\n"
"set opts(-load)\011\011{}\n"
"for {set i 0} {$i < $len} {incr i} {\n"
"set flag [lindex $args $i]\n"
"incr i\n"
"switch -glob -- $flag {\n"
"\"-name\"\011\011-\n"
"\"-version\"\011\011{\n"
"if { $i >= $len } {\n"
"error [format $err(valueMissing) $flag]\n"
"}\n"
"set opts($flag) [lindex $args $i]\n"
"}\n"
"\"-source\"\011\011-\n"
"\"-load\"\011\011{\n"
"if { $i >= $len } {\n"
"error [format $err(valueMissing) $flag]\n"
"}\n"
"lappend opts($flag) [lindex $args $i]\n"
"}\n"
"default {\n"
"error [format $err(unknownOpt) [lindex $args $i]]\n"
"}\n"
"}\n"
"}\n"
"if { [llength $opts(-name)] == 0 } {\n"
"error [format $err(valueMissing) \"-name\"]\n"
"}\n"
"if { [llength $opts(-version)] == 0 } {\n"
"error [format $err(valueMissing) \"-version\"]\n"
"}\n"
"if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {\n"
"error $err(noLoadOrSource)\n"
"}\n"
"set cmdline \"package ifneeded $opts(-name) $opts(-version) \"\n"
"set cmdList {}\n"
"set lazyFileList {}\n"
"foreach key {load source} {\n"
"foreach filespec $opts(-$key) {\n"
"foreach {filename proclist} {{} {}} {\n"
"break\n"
"}\n"
"foreach {filename proclist} $filespec {\n"
"break\n"
"}\n"
"if { [llength $proclist] == 0 } {\n"
"set cmd \"\\[list $key \\[file join \\$dir [list $filename]\\]\\]\"\n"
"lappend cmdList $cmd\n"
"} else {\n"
"lappend lazyFileList [list $filename $key $proclist]\n"
"}\n"
"}\n"
"}\n"
"if { [llength $lazyFileList] > 0 } {\n"
"lappend cmdList \"\\[list tclPkgSetup \\$dir $opts(-name)\\\n"
"\011\011$opts(-version) [list $lazyFileList]\\]\"\n"
"}\n"
"append cmdline [join $cmdList \"\\\\n\"]\n"
"return $cmdline\n"
"}\n"
;
static char Et_zFile4[] = 
"proc parray {a {pattern *}} {\n"
"upvar 1 $a array\n"
"if {![array exists array]} {\n"
"error \"\\\"$a\\\" isn't an array\"\n"
"}\n"
"set maxl 0\n"
"foreach name [lsort [array names array $pattern]] {\n"
"if {[string length $name] > $maxl} {\n"
"set maxl [string length $name]\n"
"}\n"
"}\n"
"set maxl [expr {$maxl + [string length $a] + 2}]\n"
"foreach name [lsort [array names array $pattern]] {\n"
"set nameString [format %s(%s) $a $name]\n"
"puts stdout [format \"%-*s = %s\" $maxl $nameString $array($name)]\n"
"}\n"
"}\n"
;
static char Et_zFile5[] = 
"package require opt 0.4.1;\n"
"namespace eval ::safe {\n"
"namespace export interpCreate interpInit interpConfigure interpDelete \\\n"
"\011    interpAddToAccessPath interpFindInAccessPath setLogCmd\n"
"set temp [::tcl::OptKeyRegister {\n"
"{-accessPath -list {} \"access path for the slave\"}\n"
"{-noStatics \"prevent loading of statically linked pkgs\"}\n"
"{-statics true \"loading of statically linked pkgs\"}\n"
"{-nestedLoadOk \"allow nested loading\"}\n"
"{-nested false \"nested loading\"}\n"
"{-deleteHook -script {} \"delete hook\"}\n"
"}]\n"
"::tcl::OptKeyRegister {\n"
"{?slave? -name {} \"name of the slave (optional)\"}\n"
"} ::safe::interpCreate\n"
"lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)\n"
"::tcl::OptKeyRegister {\n"
"{slave -name {} \"name of the slave\"}\n"
"} ::safe::interpIC\n"
"lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)\n"
"::tcl::OptKeyDelete $temp\n"
"proc InterpStatics {} {\n"
"foreach v {Args statics noStatics} {\n"
"upvar $v $v\n"
"}\n"
"set flag [::tcl::OptProcArgGiven -noStatics];\n"
"if {$flag && ($noStatics == $statics) \n"
"&& ([::tcl::OptProcArgGiven -statics])} {\n"
"return -code error\\\n"
"\011\011    \"conflicting values given for -statics and -noStatics\"\n"
"}\n"
"if {$flag} {\n"
"return [expr {!$noStatics}]\n"
"} else {\n"
"return $statics\n"
"}\n"
"}\n"
"proc InterpNested {} {\n"
"foreach v {Args nested nestedLoadOk} {\n"
"upvar $v $v\n"
"}\n"
"set flag [::tcl::OptProcArgGiven -nestedLoadOk];\n"
"if {$flag && ($nestedLoadOk != $nested) \n"
"&& ([::tcl::OptProcArgGiven -nested])} {\n"
"return -code error\\\n"
"\011\011    \"conflicting values given for -nested and -nestedLoadOk\"\n"
"}\n"
"if {$flag} {\n"
"return $nestedLoadOk\n"
"} else {\n"
"return $nested\n"
"}\n"
"}\n"
"proc interpCreate {args} {\n"
"set Args [::tcl::OptKeyParse ::safe::interpCreate $args]\n"
"InterpCreate $slave $accessPath \\\n"
"\011\011[InterpStatics] [InterpNested] $deleteHook\n"
"}\n"
"proc interpInit {args} {\n"
"set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n"
"if {![::interp exists $slave]} {\n"
"return -code error \"\\\"$slave\\\" is not an interpreter\"\n"
"}\n"
"InterpInit $slave $accessPath \\\n"
"\011\011[InterpStatics] [InterpNested] $deleteHook;\n"
"}\n"
"proc CheckInterp {slave} {\n"
"if {![IsInterp $slave]} {\n"
"return -code error \\\n"
"\011\011    \"\\\"$slave\\\" is not an interpreter managed by ::safe::\"\n"
"}\n"
"}\n"
"proc interpConfigure {args} {\n"
"switch [llength $args] {\n"
"1 {\n"
"set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n"
"CheckInterp $slave\n"
"set res {}\n"
"lappend res [list -accessPath [Set [PathListName $slave]]]\n"
"lappend res [list -statics    [Set [StaticsOkName $slave]]]\n"
"lappend res [list -nested     [Set [NestedOkName $slave]]]\n"
"lappend res [list -deleteHook [Set [DeleteHookName $slave]]]\n"
"join $res\n"
"}\n"
"2 {\n"
"::tcl::Lassign $args slave arg\n"
"set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]\n"
"set hits [::tcl::OptHits desc $arg]\n"
"if {$hits > 1} {\n"
"return -code error [::tcl::OptAmbigous $desc $arg]\n"
"} elseif {$hits == 0} {\n"
"return -code error [::tcl::OptFlagUsage $desc $arg]\n"
"}\n"
"CheckInterp $slave\n"
"set item [::tcl::OptCurDesc $desc]\n"
"set name [::tcl::OptName $item]\n"
"switch -exact -- $name {\n"
"-accessPath {\n"
"return [list -accessPath [Set [PathListName $slave]]]\n"
"}\n"
"-statics {\n"
"return [list -statics    [Set [StaticsOkName $slave]]]\n"
"}\n"
"-nested {\n"
"return [list -nested     [Set [NestedOkName $slave]]]\n"
"}\n"
"-deleteHook {\n"
"return [list -deleteHook [Set [DeleteHookName $slave]]]\n"
"}\n"
"-noStatics {\n"
"return -code error\\\n"
"\011\011\011\011\"ambigous query (get or set -noStatics ?)\\\n"
"\011\011\011\011use -statics instead\"\n"
"}\n"
"-nestedLoadOk {\n"
"return -code error\\\n"
"\011\011\011\011\"ambigous query (get or set -nestedLoadOk ?)\\\n"
"\011\011\011\011use -nested instead\"\n"
"}\n"
"default {\n"
"return -code error \"unknown flag $name (bug)\"\n"
"}\n"
"}\n"
"}\n"
"default {\n"
"set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n"
"CheckInterp $slave\n"
"if {![::tcl::OptProcArgGiven -accessPath]} {\n"
"set doreset 1\n"
"set accessPath [Set [PathListName $slave]]\n"
"} else {\n"
"set doreset 0\n"
"}\n"
"if {(![::tcl::OptProcArgGiven -statics]) \\\n"
"\011\011\011&& (![::tcl::OptProcArgGiven -noStatics]) } {\n"
"set statics    [Set [StaticsOkName $slave]]\n"
"} else {\n"
"set statics    [InterpStatics]\n"
"}\n"
"if {([::tcl::OptProcArgGiven -nested]) \\\n"
"\011\011\011|| ([::tcl::OptProcArgGiven -nestedLoadOk]) } {\n"
"set nested     [InterpNested]\n"
"} else {\n"
"set nested     [Set [NestedOkName $slave]]\n"
"}\n"
"if {![::tcl::OptProcArgGiven -deleteHook]} {\n"
"set deleteHook [Set [DeleteHookName $slave]]\n"
"}\n"
"InterpSetConfig $slave $accessPath $statics $nested $deleteHook\n"
"if {$doreset} {\n"
"if {[catch {::interp eval $slave {auto_reset}} msg]} {\n"
"Log $slave \"auto_reset failed: $msg\"\n"
"} else {\n"
"Log $slave \"successful auto_reset\" NOTICE\n"
"}\n"
"}\n"
"}\n"
"}\n"
"}\n"
"proc ::safe::InterpCreate {\n"
"slave \n"
"access_path\n"
"staticsok\n"
"nestedok\n"
"deletehook\n"
"} {\n"
"if {[string compare \"\" $slave]} {\n"
"::interp create -safe $slave\n"
"} else {\n"
"set slave [::interp create -safe]\n"
"}\n"
"Log $slave \"Created\" NOTICE\n"
"InterpInit $slave $access_path $staticsok $nestedok $deletehook\n"
"}\n"
"proc ::safe::InterpSetConfig {slave access_path staticsok\\\n"
"\011    nestedok deletehook} {\n"
"if {[string equal \"\" $access_path]} {\n"
"set access_path [uplevel #0 set auto_path]\n"
"set where [lsearch -exact $access_path [info library]]\n"
"if {$where == -1} {\n"
"set access_path [concat [list [info library]] $access_path]\n"
"Log $slave \"tcl_library was not in auto_path,\\\n"
"\011\011\011added it to slave's access_path\" NOTICE\n"
"} elseif {$where != 0} {\n"
"set access_path [concat [list [info library]]\\\n"
"\011\011\011[lreplace $access_path $where $where]]\n"
"Log $slave \"tcl_libray was not in first in auto_path,\\\n"
"\011\011\011moved it to front of slave's access_path\" NOTICE\n"
"}\n"
"set access_path [AddSubDirs $access_path]\n"
"}\n"
"Log $slave \"Setting accessPath=($access_path) staticsok=$staticsok\\\n"
"\011\011nestedok=$nestedok deletehook=($deletehook)\" NOTICE\n"
"set nname [PathNumberName $slave]\n"
"if {[Exists $nname]} {\n"
"set n [Set $nname]\n"
"for {set i 0} {$i<$n} {incr i} {\n"
"Unset [PathToken $i $slave]\n"
"}\n"
"}\n"
"set slave_auto_path {}\n"
"set i 0\n"
"foreach dir $access_path {\n"
"Set [PathToken $i $slave] $dir\n"
"lappend slave_auto_path \"\\$[PathToken $i]\"\n"
"incr i\n"
"}\n"
"Set $nname $i\n"
"Set [PathListName $slave] $access_path\n"
"Set [VirtualPathListName $slave] $slave_auto_path\n"
"Set [StaticsOkName $slave] $staticsok\n"
"Set [NestedOkName $slave] $nestedok\n"
"Set [DeleteHookName $slave] $deletehook\n"
"SyncAccessPath $slave\n"
"}\n"
"proc ::safe::interpFindInAccessPath {slave path} {\n"
"set access_path [GetAccessPath $slave]\n"
"set where [lsearch -exact $access_path $path]\n"
"if {$where == -1} {\n"
"return -code error \"$path not found in access path $access_path\"\n"
"}\n"
"return \"\\$[PathToken $where]\"\n"
"}\n"
"proc ::safe::interpAddToAccessPath {slave path} {\n"
"if {![catch {interpFindInAccessPath $slave $path} res]} {\n"
"return $res\n"
"}\n"
"set nname [PathNumberName $slave]\n"
"set n [Set $nname]\n"
"Set [PathToken $n $slave] $path\n"
"set token \"\\$[PathToken $n]\"\n"
"Lappend [VirtualPathListName $slave] $token\n"
"Lappend [PathListName $slave] $path\n"
"Set $nname [expr {$n+1}]\n"
"SyncAccessPath $slave\n"
"return $token\n"
"}\n"
"proc ::safe::InterpInit {\n"
"slave \n"
"access_path\n"
"staticsok\n"
"nestedok\n"
"deletehook\n"
"} {\n"
"InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook\n"
"::interp alias $slave source {} [namespace current]::AliasSource $slave\n"
"::interp alias $slave load {} [namespace current]::AliasLoad $slave\n"
"::interp alias $slave encoding {} [namespace current]::AliasEncoding \\\n"
"\011\011$slave\n"
"AliasSubset $slave file file dir.* join root.* ext.* tail \\\n"
"\011\011path.* split\n"
"::interp alias $slave exit {} [namespace current]::interpDelete $slave\n"
"if {[catch {::interp eval $slave\\\n"
"\011\011{source [file join $tcl_library init.tcl]}} msg]} {\n"
"Log $slave \"can't source init.tcl ($msg)\"\n"
"error \"can't source init.tcl into slave $slave ($msg)\"\n"
"}\n"
"return $slave\n"
"}\n"
"proc AddSubDirs {pathList} {\n"
"set res {}\n"
"foreach dir $pathList {\n"
"if {[file isdirectory $dir]} {\n"
"if {[lsearch -exact $res $dir]<0} {\n"
"lappend res $dir\n"
"}\n"
"foreach sub [glob -nocomplain -- [file join $dir *]] {\n"
"if {([file isdirectory $sub]) \\\n"
"\011\011\011    && ([lsearch -exact $res $sub]<0) } {\n"
"lappend res $sub\n"
"}\n"
"}\n"
"}\n"
"}\n"
"return $res\n"
"}\n"
"proc ::safe::interpDelete {slave} {\n"
"Log $slave \"About to delete\" NOTICE\n"
"set hookname [DeleteHookName $slave]\n"
"if {[Exists $hookname]} {\n"
"set hook [Set $hookname]\n"
"if {![::tcl::Lempty $hook]} {\n"
"Unset $hookname\n"
"if {[catch {eval $hook [list $slave]} err]} {\n"
"Log $slave \"Delete hook error ($err)\"\n"
"}\n"
"}\n"
"}\n"
"set statename [InterpStateName $slave]\n"
"if {[Exists $statename]} {\n"
"Unset $statename\n"
"}\n"
"if {[::interp exists $slave]} {\n"
"::interp delete $slave\n"
"Log $slave \"Deleted\" NOTICE\n"
"}\n"
"return\n"
"}\n"
"proc ::safe::setLogCmd {args} {\n"
"variable Log\n"
"if {[llength $args] == 0} {\n"
"return $Log\n"
"} else {\n"
"if {[llength $args] == 1} {\n"
"set Log [lindex $args 0]\n"
"} else {\n"
"set Log $args\n"
"}\n"
"}\n"
"}\n"
"variable Log {}\n"
"proc SyncAccessPath {slave} {\n"
"set slave_auto_path [Set [VirtualPathListName $slave]]\n"
"::interp eval $slave [list set auto_path $slave_auto_path]\n"
"Log $slave \"auto_path in $slave has been set to $slave_auto_path\"\\\n"
"\011\011NOTICE\n"
"::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]]\n"
"}\n"
"proc InterpStateName {slave} {\n"
"return \"S$slave\"\n"
"}\n"
"proc IsInterp {slave} {\n"
"expr {[Exists [InterpStateName $slave]] && [::interp exists $slave]}\n"
"}\n"
"proc PathToken {n {slave \"\"}} {\n"
"if {[string compare \"\" $slave]} {\n"
"return \"[InterpStateName $slave](access_path,$n)\"\n"
"} else {\n"
"return \"p(:$n:)\"\n"
"}\n"
"}\n"
"proc PathListName {slave} {\n"
"return \"[InterpStateName $slave](access_path)\"\n"
"}\n"
"proc VirtualPathListName {slave} {\n"
"return \"[InterpStateName $slave](access_path_slave)\"\n"
"}\n"
"proc PathNumberName {slave} {\n"
"return \"[InterpStateName $slave](access_path,n)\"\n"
"}\n"
"proc StaticsOkName {slave} {\n"
"return \"[InterpStateName $slave](staticsok)\"\n"
"}\n"
"proc NestedOkName {slave} {\n"
"return \"[InterpStateName $slave](nestedok)\"\n"
"}\n"
"proc Toplevel {args} {\n"
"namespace eval [namespace current] $args\n"
"}\n"
"proc Set {args} {\n"
"eval Toplevel set $args\n"
"}\n"
"proc Lappend {args} {\n"
"eval Toplevel lappend $args\n"
"}\n"
"proc Unset {args} {\n"
"eval Toplevel unset $args\n"
"}\n"
"proc Exists {varname} {\n"
"Toplevel info exists $varname\n"
"}\n"
"proc GetAccessPath {slave} {\n"
"Set [PathListName $slave]\n"
"}\n"
"proc StaticsOk {slave} {\n"
"Set [StaticsOkName $slave]\n"
"}\n"
"proc NestedOk {slave} {\n"
"Set [NestedOkName $slave]\n"
"}\n"
"proc DeleteHookName {slave} {\n"
"return [InterpStateName $slave](cleanupHook)\n"
"}\n"
"proc TranslatePath {slave path} {\n"
"if {[regexp {(::)|(\\.\\.)} $path]} {\n"
"error \"invalid characters in path $path\"\n"
"}\n"
"set n [expr {[Set [PathNumberName $slave]]-1}]\n"
"for {} {$n>=0} {incr n -1} {\n"
"set [PathToken $n] [Set [PathToken $n $slave]]\n"
"}\n"
"subst -nobackslashes -nocommands $path\n"
"}\n"
"proc Log {slave msg {type ERROR}} {\n"
"variable Log\n"
"if {[info exists Log] && [llength $Log]} {\n"
"eval $Log [list \"$type for slave $slave : $msg\"]\n"
"}\n"
"}\n"
"proc CheckFileName {slave file} {\n"
"set ftail [file tail $file]\n"
"if {[string length $ftail]>14} {\n"
"error \"$ftail: filename too long\"\n"
"}\n"
"if {[regexp {\\..*\\.} $ftail]} {\n"
"error \"$ftail: more than one dot is forbidden\"\n"
"}\n"
"if {[string compare $ftail \"tclIndex\"] && \\\n"
"\011\011[string compare -nocase [file extension $ftail]\011\".tcl\"]} {\n"
"error \"$ftail: must be a *.tcl or tclIndex\"\n"
"}\n"
"if {![file exists $file]} {\n"
"error \"no such file or directory\"\n"
"}\n"
"if {![file readable $file]} {\n"
"error \"not readable\"\n"
"}\n"
"}\n"
"proc AliasSource {slave args} {\n"
"set argc [llength $args]\n"
"if {$argc != 1} {\n"
"set msg \"wrong # args: should be \\\"source fileName\\\"\"\n"
"Log $slave \"$msg ($args)\"\n"
"return -code error $msg\n"
"}\n"
"set file [lindex $args 0]\n"
"if {[catch {set file [TranslatePath $slave $file]} msg]} {\n"
"Log $slave $msg\n"
"return -code error \"permission denied\"\n"
"}\n"
"if {[catch {FileInAccessPath $slave $file} msg]} {\n"
"Log $slave $msg\n"
"return -code error \"permission denied\"\n"
"}\n"
"if {[catch {CheckFileName $slave $file} msg]} {\n"
"Log $slave \"$file:$msg\"\n"
"return -code error $msg\n"
"}\n"
"if {[catch {::interp invokehidden $slave source $file} msg]} {\n"
"Log $slave $msg\n"
"return -code error \"script error\"\n"
"}\n"
"return $msg\n"
"}\n"
"proc AliasLoad {slave file args} {\n"
"set argc [llength $args]\n"
"if {$argc > 2} {\n"
"set msg \"load error: too many arguments\"\n"
"Log $slave \"$msg ($argc) {$file $args}\"\n"
"return -code error $msg\n"
"}\n"
"set package [lindex $args 0]\n"
"set target [lindex $args 1]\n"
"if {[string length $target]} {\n"
"if {![NestedOk $slave]} {\n"
"Log $slave \"loading to a sub interp (nestedok)\\\n"
"\011\011\011disabled (trying to load $package to $target)\"\n"
"return -code error \"permission denied (nested load)\"\n"
"}\n"
"}\n"
"if {[string length $file] == 0} {\n"
"if {[string length $package] == 0} {\n"
"set msg \"load error: empty filename and no package name\"\n"
"Log $slave $msg\n"
"return -code error $msg\n"
"}\n"
"if {![StaticsOk $slave]} {\n"
"Log $slave \"static packages loading disabled\\\n"
"\011\011\011(trying to load $package to $target)\"\n"
"return -code error \"permission denied (static package)\"\n"
"}\n"
"} else {\n"
"if {[catch {set file [TranslatePath $slave $file]} msg]} {\n"
"Log $slave $msg\n"
"return -code error \"permission denied\"\n"
"}\n"
"if {[catch {FileInAccessPath $slave $file} msg]} {\n"
"Log $slave $msg\n"
"return -code error \"permission denied (path)\"\n"
"}\n"
"}\n"
"if {[catch {::interp invokehidden\\\n"
"\011\011$slave load $file $package $target} msg]} {\n"
"Log $slave $msg\n"
"return -code error $msg\n"
"}\n"
"return $msg\n"
"}\n"
"proc FileInAccessPath {slave file} {\n"
"set access_path [GetAccessPath $slave]\n"
"if {[file isdirectory $file]} {\n"
"error \"\\\"$file\\\": is a directory\"\n"
"}\n"
"set parent [file dirname $file]\n"
"if {[lsearch -exact $access_path $parent] == -1} {\n"
"error \"\\\"$file\\\": not in access_path\"\n"
"}\n"
"}\n"
"proc Subset {slave command okpat args} {\n"
"set subcommand [lindex $args 0]\n"
"if {[regexp $okpat $subcommand]} {\n"
"return [eval {$command $subcommand} [lrange $args 1 end]]\n"
"}\n"
"set msg \"not allowed to invoke subcommand $subcommand of $command\"\n"
"Log $slave $msg\n"
"error $msg\n"
"}\n"
"proc AliasSubset {slave alias target args} {\n"
"set pat ^(; set sep \"\"\n"
"foreach sub $args {\n"
"append pat $sep$sub\n"
"set sep |\n"
"}\n"
"append pat )\\$\n"
"::interp alias $slave $alias {}\\\n"
"\011\011[namespace current]::Subset $slave $target $pat\n"
"}\n"
"proc AliasEncoding {slave args} {\n"
"set argc [llength $args]\n"
"set okpat \"^(name.*|convert.*)\\$\"\n"
"set subcommand [lindex $args 0]\n"
"if {[regexp $okpat $subcommand]} {\n"
"return [eval ::interp invokehidden $slave encoding $subcommand \\\n"
"\011\011    [lrange $args 1 end]]\n"
"}\n"
"if {[string match $subcommand system]} {\n"
"if {$argc == 1} {\n"
"if {[catch {::interp invokehidden \\\n"
"\011\011\011$slave encoding system} msg]} {\n"
"Log $slave $msg\n"
"return -code error \"script error\"\n"
"}\n"
"} else {\n"
"set msg \"wrong # args: should be \\\"encoding system\\\"\"\n"
"Log $slave $msg\n"
"error $msg\n"
"}\n"
"} else {\n"
"set msg \"wrong # args: should be \\\"encoding option ?arg ...?\\\"\"\n"
"Log $slave $msg\n"
"error $msg\n"
"}\n"
"return $msg\n"
"}\n"
"}\n"
;
static char Et_zFile6[] = 
"# Tcl autoload index file, version 2.0\n"
"# This file is generated by the \"auto_mkindex\" command\n"
"# and sourced to set up indexing information for one or\n"
"# more commands.  Typically each line is a command that\n"
"# sets an element in the auto_index array, where the\n"
"# element name is the name of a command and the value is\n"
"# a script that loads the command.\n"
"\n"
"set auto_index(auto_reset) [list source [file join $dir auto.tcl]]\n"
"set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]\n"
"set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]\n"
"set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]\n"
"set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]\n"
"set auto_index(history) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]\n"
"set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]\n"
"set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]\n"
"set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]]\n"
"set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]\n"
"set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]\n"
"set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]]\n"
"set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]\n"
"set auto_index(::pkg::create) [list source [file join $dir package.tcl]]\n"
"set auto_index(parray) [list source [file join $dir parray.tcl]]\n"
"set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]\n"
"set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]\n"
"set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]\n"
"set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]\n"
;
static char Et_zFile7[] = 
"if {[string equal $tcl_platform(platform) \"windows\"]} {\n"
"set tcl_wordchars \"\\\\S\"\n"
"set tcl_nonwordchars \"\\\\s\"\n"
"} else {\n"
"set tcl_wordchars \"\\\\w\"\n"
"set tcl_nonwordchars \"\\\\W\"\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"
"proc tcl_wordBreakBefore {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[string equal $start end]} {\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"
"proc tcl_endOfWord {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[regexp -indices \"$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars\" \\\n"
"\011    [string range $str $start end] result]} {\n"
"return [expr {[lindex $result 1] + $start}]\n"
"}\n"
"return -1\n"
"}\n"
"proc tcl_startOfNextWord {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[regexp -indices \"$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars\" \\\n"
"\011    [string range $str $start end] result]} {\n"
"return [expr {[lindex $result 1] + $start}]\n"
"}\n"
"return -1\n"
"}\n"
"proc tcl_startOfPreviousWord {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[string equal $start end]} {\n"
"set start [string length $str]\n"
"}\n"
"if {[regexp -indices \\\n"
"\011    \"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\\$\" \\\n"
"\011    [string range $str 0 [expr {$start - 1}]] result word]} {\n"
"return [lindex $word 0]\n"
"}\n"
"return -1\n"
"}\n"
;
static char Et_zFile8[] = 
"proc bgerror err {\n"
"global errorInfo tcl_platform\n"
"set info $errorInfo ;\n"
"set ret [catch {tkerror $err} msg];\n"
"if {$ret != 1} {return -code $ret $msg}\n"
"if {$tcl_platform(platform) == \"macintosh\"} {\n"
"set ok Ok\n"
"} else {\n"
"set ok OK\n"
"}\n"
"set button [tk_dialog .bgerrorDialog \"Error in Tcl Script\" \\\n"
"\011    \"Error: $err\" error 0 $ok \"Skip Messages\" \"Stack Trace\"]\n"
"if {$button == 0} {\n"
"return\n"
"} elseif {$button == 1} {\n"
"return -code break\n"
"}\n"
"set w .bgerrorTrace\n"
"catch {destroy $w}\n"
"toplevel $w -class ErrorTrace\n"
"wm minsize $w 1 1\n"
"wm title $w \"Stack Trace for Error\"\n"
"wm iconname $w \"Stack Trace\"\n"
"button $w.ok -text OK -command \"destroy $w\" -default active\n"
"if {![string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \\\n"
"\011    -yscrollcommand \"$w.scroll set\" -width 60 -height 20\n"
"} else {\n"
"text $w.text -relief sunken -bd 2 -yscrollcommand \"$w.scroll set\" \\\n"
"\011    -setgrid true -width 60 -height 20\n"
"}\n"
"scrollbar $w.scroll -relief sunken -command \"$w.text yview\"\n"
"pack $w.ok -side bottom -padx 3m -pady 2m\n"
"pack $w.scroll -side right -fill y\n"
"pack $w.text -side left -expand yes -fill both\n"
"$w.text insert 0.0 $info\n"
"$w.text mark set insert 0.0\n"
"bind $w <Return> \"destroy $w\"\n"
"bind $w.text <Return> \"destroy $w; break\"\n"
"wm withdraw $w\n"
"update idletasks\n"
"set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
"\011    - [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"\011    - [winfo vrooty [winfo parent $w]]}]\n"
"wm geom $w +$x+$y\n"
"wm deiconify $w\n"
"if {[string compare [grab current .] \"\"]} {\n"
"grab release [grab current .]\n"
"}\n"
"}\n"
;
static char Et_zFile9[] = 
"if {[string match \"macintosh\" $tcl_platform(platform)]} {\n"
"bind Radiobutton <Enter> {\n"
"tkButtonEnter %W\n"
"}\n"
"bind Radiobutton <1> {\n"
"tkButtonDown %W\n"
"}\n"
"bind Radiobutton <ButtonRelease-1> {\n"
"tkButtonUp %W\n"
"}\n"
"bind Checkbutton <Enter> {\n"
"tkButtonEnter %W\n"
"}\n"
"bind Checkbutton <1> {\n"
"tkButtonDown %W\n"
"}\n"
"bind Checkbutton <ButtonRelease-1> {\n"
"tkButtonUp %W\n"
"}\n"
"}\n"
"if {[string match \"windows\" $tcl_platform(platform)]} {\n"
"bind Checkbutton <equal> {\n"
"tkCheckRadioInvoke %W select\n"
"}\n"
"bind Checkbutton <plus> {\n"
"tkCheckRadioInvoke %W select\n"
"}\n"
"bind Checkbutton <minus> {\n"
"tkCheckRadioInvoke %W deselect\n"
"}\n"
"bind Checkbutton <1> {\n"
"tkCheckRadioDown %W\n"
"}\n"
"bind Checkbutton <ButtonRelease-1> {\n"
"tkButtonUp %W\n"
"}\n"
"bind Checkbutton <Enter> {\n"
"tkCheckRadioEnter %W\n"
"}\n"
"bind Radiobutton <1> {\n"
"tkCheckRadioDown %W\n"
"}\n"
"bind Radiobutton <ButtonRelease-1> {\n"
"tkButtonUp %W\n"
"}\n"
"bind Radiobutton <Enter> {\n"
"tkCheckRadioEnter %W\n"
"}\n"
"}\n"
"if {[string match \"unix\" $tcl_platform(platform)]} {\n"
"bind Checkbutton <Return> {\n"
"if {!$tk_strictMotif} {\n"
"tkCheckRadioInvoke %W\n"
"}\n"
"}\n"
"bind Radiobutton <Return> {\n"
"if {!$tk_strictMotif} {\n"
"tkCheckRadioInvoke %W\n"
"}\n"
"}\n"
"bind Checkbutton <1> {\n"
"tkCheckRadioInvoke %W\n"
"}\n"
"bind Radiobutton <1> {\n"
"tkCheckRadioInvoke %W\n"
"}\n"
"bind Checkbutton <Enter> {\n"
"tkButtonEnter %W\n"
"}\n"
"bind Radiobutton <Enter> {\n"
"tkButtonEnter %W\n"
"}\n"
"}\n"
"bind Button <space> {\n"
"tkButtonInvoke %W\n"
"}\n"
"bind Checkbutton <space> {\n"
"tkCheckRadioInvoke %W\n"
"}\n"
"bind Radiobutton <space> {\n"
"tkCheckRadioInvoke %W\n"
"}\n"
"bind Button <FocusIn> {}\n"
"bind Button <Enter> {\n"
"tkButtonEnter %W\n"
"}\n"
"bind Button <Leave> {\n"
"tkButtonLeave %W\n"
"}\n"
"bind Button <1> {\n"
"tkButtonDown %W\n"
"}\n"
"bind Button <ButtonRelease-1> {\n"
"tkButtonUp %W\n"
"}\n"
"bind Checkbutton <FocusIn> {}\n"
"bind Checkbutton <Leave> {\n"
"tkButtonLeave %W\n"
"}\n"
"bind Radiobutton <FocusIn> {}\n"
"bind Radiobutton <Leave> {\n"
"tkButtonLeave %W\n"
"}\n"
"if {[string match \"windows\" $tcl_platform(platform)]} {\n"
"proc tkButtonEnter w {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"] \\\n"
"\011    && [string equal $tkPriv(buttonWindow) $w]} {\n"
"$w configure -state active -relief sunken\n"
"}\n"
"set tkPriv(window) $w\n"
"}\n"
"proc tkButtonLeave w {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"$w configure -state normal\n"
"}\n"
"if {[string equal $tkPriv(buttonWindow) $w]} {\n"
"$w configure -relief $tkPriv(relief)\n"
"}\n"
"set tkPriv(window) \"\"\n"
"}\n"
"proc tkCheckRadioEnter w {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"] \\\n"
"\011    && [string equal $tkPriv(buttonWindow) $w]} {\n"
"$w configure -state active\n"
"}\n"
"set tkPriv(window) $w\n"
"}\n"
"proc tkButtonDown w {\n"
"global tkPriv\n"
"set tkPriv(relief) [$w cget -relief]\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w configure -relief sunken -state active\n"
"}\n"
"}\n"
"proc tkCheckRadioDown w {\n"
"global tkPriv\n"
"set tkPriv(relief) [$w cget -relief]\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w configure -state active\n"
"}\n"
"}\n"
"proc tkButtonUp w {\n"
"global tkPriv\n"
"if {[string equal $tkPriv(buttonWindow) $w]} {\n"
"set tkPriv(buttonWindow) \"\"\n"
"$w configure -relief $tkPriv(relief)\n"
"if {[string equal $tkPriv(window) $w]\n"
"&& [string compare [$w cget -state] \"disabled\"]} {\n"
"$w configure -state normal\n"
"uplevel #0 [list $w invoke]\n"
"}\n"
"}\n"
"}\n"
"}\n"
"if {[string match \"unix\" $tcl_platform(platform)]} {\n"
"proc tkButtonEnter {w} {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"$w configure -state active\n"
"if {[string equal $tkPriv(buttonWindow) $w]} {\n"
"$w configure -state active -relief sunken\n"
"}\n"
"}\n"
"set tkPriv(window) $w\n"
"}\n"
"proc tkButtonLeave w {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"$w configure -state normal\n"
"}\n"
"if {[string equal $tkPriv(buttonWindow) $w]} {\n"
"$w configure -relief $tkPriv(relief)\n"
"}\n"
"set tkPriv(window) \"\"\n"
"}\n"
"proc tkButtonDown w {\n"
"global tkPriv\n"
"set tkPriv(relief) [$w cget -relief]\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w configure -relief sunken\n"
"}\n"
"}\n"
"proc tkButtonUp w {\n"
"global tkPriv\n"
"if {[string equal $w $tkPriv(buttonWindow)]} {\n"
"set tkPriv(buttonWindow) \"\"\n"
"$w configure -relief $tkPriv(relief)\n"
"if {[string equal $w $tkPriv(window)] \\\n"
"\011\011&& [string compare [$w cget -state] \"disabled\"]} {\n"
"uplevel #0 [list $w invoke]\n"
"}\n"
"}\n"
"}\n"
"}\n"
"if {[string match \"macintosh\" $tcl_platform(platform)]} {\n"
"proc tkButtonEnter {w} {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"if {[string equal $w $tkPriv(buttonWindow)]} {\n"
"$w configure -state active\n"
"}\n"
"}\n"
"set tkPriv(window) $w\n"
"}\n"
"proc tkButtonLeave w {\n"
"global tkPriv\n"
"if {[string equal $w $tkPriv(buttonWindow)]} {\n"
"$w configure -state normal\n"
"}\n"
"set tkPriv(window) \"\"\n"
"}\n"
"proc tkButtonDown w {\n"
"global tkPriv\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w configure -state active\n"
"}\n"
"}\n"
"proc tkButtonUp w {\n"
"global tkPriv\n"
"if {[string equal $w $tkPriv(buttonWindow)]} {\n"
"$w configure -state normal\n"
"set tkPriv(buttonWindow) \"\"\n"
"if {[string equal $w $tkPriv(window)]\n"
"&& [string compare [$w cget -state] \"disabled\"]} {\n"
"uplevel #0 [list $w invoke]\n"
"}\n"
"}\n"
"}\n"
"}\n"
"proc tkButtonInvoke w {\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set oldRelief [$w cget -relief]\n"
"set oldState [$w cget -state]\n"
"$w configure -state active -relief sunken\n"
"update idletasks\n"
"after 100\n"
"$w configure -state $oldState -relief $oldRelief\n"
"uplevel #0 [list $w invoke]\n"
"}\n"
"}\n"
"proc tkCheckRadioInvoke {w {cmd invoke}} {\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"uplevel #0 [list $w $cmd]\n"
"}\n"
"}\n"
;
static char Et_zFile10[] = 
"proc tkColorDialog {args} {\n"
"global tkPriv\n"
"set w .__tk__color\n"
"upvar #0 $w data\n"
"set data(lines,red,start)   0\n"
"set data(lines,red,last)   -1\n"
"set data(lines,green,start) 0\n"
"set data(lines,green,last) -1\n"
"set data(lines,blue,start)  0\n"
"set data(lines,blue,last)  -1\n"
"set data(NUM_COLORBARS) 8\n"
"set data(BARS_WIDTH) 128\n"
"set data(PLGN_HEIGHT) 10\n"
"set data(PLGN_WIDTH) 10\n"
"tkColorDialog_Config $w $args\n"
"tkColorDialog_InitValues $w\n"
"set sc [winfo screen $data(-parent)]\n"
"set winExists [winfo exists $w]\n"
"if {!$winExists || [string compare $sc [winfo screen $w]]} {\n"
"if {$winExists} {\n"
"destroy $w\n"
"}\n"
"toplevel $w -class tkColorDialog -screen $sc\n"
"tkColorDialog_BuildDialog $w\n"
"}\n"
"wm transient $w $data(-parent)\n"
"::tk::PlaceWindow $w widget $data(-parent)\n"
"wm title $w $data(-title)\n"
"::tk::SetFocusGrab $w $data(okBtn)\n"
"vwait tkPriv(selectColor)\n"
"::tk::RestoreFocusGrab $w $data(okBtn)\n"
"unset data\n"
"return $tkPriv(selectColor)\n"
"}\n"
"proc tkColorDialog_InitValues {w} {\n"
"upvar #0 $w data\n"
"set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]\n"
"set data(colorbarWidth) \\\n"
"\011    [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]\n"
"set data(indent) [expr {$data(PLGN_WIDTH) / 2}]\n"
"set data(colorPad) 2\n"
"set data(selPad)   [expr {$data(PLGN_WIDTH) / 2}]\n"
"set data(minX) $data(indent)\n"
"set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]\n"
"set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]\n"
"set data(selection) $data(-initialcolor)\n"
"set data(finalColor)  $data(-initialcolor)\n"
"set rgb [winfo rgb . $data(selection)]\n"
"set data(red,intensity)   [expr {[lindex $rgb 0]/0x100}]\n"
"set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]\n"
"set data(blue,intensity)  [expr {[lindex $rgb 2]/0x100}]\n"
"}\n"
"proc tkColorDialog_Config {w argList} {\n"
"global tkPriv\n"
"upvar #0 $w data\n"
"if {[info exists tkPriv(selectColor)] && \\\n"
"\011    [string compare $tkPriv(selectColor) \"\"]} {\n"
"set defaultColor $tkPriv(selectColor)\n"
"} else {\n"
"set defaultColor [. cget -background]\n"
"}\n"
"set specs [list \\\n"
"\011    [list -initialcolor \"\" \"\" $defaultColor] \\\n"
"\011    [list -parent \"\" \"\" \".\"] \\\n"
"\011    [list -title \"\" \"\" \"Color\"] \\\n"
"\011    ]\n"
"tclParseConfigSpec $w $specs \"\" $argList\n"
"if {[string equal $data(-title) \"\"]} {\n"
"set data(-title) \" \"\n"
"}\n"
"if {[catch {winfo rgb . $data(-initialcolor)} err]} {\n"
"error $err\n"
"}\n"
"if {![winfo exists $data(-parent)]} {\n"
"error \"bad window path name \\\"$data(-parent)\\\"\"\n"
"}\n"
"}\n"
"proc tkColorDialog_BuildDialog {w} {\n"
"upvar #0 $w data\n"
"set topFrame [frame $w.top -relief raised -bd 1]\n"
"set stripsFrame [frame $topFrame.colorStrip]\n"
"foreach c { Red Green Blue } {\n"
"set color [string tolower $c]\n"
"set f [frame $stripsFrame.$color]\n"
"set box [frame $f.box]\n"
"label $box.label -text $c: -width 6 -under 0 -anchor ne\n"
"entry $box.entry -textvariable [format %s $w]($color,intensity) \\\n"
"\011    -width 4\n"
"pack $box.label -side left -fill y -padx 2 -pady 3\n"
"pack $box.entry -side left -anchor n -pady 0\n"
"pack $box -side left -fill both\n"
"set height [expr \\\n"
"\011    {[winfo reqheight $box.entry] - \\\n"
"\011    2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]\n"
"canvas $f.color -height $height\\\n"
"\011    -width $data(BARS_WIDTH) -relief sunken -bd 2\n"
"canvas $f.sel -height $data(PLGN_HEIGHT) \\\n"
"\011    -width $data(canvasWidth) -highlightthickness 0\n"
"pack $f.color -expand yes -fill both\n"
"pack $f.sel -expand yes -fill both\n"
"pack $f -side top -fill x -padx 0 -pady 2\n"
"set data($color,entry) $box.entry\n"
"set data($color,col) $f.color\n"
"set data($color,sel) $f.sel\n"
"bind $data($color,col) <Configure> \\\n"
"\011    [list tkColorDialog_DrawColorScale $w $color 1]\n"
"bind $data($color,col) <Enter> \\\n"
"\011    [list tkColorDialog_EnterColorBar $w $color]\n"
"bind $data($color,col) <Leave> \\\n"
"\011    [list tkColorDialog_LeaveColorBar $w $color]\n"
"bind $data($color,sel) <Enter> \\\n"
"\011    [list tkColorDialog_EnterColorBar $w $color]\n"
"bind $data($color,sel) <Leave> \\\n"
"\011    [list tkColorDialog_LeaveColorBar $w $color]\n"
"bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w]\n"
"}\n"
"pack $stripsFrame -side left -fill both -padx 4 -pady 10\n"
"set selFrame [frame $topFrame.sel]\n"
"set lab [label $selFrame.lab -text \"Selection:\" -under 0 -anchor sw]\n"
"set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \\\n"
"\011-width 16]\n"
"set f1  [frame $selFrame.f1 -relief sunken -bd 2]\n"
"set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]\n"
"pack $lab $ent -side top -fill x -padx 4 -pady 2\n"
"pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10\n"
"pack $data(finalCanvas) -expand yes -fill both\n"
"bind $ent <Return> [list tkColorDialog_HandleSelEntry $w]\n"
"pack $selFrame -side left -fill none -anchor nw\n"
"pack $topFrame -side top -expand yes -fill both -anchor nw\n"
"set botFrame [frame $w.bot -relief raised -bd 1]\n"
"button $botFrame.ok     -text OK            -width 8 -under 0 \\\n"
"\011-command [list tkColorDialog_OkCmd $w]\n"
"button $botFrame.cancel -text Cancel        -width 8 -under 0 \\\n"
"\011-command [list tkColorDialog_CancelCmd $w]\n"
"set data(okBtn)      $botFrame.ok\n"
"set data(cancelBtn)  $botFrame.cancel\n"
"pack $botFrame.ok $botFrame.cancel \\\n"
"\011-padx 10 -pady 10 -expand yes -side left\n"
"pack $botFrame -side bottom -fill x\n"
"bind $w <Alt-r> [list focus $data(red,entry)]\n"
"bind $w <Alt-g> [list focus $data(green,entry)]\n"
"bind $w <Alt-b> [list focus $data(blue,entry)]\n"
"bind $w <Alt-s> [list focus $ent]\n"
"bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]\n"
"bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]\n"
"bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]\n"
"wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w]\n"
"}\n"
"proc tkColorDialog_SetRGBValue {w color} {\n"
"upvar #0 $w data \n"
"set data(red,intensity)   [lindex $color 0]\n"
"set data(green,intensity) [lindex $color 1]\n"
"set data(blue,intensity)  [lindex $color 2]\n"
"tkColorDialog_RedrawColorBars $w all\n"
"foreach color { red green blue } {\n"
"set x [tkColorDialog_RgbToX $w $data($color,intensity)]\n"
"tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0\n"
"}\n"
"}\n"
"proc tkColorDialog_XToRgb {w x} {\n"
"upvar #0 $w data\n"
"return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]\n"
"}\n"
"proc tkColorDialog_RgbToX {w color} {\n"
"upvar #0 $w data\n"
"return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]\n"
"}\n"
"proc tkColorDialog_DrawColorScale {w c {create 0}} {\n"
"global lines\n"
"upvar #0 $w data\n"
"set col $data($c,col)\n"
"set sel $data($c,sel)\n"
"if {$create} {\n"
"if { $data(lines,$c,last) > $data(lines,$c,start)} {\n"
"for {set i $data(lines,$c,start)} \\\n"
"\011\011{$i <= $data(lines,$c,last)} { incr i} {\n"
"$sel delete $i\n"
"}\n"
"}\n"
"if {[info exists data($c,index)]} {\n"
"$sel delete $data($c,index)\n"
"}\n"
"tkColorDialog_CreateSelector $w $sel $c\n"
"$sel bind $data($c,index) <ButtonPress-1> \\\n"
"\011\011[list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1]\n"
"$sel bind $data($c,index) <B1-Motion> \\\n"
"\011\011[list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]\n"
"$sel bind $data($c,index) <ButtonRelease-1> \\\n"
"\011\011[list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]\n"
"set height [winfo height $col]\n"
"set data($c,clickRegion) [$sel create rectangle 0 0 \\\n"
"\011\011$data(canvasWidth) $height -fill {} -outline {}]\n"
"bind $col <ButtonPress-1> \\\n"
"\011\011[list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)]\n"
"bind $col <B1-Motion> \\\n"
"\011\011[list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)]\n"
"bind $col <ButtonRelease-1> \\\n"
"\011\011[list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)]\n"
"$sel bind $data($c,clickRegion) <ButtonPress-1> \\\n"
"\011\011[list tkColorDialog_StartMove $w $sel $c %x $data(selPad)]\n"
"$sel bind $data($c,clickRegion) <B1-Motion> \\\n"
"\011\011[list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]\n"
"$sel bind $data($c,clickRegion) <ButtonRelease-1> \\\n"
"\011\011[list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]\n"
"} else {\n"
"set l $data(lines,$c,start)\n"
"}\n"
"set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]\n"
"for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {\n"
"set intensity [expr {$i * $data(intensityIncr)}]\n"
"set startx [expr {$i * $data(colorbarWidth) + $highlightW}]\n"
"if {[string equal $c \"red\"]} {\n"
"set color [format \"#%02x%02x%02x\" \\\n"
"\011\011\011   $intensity \\\n"
"\011\011\011   $data(green,intensity) \\\n"
"\011\011\011   $data(blue,intensity)]\n"
"} elseif {[string equal $c \"green\"]} {\n"
"set color [format \"#%02x%02x%02x\" \\\n"
"\011\011\011   $data(red,intensity) \\\n"
"\011\011\011   $intensity \\\n"
"\011\011\011   $data(blue,intensity)]\n"
"} else {\n"
"set color [format \"#%02x%02x%02x\" \\\n"
"\011\011\011   $data(red,intensity) \\\n"
"\011\011\011   $data(green,intensity) \\\n"
"\011\011\011   $intensity]\n"
"}\n"
"if {$create} {\n"
"set index [$col create rect $startx $highlightW \\\n"
"\011\011    [expr {$startx +$data(colorbarWidth)}] \\\n"
"\011\011    [expr {[winfo height $col] + $highlightW}]\\\n"
"\011        -fill $color -outline $color]\n"
"} else {\n"
"$col itemconfigure $l -fill $color -outline $color\n"
"incr l\n"
"}\n"
"}\n"
"$sel raise $data($c,index)\n"
"if {$create} {\n"
"set data(lines,$c,last) $index\n"
"set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]\n"
"}\n"
"tkColorDialog_RedrawFinalColor $w\n"
"}\n"
"proc tkColorDialog_CreateSelector {w sel c } {\n"
"upvar #0 $w data\n"
"set data($c,index) [$sel create polygon \\\n"
"\0110 $data(PLGN_HEIGHT) \\\n"
"\011$data(PLGN_WIDTH) $data(PLGN_HEIGHT) \\\n"
"\011$data(indent) 0]\n"
"set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]\n"
"$sel move $data($c,index) $data($c,x) 0\n"
"}\n"
"proc tkColorDialog_RedrawFinalColor {w} {\n"
"upvar #0 $w data\n"
"set color [format \"#%02x%02x%02x\" $data(red,intensity) \\\n"
"\011$data(green,intensity) $data(blue,intensity)]\n"
"$data(finalCanvas) configure -bg $color\n"
"set data(finalColor) $color\n"
"set data(selection) $color\n"
"set data(finalRGB) [list \\\n"
"\011    $data(red,intensity) \\\n"
"\011    $data(green,intensity) \\\n"
"\011    $data(blue,intensity)]\n"
"}\n"
"proc tkColorDialog_RedrawColorBars {w colorChanged} {\n"
"upvar #0 $w data\n"
"switch $colorChanged {\n"
"red { \n"
"tkColorDialog_DrawColorScale $w green\n"
"tkColorDialog_DrawColorScale $w blue\n"
"}\n"
"green {\n"
"tkColorDialog_DrawColorScale $w red\n"
"tkColorDialog_DrawColorScale $w blue\n"
"}\n"
"blue {\n"
"tkColorDialog_DrawColorScale $w red\n"
"tkColorDialog_DrawColorScale $w green\n"
"}\n"
"default {\n"
"tkColorDialog_DrawColorScale $w red\n"
"tkColorDialog_DrawColorScale $w green\n"
"tkColorDialog_DrawColorScale $w blue\n"
"}\n"
"}\n"
"tkColorDialog_RedrawFinalColor $w\n"
"}\n"
"proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {\n"
"upvar #0 $w data\n"
"if {!$dontMove} {\n"
"tkColorDialog_MoveSelector $w $sel $color $x $delta\n"
"}\n"
"}\n"
"proc tkColorDialog_MoveSelector {w sel color x delta} {\n"
"upvar #0 $w data\n"
"incr x -$delta\n"
"if { $x < 0 } {\n"
"set x 0\n"
"} elseif { $x >= $data(BARS_WIDTH)} {\n"
"set x [expr {$data(BARS_WIDTH) - 1}]\n"
"}\n"
"set diff [expr {$x - $data($color,x)}]\n"
"$sel move $data($color,index) $diff 0\n"
"set data($color,x) [expr {$data($color,x) + $diff}]\n"
"return $x\n"
"}\n"
"proc tkColorDialog_ReleaseMouse {w sel color x delta} {\n"
"upvar #0 $w data \n"
"set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]\n"
"set data($color,intensity) [tkColorDialog_XToRgb $w $x]\n"
"tkColorDialog_RedrawColorBars $w $color\n"
"}\n"
"proc tkColorDialog_ResizeColorBars {w} {\n"
"upvar #0 $w data\n"
"if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || \n"
"(($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {\n"
"set data(BARS_WIDTH) $data(NUM_COLORBARS)\n"
"}\n"
"tkColorDialog_InitValues $w\n"
"foreach color { red green blue } {\n"
"$data($color,col) configure -width $data(canvasWidth)\n"
"tkColorDialog_DrawColorScale $w $color 1\n"
"}\n"
"}\n"
"proc tkColorDialog_HandleSelEntry {w} {\n"
"upvar #0 $w data\n"
"set text [string trim $data(selection)]\n"
"if {[catch {set color [winfo rgb . $text]} ]} {\n"
"set data(selection) $data(finalColor)\n"
"return\n"
"}\n"
"set R [expr {[lindex $color 0]/0x100}]\n"
"set G [expr {[lindex $color 1]/0x100}]\n"
"set B [expr {[lindex $color 2]/0x100}]\n"
"tkColorDialog_SetRGBValue $w \"$R $G $B\"\n"
"set data(selection) $text\n"
"}\n"
"proc tkColorDialog_HandleRGBEntry {w} {\n"
"upvar #0 $w data\n"
"foreach c {red green blue} {\n"
"if {[catch {\n"
"set data($c,intensity) [expr {int($data($c,intensity))}]\n"
"}]} {\n"
"set data($c,intensity) 0\n"
"}\n"
"if {$data($c,intensity) < 0} {\n"
"set data($c,intensity) 0\n"
"}\n"
"if {$data($c,intensity) > 255} {\n"
"set data($c,intensity) 255\n"
"}\n"
"}\n"
"tkColorDialog_SetRGBValue $w \"$data(red,intensity) $data(green,intensity) \\\n"
"\011$data(blue,intensity)\"\n"
"}    \n"
"proc tkColorDialog_EnterColorBar {w color} {\n"
"upvar #0 $w data\n"
"$data($color,sel) itemconfig $data($color,index) -fill red\n"
"}\n"
"proc tkColorDialog_LeaveColorBar {w color} {\n"
"upvar #0 $w data\n"
"$data($color,sel) itemconfig $data($color,index) -fill black\n"
"}\n"
"proc tkColorDialog_OkCmd {w} {\n"
"global tkPriv\n"
"upvar #0 $w data\n"
"set tkPriv(selectColor) $data(finalColor)\n"
"}\n"
"proc tkColorDialog_CancelCmd {w} {\n"
"global tkPriv\n"
"set tkPriv(selectColor) \"\"\n"
"}\n"
;
static char Et_zFile11[] = 
"proc tclParseConfigSpec {w specs flags argList} {\n"
"upvar #0 $w data\n"
"foreach spec $specs {\n"
"if {[llength $spec] < 4} {\n"
"error \"\\\"spec\\\" should contain 5 or 4 elements\"\n"
"}\n"
"set cmdsw [lindex $spec 0]\n"
"set cmd($cmdsw) \"\"\n"
"set rname($cmdsw)   [lindex $spec 1]\n"
"set rclass($cmdsw)  [lindex $spec 2]\n"
"set def($cmdsw)     [lindex $spec 3]\n"
"set verproc($cmdsw) [lindex $spec 4]\n"
"}\n"
"if {[llength $argList] & 1} {\n"
"set cmdsw [lindex $argList end]\n"
"if {![info exists cmd($cmdsw)]} {\n"
"error \"bad option \\\"$cmdsw\\\": must be [tclListValidFlags cmd]\"\n"
"}\n"
"error \"value for \\\"$cmdsw\\\" missing\"\n"
"}\n"
"foreach cmdsw [array names cmd] {\n"
"set data($cmdsw) $def($cmdsw)\n"
"}\n"
"foreach {cmdsw value} $argList {\n"
"if {![info exists cmd($cmdsw)]} {\n"
"error \"bad option \\\"$cmdsw\\\": must be [tclListValidFlags cmd]\"\n"
"}\n"
"set data($cmdsw) $value\n"
"}\n"
"}\n"
"proc tclListValidFlags {v} {\n"
"upvar $v cmd\n"
"set len [llength [array names cmd]]\n"
"set i 1\n"
"set separator \"\"\n"
"set errormsg \"\"\n"
"foreach cmdsw [lsort [array names cmd]] {\n"
"append errormsg \"$separator$cmdsw\"\n"
"incr i\n"
"if {$i == $len} {\n"
"set separator \", or \"\n"
"} else {\n"
"set separator \", \"\n"
"}\n"
"}\n"
"return $errormsg\n"
"}\n"
"proc tkFocusGroup_Create {t} {\n"
"global tkPriv\n"
"if {[string compare [winfo toplevel $t] $t]} {\n"
"error \"$t is not a toplevel window\"\n"
"}\n"
"if {![info exists tkPriv(fg,$t)]} {\n"
"set tkPriv(fg,$t) 1\n"
"set tkPriv(focus,$t) \"\"\n"
"bind $t <FocusIn>  [list tkFocusGroup_In  $t %W %d]\n"
"bind $t <FocusOut> [list tkFocusGroup_Out $t %W %d]\n"
"bind $t <Destroy>  [list tkFocusGroup_Destroy $t %W]\n"
"}\n"
"}\n"
"proc tkFocusGroup_BindIn {t w cmd} {\n"
"global tkFocusIn tkPriv\n"
"if {![info exists tkPriv(fg,$t)]} {\n"
"error \"focus group \\\"$t\\\" doesn't exist\"\n"
"}\n"
"set tkFocusIn($t,$w) $cmd\n"
"}\n"
"proc tkFocusGroup_BindOut {t w cmd} {\n"
"global tkFocusOut tkPriv\n"
"if {![info exists tkPriv(fg,$t)]} {\n"
"error \"focus group \\\"$t\\\" doesn't exist\"\n"
"}\n"
"set tkFocusOut($t,$w) $cmd\n"
"}\n"
"proc tkFocusGroup_Destroy {t w} {\n"
"global tkPriv tkFocusIn tkFocusOut\n"
"if {[string equal $t $w]} {\n"
"unset tkPriv(fg,$t)\n"
"unset tkPriv(focus,$t) \n"
"foreach name [array names tkFocusIn $t,*] {\n"
"unset tkFocusIn($name)\n"
"}\n"
"foreach name [array names tkFocusOut $t,*] {\n"
"unset tkFocusOut($name)\n"
"}\n"
"} else {\n"
"if {[info exists tkPriv(focus,$t)] && \\\n"
"\011\011[string equal $tkPriv(focus,$t) $w]} {\n"
"set tkPriv(focus,$t) \"\"\n"
"}\n"
"catch {\n"
"unset tkFocusIn($t,$w)\n"
"}\n"
"catch {\n"
"unset tkFocusOut($t,$w)\n"
"}\n"
"}\n"
"}\n"
"proc tkFocusGroup_In {t w detail} {\n"
"global tkPriv tkFocusIn\n"
"if {[string compare $detail NotifyNonlinear] && \\\n"
"\011    [string compare $detail NotifyNonlinearVirtual]} {\n"
"return\n"
"}\n"
"if {![info exists tkFocusIn($t,$w)]} {\n"
"set tkFocusIn($t,$w) \"\"\n"
"return\n"
"}\n"
"if {![info exists tkPriv(focus,$t)]} {\n"
"return\n"
"}\n"
"if {[string equal $tkPriv(focus,$t) $w]} {\n"
"return\n"
"} else {\n"
"set tkPriv(focus,$t) $w\n"
"eval $tkFocusIn($t,$w)\n"
"}\n"
"}\n"
"proc tkFocusGroup_Out {t w detail} {\n"
"global tkPriv tkFocusOut\n"
"if {[string compare $detail NotifyNonlinear] && \\\n"
"\011    [string compare $detail NotifyNonlinearVirtual]} {\n"
"return\n"
"}\n"
"if {![info exists tkPriv(focus,$t)]} {\n"
"return\n"
"}\n"
"if {![info exists tkFocusOut($t,$w)]} {\n"
"return\n"
"} else {\n"
"eval $tkFocusOut($t,$w)\n"
"set tkPriv(focus,$t) \"\"\n"
"}\n"
"}\n"
"proc tkFDGetFileTypes {string} {\n"
"foreach t $string {\n"
"if {[llength $t] < 2 || [llength $t] > 3} {\n"
"error \"bad file type \\\"$t\\\", should be \\\"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\\\"\"\n"
"}\n"
"eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1]\n"
"}\n"
"set types {}\n"
"foreach t $string {\n"
"set label [lindex $t 0]\n"
"set exts {}\n"
"if {[info exists hasDoneType($label)]} {\n"
"continue\n"
"}\n"
"set name \"$label (\"\n"
"set sep \"\"\n"
"foreach ext $fileTypes($label) {\n"
"if {[string equal $ext \"\"]} {\n"
"continue\n"
"}\n"
"regsub {^[.]} $ext \"*.\" ext\n"
"if {![info exists hasGotExt($label,$ext)]} {\n"
"append name $sep$ext\n"
"lappend exts $ext\n"
"set hasGotExt($label,$ext) 1\n"
"}\n"
"set sep ,\n"
"}\n"
"append name \")\"\n"
"lappend types [list $name $exts]\n"
"set hasDoneType($label) 1\n"
"}\n"
"return $types\n"
"}\n"
;
static char Et_zFile12[] = 
"proc tkConsoleInit {} {\n"
"global tcl_platform\n"
"if {![consoleinterp eval {set tcl_interactive}]} {\n"
"wm withdraw .\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"set mod \"Ctrl\"\n"
"} else {\n"
"set mod \"Cmd\"\n"
"}\n"
"menu .menubar\n"
".menubar add cascade -label File -menu .menubar.file -underline 0\n"
".menubar add cascade -label Edit -menu .menubar.edit -underline 0\n"
"menu .menubar.file -tearoff 0\n"
".menubar.file add command -label \"Source...\" -underline 0 \\\n"
"\011    -command tkConsoleSource\n"
".menubar.file add command -label \"Hide Console\" -underline 0 \\\n"
"\011    -command {wm withdraw .}\n"
"if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
".menubar.file add command -label \"Exit\" -underline 1 -command exit\n"
"} else {\n"
".menubar.file add command -label \"Quit\" -command exit -accel Cmd-Q\n"
"}\n"
"menu .menubar.edit -tearoff 0\n"
".menubar.edit add command -label \"Cut\" -underline 2 \\\n"
"\011    -command { event generate .console <<Cut>> } -accel \"$mod+X\"\n"
".menubar.edit add command -label \"Copy\" -underline 0 \\\n"
"\011    -command { event generate .console <<Copy>> } -accel \"$mod+C\"\n"
".menubar.edit add command -label \"Paste\" -underline 1 \\\n"
"\011    -command { event generate .console <<Paste>> } -accel \"$mod+V\"\n"
"if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
".menubar.edit add command -label \"Clear\" -underline 2 \\\n"
"\011\011-command { event generate .console <<Clear>> }\n"
"} else {\n"
".menubar.edit add command -label \"Delete\" -underline 0 \\\n"
"\011\011-command { event generate .console <<Clear>> } -accel \"Del\"\n"
".menubar add cascade -label Help -menu .menubar.help -underline 0\n"
"menu .menubar.help -tearoff 0\n"
".menubar.help add command -label \"About...\" -underline 0 \\\n"
"\011\011-command tkConsoleAbout\n"
"}\n"
". configure -menu .menubar\n"
"text .console  -yscrollcommand \".sb set\" -setgrid true \n"
"scrollbar .sb -command \".console yview\"\n"
"pack .sb -side right -fill both\n"
"pack .console -fill both -expand 1 -side left\n"
"switch -exact $tcl_platform(platform) {\n"
"\"macintosh\" {\n"
".console configure -font {Monaco 9 normal} -highlightthickness 0\n"
"}\n"
"\"windows\" {\n"
".console configure -font systemfixed\n"
"}\n"
"}\n"
"tkConsoleBind .console\n"
".console tag configure stderr -foreground red\n"
".console tag configure stdin -foreground blue\n"
"focus .console\n"
"wm protocol . WM_DELETE_WINDOW { wm withdraw . }\n"
"wm title . \"" BUILD_CONFIG_STATIC_WISH_ALIAS " v" BUILD_CONFIG_RELEASE_VERSION "\"\n"
"flush stdout\n"
".console mark set output [.console index \"end - 1 char\"]\n"
"tkTextSetCursor .console end\n"
".console mark set promptEnd insert\n"
".console mark gravity promptEnd left\n"
"}\n"
"proc tkConsoleSource {} {\n"
"set filename [tk_getOpenFile -defaultextension .tcl -parent . \\\n"
"\011\011      -title \"Select a file to source\" \\\n"
"\011\011      -filetypes {{\"Tcl Scripts\" .tcl} {\"All Files\" *}}]\n"
"if {[string compare $filename \"\"]} {\n"
"set cmd [list source $filename]\n"
"if {[catch {consoleinterp eval $cmd} result]} {\n"
"tkConsoleOutput stderr \"$result\\n\"\n"
"}\n"
"}\n"
"}\n"
"proc tkConsoleInvoke {args} {\n"
"set ranges [.console tag ranges input]\n"
"set cmd \"\"\n"
"if {[llength $ranges]} {\n"
"set pos 0\n"
"while {[string compare [lindex $ranges $pos] \"\"]} {\n"
"set start [lindex $ranges $pos]\n"
"set end [lindex $ranges [incr pos]]\n"
"append cmd [.console get $start $end]\n"
"incr pos\n"
"}\n"
"}\n"
"if {[string equal $cmd \"\"]} {\n"
"tkConsolePrompt\n"
"} elseif {[info complete $cmd]} {\n"
".console mark set output end\n"
".console tag delete input\n"
"set result [consoleinterp record $cmd]\n"
"if {[string compare $result \"\"]} {\n"
"puts $result\n"
"}\n"
"tkConsoleHistory reset\n"
"tkConsolePrompt\n"
"} else {\n"
"tkConsolePrompt partial\n"
"}\n"
".console yview -pickplace insert\n"
"}\n"
"set histNum 1\n"
"proc tkConsoleHistory {cmd} {\n"
"global histNum\n"
"switch $cmd {\n"
"prev {\n"
"incr histNum -1\n"
"if {$histNum == 0} {\n"
"set cmd {history event [expr {[history nextid] -1}]}\n"
"} else {\n"
"set cmd \"history event $histNum\"\n"
"}\n"
"if {[catch {consoleinterp eval $cmd} cmd]} {\n"
"incr histNum\n"
"return\n"
"}\n"
".console delete promptEnd end\n"
".console insert promptEnd $cmd {input stdin}\n"
"}\n"
"next {\n"
"incr histNum\n"
"if {$histNum == 0} {\n"
"set cmd {history event [expr {[history nextid] -1}]}\n"
"} elseif {$histNum > 0} {\n"
"set cmd \"\"\n"
"set histNum 1\n"
"} else {\n"
"set cmd \"history event $histNum\"\n"
"}\n"
"if {[string compare $cmd \"\"]} {\n"
"catch {consoleinterp eval $cmd} cmd\n"
"}\n"
".console delete promptEnd end\n"
".console insert promptEnd $cmd {input stdin}\n"
"}\n"
"reset {\n"
"set histNum 1\n"
"}\n"
"}\n"
"}\n"
"proc tkConsolePrompt {{partial normal}} {\n"
"if {[string equal $partial \"normal\"]} {\n"
"set temp [.console index \"end - 1 char\"]\n"
".console mark set output end\n"
"if {[consoleinterp eval \"info exists tcl_prompt1\"]} {\n"
"consoleinterp eval \"eval \\[set tcl_prompt1\\]\"\n"
"} else {\n"
"puts -nonewline \"% \"\n"
"}\n"
"} else {\n"
"set temp [.console index output]\n"
".console mark set output end\n"
"if {[consoleinterp eval \"info exists tcl_prompt2\"]} {\n"
"consoleinterp eval \"eval \\[set tcl_prompt2\\]\"\n"
"} else {\n"
"puts -nonewline \"> \"\n"
"}\n"
"}\n"
"flush stdout\n"
".console mark set output $temp\n"
"tkTextSetCursor .console end\n"
".console mark set promptEnd insert\n"
".console mark gravity promptEnd left\n"
"}\n"
"proc tkConsoleBind {win} {\n"
"bindtags $win \"$win Text . all\"\n"
"bind $win <Alt-KeyPress> {# nothing }\n"
"bind $win <Meta-KeyPress> {# nothing}\n"
"bind $win <Control-KeyPress> {# nothing}\n"
"bind $win <Escape> {# nothing}\n"
"bind $win <KP_Enter> {# nothing}\n"
"bind $win <Tab> {\n"
"tkConsoleInsert %W \\t\n"
"focus %W\n"
"break\n"
"}\n"
"bind $win <Return> {\n"
"%W mark set insert {end - 1c}\n"
"tkConsoleInsert %W \"\\n\"\n"
"tkConsoleInvoke\n"
"break\n"
"}\n"
"bind $win <Delete> {\n"
"if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
"%W tag remove sel sel.first promptEnd\n"
"} elseif {[%W compare insert < promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"bind $win <BackSpace> {\n"
"if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
"%W tag remove sel sel.first promptEnd\n"
"} elseif {[%W compare insert <= promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"foreach left {Control-a Home} {\n"
"bind $win <$left> {\n"
"if {[%W compare insert < promptEnd]} {\n"
"tkTextSetCursor %W {insert linestart}\n"
"} else {\n"
"tkTextSetCursor %W promptEnd\n"
"}\n"
"break\n"
"}\n"
"}\n"
"foreach right {Control-e End} {\n"
"bind $win <$right> {\n"
"tkTextSetCursor %W {insert lineend}\n"
"break\n"
"}\n"
"}\n"
"bind $win <Control-d> {\n"
"if {[%W compare insert < promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"bind $win <Control-k> {\n"
"if {[%W compare insert < promptEnd]} {\n"
"%W mark set insert promptEnd\n"
"}\n"
"}\n"
"bind $win <Control-t> {\n"
"if {[%W compare insert < promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"bind $win <Meta-d> {\n"
"if {[%W compare insert < promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"bind $win <Meta-BackSpace> {\n"
"if {[%W compare insert <= promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"bind $win <Control-h> {\n"
"if {[%W compare insert <= promptEnd]} {\n"
"break\n"
"}\n"
"}\n"
"foreach prev {Control-p Up} {\n"
"bind $win <$prev> {\n"
"tkConsoleHistory prev\n"
"break\n"
"}\n"
"}\n"
"foreach prev {Control-n Down} {\n"
"bind $win <$prev> {\n"
"tkConsoleHistory next\n"
"break\n"
"}\n"
"}\n"
"bind $win <Insert> {\n"
"catch {tkConsoleInsert %W [selection get -displayof %W]}\n"
"break\n"
"}\n"
"bind $win <KeyPress> {\n"
"tkConsoleInsert %W %A\n"
"break\n"
"}\n"
"foreach left {Control-b Left} {\n"
"bind $win <$left> {\n"
"if {[%W compare insert == promptEnd]} {\n"
"break\n"
"}\n"
"tkTextSetCursor %W insert-1c\n"
"break\n"
"}\n"
"}\n"
"foreach right {Control-f Right} {\n"
"bind $win <$right> {\n"
"tkTextSetCursor %W insert+1c\n"
"break\n"
"}\n"
"}\n"
"bind $win <F9> {\n"
"eval destroy [winfo child .]\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"source -rsrc Console\n"
"} else {\n"
"source [file join $tk_library console.tcl]\n"
"}\n"
"}\n"
"bind $win <<Cut>> {\n"
"if {![catch {set data [%W get sel.first sel.last]}]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W $data\n"
"}\n"
"break\n"
"}\n"
"bind $win <<Copy>> {\n"
"if {![catch {set data [%W get sel.first sel.last]}]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W $data\n"
"}\n"
"break\n"
"}\n"
"bind $win <<Paste>> {\n"
"catch {\n"
"set clip [selection get -displayof %W -selection CLIPBOARD]\n"
"set list [split $clip \\n\\r]\n"
"tkConsoleInsert %W [lindex $list 0]\n"
"foreach x [lrange $list 1 end] {\n"
"%W mark set insert {end - 1c}\n"
"tkConsoleInsert %W \"\\n\"\n"
"tkConsoleInvoke\n"
"tkConsoleInsert %W $x\n"
"}\n"
"}\n"
"break\n"
"}\n"
"}\n"
"proc tkConsoleInsert {w s} {\n"
"if {[string equal $s \"\"]} {\n"
"return\n"
"}\n"
"catch {\n"
"if {[$w compare sel.first <= insert]\n"
"&& [$w compare sel.last >= insert]} {\n"
"$w tag remove sel sel.first promptEnd\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"if {[$w compare insert < promptEnd]} {\n"
"$w mark set insert end\011\n"
"}\n"
"$w insert insert $s {input stdin}\n"
"$w see insert\n"
"}\n"
"proc tkConsoleOutput {dest string} {\n"
".console insert output $string $dest\n"
".console see insert\n"
"}\n"
"proc tkConsoleExit {} {\n"
"destroy .\n"
"}\n"
"proc tkConsoleAbout {} {\n"
"global tk_patchLevel\n"
"tk_messageBox -type ok -message \""
BUILD_CONFIG_STATIC_WISH_ALIAS
" for Windows, Version "
BUILD_CONFIG_RELEASE_VERSION ", " BUILD_CONFIG_RELEASE_YEAR ".\n"
"This product is an open-source static port of\n"
"Tcl/Tk 8.3.1, originally from Scriptics.  This product\n"
"and its source code can be downloaded at no charge\n"
"from http://ijutools.sourceforge.net, and is licensed\n"
"under the GNU Public License (GPL).\n"
"(Core components:  Tcl [info patchlevel], Tk $tk_patchLevel.)\"\n"
"}\n"
"tkConsoleInit\n"
;
static char Et_zFile13[] = 
"proc tk_dialog {w title text bitmap default args} {\n"
"global tkPriv tcl_platform\n"
"if {[string is int $default]} {\n"
"if {$default >= [llength $args]} {\n"
"return -code error \"default button index greater than number of\\\n"
"\011\011    buttons specified for tk_dialog\"\n"
"}\n"
"} elseif {[string equal {} $default]} {\n"
"set default -1\n"
"} else {\n"
"set default [lsearch -exact $args $default]\n"
"}\n"
"catch {destroy $w}\n"
"toplevel $w -class Dialog\n"
"wm title $w $title\n"
"wm iconname $w Dialog\n"
"wm protocol $w WM_DELETE_WINDOW { }\n"
"if { [winfo viewable [winfo toplevel [winfo parent $w]]] } {\n"
"wm transient $w [winfo toplevel [winfo parent $w]]\n"
"}    \n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"unsupported1 style $w dBoxProc\n"
"}\n"
"frame $w.bot\n"
"frame $w.top\n"
"if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
"$w.bot configure -relief raised -bd 1\n"
"$w.top configure -relief raised -bd 1\n"
"}\n"
"pack $w.bot -side bottom -fill both\n"
"pack $w.top -side top -fill both -expand 1\n"
"option add *Dialog.msg.wrapLength 3i widgetDefault\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"option add *Dialog.msg.font system widgetDefault\n"
"} else {\n"
"option add *Dialog.msg.font {Times 12} widgetDefault\n"
"}\n"
"label $w.msg -justify left -text $text\n"
"pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m\n"
"if {[string compare $bitmap \"\"]} {\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"] && \\\n"
"\011\011[string equal $bitmap \"error\"]} {\n"
"set bitmap \"stop\"\n"
"}\n"
"label $w.bitmap -bitmap $bitmap\n"
"pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m\n"
"}\n"
"set i 0\n"
"foreach but $args {\n"
"button $w.button$i -text $but -command [list set tkPriv(button) $i]\n"
"if {$i == $default} {\n"
"$w.button$i configure -default active\n"
"} else {\n"
"$w.button$i configure -default normal\n"
"}\n"
"grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10\n"
"grid columnconfigure $w.bot $i\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"set tmp [string tolower $but]\n"
"if {[string equal $tmp \"ok\"] || [string equal $tmp \"cancel\"]} {\n"
"grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]\n"
"}\n"
"}\n"
"incr i\n"
"}\n"
"if {$default >= 0} {\n"
"bind $w <Return> \"\n"
"[list $w.button$default] configure -state active -relief sunken\n"
"update idletasks\n"
"after 100\n"
"set tkPriv(button) $default\n"
"\"\n"
"}\n"
"bind $w <Destroy> {set tkPriv(button) -1}\n"
"wm withdraw $w\n"
"update idletasks\n"
"set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
"\011    - [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"\011    - [winfo vrooty [winfo parent $w]]}]\n"
"wm geom $w +$x+$y\n"
"wm deiconify $w\n"
"set oldFocus [focus]\n"
"set oldGrab [grab current $w]\n"
"if {[string compare $oldGrab \"\"]} {\n"
"set grabStatus [grab status $oldGrab]\n"
"}\n"
"grab $w\n"
"if {$default >= 0} {\n"
"focus $w.button$default\n"
"} else {\n"
"focus $w\n"
"}\n"
"tkwait variable tkPriv(button)\n"
"catch {focus $oldFocus}\n"
"catch {\n"
"bind $w <Destroy> {}\n"
"destroy $w\n"
"}\n"
"if {[string compare $oldGrab \"\"]} {\n"
"if {[string compare $grabStatus \"global\"]} {\n"
"grab $oldGrab\n"
"} else {\n"
"grab -global $oldGrab\n"
"}\n"
"}\n"
"return $tkPriv(button)\n"
"}\n"
;
static char Et_zFile14[] = 
"bind Entry <<Cut>> {\n"
"if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W $tkPriv(data)\n"
"%W delete sel.first sel.last\n"
"unset tkPriv(data)\n"
"}\n"
"}\n"
"bind Entry <<Copy>> {\n"
"if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W $tkPriv(data)\n"
"unset tkPriv(data)\n"
"}\n"
"}\n"
"bind Entry <<Paste>> {\n"
"global tcl_platform\n"
"catch {\n"
"if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
"catch {\n"
"%W delete sel.first sel.last\n"
"}\n"
"}\n"
"%W insert insert [selection get -displayof %W -selection CLIPBOARD]\n"
"tkEntrySeeInsert %W\n"
"}\n"
"}\n"
"bind Entry <<Clear>> {\n"
"%W delete sel.first sel.last\n"
"}\n"
"bind Entry <<PasteSelection>> {\n"
"if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n"
"tkEntryPaste %W %x\n"
"}\n"
"}\n"
"bind Entry <1> {\n"
"tkEntryButton1 %W %x\n"
"%W selection clear\n"
"}\n"
"bind Entry <B1-Motion> {\n"
"set tkPriv(x) %x\n"
"tkEntryMouseSelect %W %x\n"
"}\n"
"bind Entry <Double-1> {\n"
"set tkPriv(selectMode) word\n"
"tkEntryMouseSelect %W %x\n"
"catch {%W icursor sel.first}\n"
"}\n"
"bind Entry <Triple-1> {\n"
"set tkPriv(selectMode) line\n"
"tkEntryMouseSelect %W %x\n"
"%W icursor 0\n"
"}\n"
"bind Entry <Shift-1> {\n"
"set tkPriv(selectMode) char\n"
"%W selection adjust @%x\n"
"}\n"
"bind Entry <Double-Shift-1>\011{\n"
"set tkPriv(selectMode) word\n"
"tkEntryMouseSelect %W %x\n"
"}\n"
"bind Entry <Triple-Shift-1>\011{\n"
"set tkPriv(selectMode) line\n"
"tkEntryMouseSelect %W %x\n"
"}\n"
"bind Entry <B1-Leave> {\n"
"set tkPriv(x) %x\n"
"tkEntryAutoScan %W\n"
"}\n"
"bind Entry <B1-Enter> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Entry <ButtonRelease-1> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Entry <Control-1> {\n"
"%W icursor @%x\n"
"}\n"
"bind Entry <Left> {\n"
"tkEntrySetCursor %W [expr {[%W index insert] - 1}]\n"
"}\n"
"bind Entry <Right> {\n"
"tkEntrySetCursor %W [expr {[%W index insert] + 1}]\n"
"}\n"
"bind Entry <Shift-Left> {\n"
"tkEntryKeySelect %W [expr {[%W index insert] - 1}]\n"
"tkEntrySeeInsert %W\n"
"}\n"
"bind Entry <Shift-Right> {\n"
"tkEntryKeySelect %W [expr {[%W index insert] + 1}]\n"
"tkEntrySeeInsert %W\n"
"}\n"
"bind Entry <Control-Left> {\n"
"tkEntrySetCursor %W [tkEntryPreviousWord %W insert]\n"
"}\n"
"bind Entry <Control-Right> {\n"
"tkEntrySetCursor %W [tkEntryNextWord %W insert]\n"
"}\n"
"bind Entry <Shift-Control-Left> {\n"
"tkEntryKeySelect %W [tkEntryPreviousWord %W insert]\n"
"tkEntrySeeInsert %W\n"
"}\n"
"bind Entry <Shift-Control-Right> {\n"
"tkEntryKeySelect %W [tkEntryNextWord %W insert]\n"
"tkEntrySeeInsert %W\n"
"}\n"
"bind Entry <Home> {\n"
"tkEntrySetCursor %W 0\n"
"}\n"
"bind Entry <Shift-Home> {\n"
"tkEntryKeySelect %W 0\n"
"tkEntrySeeInsert %W\n"
"}\n"
"bind Entry <End> {\n"
"tkEntrySetCursor %W end\n"
"}\n"
"bind Entry <Shift-End> {\n"
"tkEntryKeySelect %W end\n"
"tkEntrySeeInsert %W\n"
"}\n"
"bind Entry <Delete> {\n"
"if {[%W selection present]} {\n"
"%W delete sel.first sel.last\n"
"} else {\n"
"%W delete insert\n"
"}\n"
"}\n"
"bind Entry <BackSpace> {\n"
"tkEntryBackspace %W\n"
"}\n"
"bind Entry <Control-space> {\n"
"%W selection from insert\n"
"}\n"
"bind Entry <Select> {\n"
"%W selection from insert\n"
"}\n"
"bind Entry <Control-Shift-space> {\n"
"%W selection adjust insert\n"
"}\n"
"bind Entry <Shift-Select> {\n"
"%W selection adjust insert\n"
"}\n"
"bind Entry <Control-slash> {\n"
"%W selection range 0 end\n"
"}\n"
"bind Entry <Control-backslash> {\n"
"%W selection clear\n"
"}\n"
"bind Entry <KeyPress> {\n"
"tkEntryInsert %W %A\n"
"}\n"
"bind Entry <Alt-KeyPress> {# nothing}\n"
"bind Entry <Meta-KeyPress> {# nothing}\n"
"bind Entry <Control-KeyPress> {# nothing}\n"
"bind Entry <Escape> {# nothing}\n"
"bind Entry <Return> {# nothing}\n"
"bind Entry <KP_Enter> {# nothing}\n"
"bind Entry <Tab> {# nothing}\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Entry <Command-KeyPress> {# nothing}\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
"bind Entry <Insert> {\n"
"catch {tkEntryInsert %W [selection get -displayof %W]}\n"
"}\n"
"}\n"
"bind Entry <Control-a> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntrySetCursor %W 0\n"
"}\n"
"}\n"
"bind Entry <Control-b> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntrySetCursor %W [expr {[%W index insert] - 1}]\n"
"}\n"
"}\n"
"bind Entry <Control-d> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert\n"
"}\n"
"}\n"
"bind Entry <Control-e> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntrySetCursor %W end\n"
"}\n"
"}\n"
"bind Entry <Control-f> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntrySetCursor %W [expr {[%W index insert] + 1}]\n"
"}\n"
"}\n"
"bind Entry <Control-h> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntryBackspace %W\n"
"}\n"
"}\n"
"bind Entry <Control-k> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert end\n"
"}\n"
"}\n"
"bind Entry <Control-t> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntryTranspose %W\n"
"}\n"
"}\n"
"bind Entry <Meta-b> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntrySetCursor %W [tkEntryPreviousWord %W insert]\n"
"}\n"
"}\n"
"bind Entry <Meta-d> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert [tkEntryNextWord %W insert]\n"
"}\n"
"}\n"
"bind Entry <Meta-f> {\n"
"if {!$tk_strictMotif} {\n"
"tkEntrySetCursor %W [tkEntryNextWord %W insert]\n"
"}\n"
"}\n"
"bind Entry <Meta-BackSpace> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete [tkEntryPreviousWord %W insert] insert\n"
"}\n"
"}\n"
"bind Entry <Meta-Delete> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete [tkEntryPreviousWord %W insert] insert\n"
"}\n"
"}\n"
"bind Entry <2> {\n"
"if {!$tk_strictMotif} {\n"
"%W scan mark %x\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"set tkPriv(mouseMoved) 0\n"
"}\n"
"}\n"
"bind Entry <B2-Motion> {\n"
"if {!$tk_strictMotif} {\n"
"if {abs(%x-$tkPriv(x)) > 2} {\n"
"set tkPriv(mouseMoved) 1\n"
"}\n"
"%W scan dragto %x\n"
"}\n"
"}\n"
"proc tkEntryClosestGap {w x} {\n"
"set pos [$w index @$x]\n"
"set bbox [$w bbox $pos]\n"
"if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {\n"
"return $pos\n"
"}\n"
"incr pos\n"
"}\n"
"proc tkEntryButton1 {w x} {\n"
"global tkPriv\n"
"set tkPriv(selectMode) char\n"
"set tkPriv(mouseMoved) 0\n"
"set tkPriv(pressX) $x\n"
"$w icursor [tkEntryClosestGap $w $x]\n"
"$w selection from insert\n"
"if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
"}\n"
"proc tkEntryMouseSelect {w x} {\n"
"global tkPriv\n"
"set cur [tkEntryClosestGap $w $x]\n"
"set anchor [$w index anchor]\n"
"if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {\n"
"set tkPriv(mouseMoved) 1\n"
"}\n"
"switch $tkPriv(selectMode) {\n"
"char {\n"
"if {$tkPriv(mouseMoved)} {\n"
"if {$cur < $anchor} {\n"
"$w selection range $cur $anchor\n"
"} elseif {$cur > $anchor} {\n"
"$w selection range $anchor $cur\n"
"} else {\n"
"$w selection clear\n"
"}\n"
"}\n"
"}\n"
"word {\n"
"if {$cur < [$w index anchor]} {\n"
"set before [tcl_wordBreakBefore [$w get] $cur]\n"
"set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]\n"
"} else {\n"
"set before [tcl_wordBreakBefore [$w get] $anchor]\n"
"set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]\n"
"}\n"
"if {$before < 0} {\n"
"set before 0\n"
"}\n"
"if {$after < 0} {\n"
"set after end\n"
"}\n"
"$w selection range $before $after\n"
"}\n"
"line {\n"
"$w selection range 0 end\n"
"}\n"
"}\n"
"update idletasks\n"
"}\n"
"proc tkEntryPaste {w x} {\n"
"global tkPriv\n"
"$w icursor [tkEntryClosestGap $w $x]\n"
"catch {$w insert insert [selection get -displayof $w]}\n"
"if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
"}\n"
"proc tkEntryAutoScan {w} {\n"
"global tkPriv\n"
"set x $tkPriv(x)\n"
"if {![winfo exists $w]} return\n"
"if {$x >= [winfo width $w]} {\n"
"$w xview scroll 2 units\n"
"tkEntryMouseSelect $w $x\n"
"} elseif {$x < 0} {\n"
"$w xview scroll -2 units\n"
"tkEntryMouseSelect $w $x\n"
"}\n"
"set tkPriv(afterId) [after 50 [list tkEntryAutoScan $w]]\n"
"}\n"
"proc tkEntryKeySelect {w new} {\n"
"if {![$w selection present]} {\n"
"$w selection from insert\n"
"$w selection to $new\n"
"} else {\n"
"$w selection adjust $new\n"
"}\n"
"$w icursor $new\n"
"}\n"
"proc tkEntryInsert {w s} {\n"
"if {[string equal $s \"\"]} {\n"
"return\n"
"}\n"
"catch {\n"
"set insert [$w index insert]\n"
"if {([$w index sel.first] <= $insert)\n"
"&& ([$w index sel.last] >= $insert)} {\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"$w insert insert $s\n"
"tkEntrySeeInsert $w\n"
"}\n"
"proc tkEntryBackspace w {\n"
"if {[$w selection present]} {\n"
"$w delete sel.first sel.last\n"
"} else {\n"
"set x [expr {[$w index insert] - 1}]\n"
"if {$x >= 0} {$w delete $x}\n"
"if {[$w index @0] >= [$w index insert]} {\n"
"set range [$w xview]\n"
"set left [lindex $range 0]\n"
"set right [lindex $range 1]\n"
"$w xview moveto [expr {$left - ($right - $left)/2.0}]\n"
"}\n"
"}\n"
"}\n"
"proc tkEntrySeeInsert w {\n"
"set c [$w index insert]\n"
"if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {\n"
"$w xview $c\n"
"}\n"
"}\n"
"proc tkEntrySetCursor {w pos} {\n"
"$w icursor $pos\n"
"$w selection clear\n"
"tkEntrySeeInsert $w\n"
"}\n"
"proc tkEntryTranspose w {\n"
"set i [$w index insert]\n"
"if {$i < [$w index end]} {\n"
"incr i\n"
"}\n"
"set first [expr {$i-2}]\n"
"if {$first < 0} {\n"
"return\n"
"}\n"
"set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]\n"
"$w delete $first $i\n"
"$w insert insert $new\n"
"tkEntrySeeInsert $w\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"windows\"]}  {\n"
"proc tkEntryNextWord {w start} {\n"
"set pos [tcl_endOfWord [$w get] [$w index $start]]\n"
"if {$pos >= 0} {\n"
"set pos [tcl_startOfNextWord [$w get] $pos]\n"
"}\n"
"if {$pos < 0} {\n"
"return end\n"
"}\n"
"return $pos\n"
"}\n"
"} else {\n"
"proc tkEntryNextWord {w start} {\n"
"set pos [tcl_endOfWord [$w get] [$w index $start]]\n"
"if {$pos < 0} {\n"
"return end\n"
"}\n"
"return $pos\n"
"}\n"
"}\n"
"proc tkEntryPreviousWord {w start} {\n"
"set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]\n"
"if {$pos < 0} {\n"
"return 0\n"
"}\n"
"return $pos\n"
"}\n"
"proc tkEntryGetSelection {w} {\n"
"set entryString [string range [$w get] [$w index sel.first] \\\n"
"\011    [expr {[$w index sel.last] - 1}]]\n"
"if {[string compare [$w cget -show] \"\"]} {\n"
"regsub -all . $entryString [string index [$w cget -show] 0] entryString\n"
"}\n"
"return $entryString\n"
"}\n"
;
static char Et_zFile15[] = 
"proc tk_focusNext w {\n"
"set cur $w\n"
"while {1} {\n"
"set parent $cur\n"
"set children [winfo children $cur]\n"
"set i -1\n"
"while {1} {\n"
"incr i\n"
"if {$i < [llength $children]} {\n"
"set cur [lindex $children $i]\n"
"if {[string equal [winfo toplevel $cur] $cur]} {\n"
"continue\n"
"} else {\n"
"break\n"
"}\n"
"}\n"
"set cur $parent\n"
"if {[string equal [winfo toplevel $cur] $cur]} {\n"
"break\n"
"}\n"
"set parent [winfo parent $parent]\n"
"set children [winfo children $parent]\n"
"set i [lsearch -exact $children $cur]\n"
"}\n"
"if {[string equal $w $cur] || [tkFocusOK $cur]} {\n"
"return $cur\n"
"}\n"
"}\n"
"}\n"
"proc tk_focusPrev w {\n"
"set cur $w\n"
"while {1} {\n"
"if {[string equal [winfo toplevel $cur] $cur]}  {\n"
"set parent $cur\n"
"set children [winfo children $cur]\n"
"set i [llength $children]\n"
"} else {\n"
"set parent [winfo parent $cur]\n"
"set children [winfo children $parent]\n"
"set i [lsearch -exact $children $cur]\n"
"}\n"
"while {$i > 0} {\n"
"incr i -1\n"
"set cur [lindex $children $i]\n"
"if {[string equal [winfo toplevel $cur] $cur]} {\n"
"continue\n"
"}\n"
"set parent $cur\n"
"set children [winfo children $parent]\n"
"set i [llength $children]\n"
"}\n"
"set cur $parent\n"
"if {[string equal $w $cur] || [tkFocusOK $cur]} {\n"
"return $cur\n"
"}\n"
"}\n"
"}\n"
"proc tkFocusOK w {\n"
"set code [catch {$w cget -takefocus} value]\n"
"if {($code == 0) && [string compare $value \"\"]} {\n"
"if {$value == 0} {\n"
"return 0\n"
"} elseif {$value == 1} {\n"
"return [winfo viewable $w]\n"
"} else {\n"
"set value [uplevel #0 [list $value $w]]\n"
"if {[string compare $value \"\"]} {\n"
"return $value\n"
"}\n"
"}\n"
"}\n"
"if {![winfo viewable $w]} {\n"
"return 0\n"
"}\n"
"set code [catch {$w cget -state} value]\n"
"if {($code == 0) && [string equal $value \"disabled\"]} {\n"
"return 0\n"
"}\n"
"regexp Key|Focus \"[bind $w] [bind [winfo class $w]]\"\n"
"}\n"
"proc tk_focusFollowsMouse {} {\n"
"set old [bind all <Enter>]\n"
"set script {\n"
"if {[string equal \"%d\" \"NotifyAncestor\"] \\\n"
"\011\011|| [string equal \"%d\" \"NotifyNonlinear\"] \\\n"
"\011\011|| [string equal \"%d\" \"NotifyInferior\"]} {\n"
"if {[tkFocusOK %W]} {\n"
"focus %W\n"
"}\n"
"}\n"
"}\n"
"if {[string compare $old \"\"]} {\n"
"bind all <Enter> \"$old; $script\"\n"
"} else {\n"
"bind all <Enter> $script\n"
"}\n"
"}\n"
;
static char Et_zFile16[] = 
"bind Listbox <1> {\n"
"if {[winfo exists %W]} {\n"
"tkListboxBeginSelect %W [%W index @%x,%y]\n"
"}\n"
"}\n"
"bind Listbox <Double-1> {\n"
"}\n"
"bind Listbox <B1-Motion> {\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"tkListboxMotion %W [%W index @%x,%y]\n"
"}\n"
"bind Listbox <ButtonRelease-1> {\n"
"tkCancelRepeat\n"
"%W activate @%x,%y\n"
"}\n"
"bind Listbox <Shift-1> {\n"
"tkListboxBeginExtend %W [%W index @%x,%y]\n"
"}\n"
"bind Listbox <Control-1> {\n"
"tkListboxBeginToggle %W [%W index @%x,%y]\n"
"}\n"
"bind Listbox <B1-Leave> {\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"tkListboxAutoScan %W\n"
"}\n"
"bind Listbox <B1-Enter> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Listbox <Up> {\n"
"tkListboxUpDown %W -1\n"
"}\n"
"bind Listbox <Shift-Up> {\n"
"tkListboxExtendUpDown %W -1\n"
"}\n"
"bind Listbox <Down> {\n"
"tkListboxUpDown %W 1\n"
"}\n"
"bind Listbox <Shift-Down> {\n"
"tkListboxExtendUpDown %W 1\n"
"}\n"
"bind Listbox <Left> {\n"
"%W xview scroll -1 units\n"
"}\n"
"bind Listbox <Control-Left> {\n"
"%W xview scroll -1 pages\n"
"}\n"
"bind Listbox <Right> {\n"
"%W xview scroll 1 units\n"
"}\n"
"bind Listbox <Control-Right> {\n"
"%W xview scroll 1 pages\n"
"}\n"
"bind Listbox <Prior> {\n"
"%W yview scroll -1 pages\n"
"%W activate @0,0\n"
"}\n"
"bind Listbox <Next> {\n"
"%W yview scroll 1 pages\n"
"%W activate @0,0\n"
"}\n"
"bind Listbox <Control-Prior> {\n"
"%W xview scroll -1 pages\n"
"}\n"
"bind Listbox <Control-Next> {\n"
"%W xview scroll 1 pages\n"
"}\n"
"bind Listbox <Home> {\n"
"%W xview moveto 0\n"
"}\n"
"bind Listbox <End> {\n"
"%W xview moveto 1\n"
"}\n"
"bind Listbox <Control-Home> {\n"
"%W activate 0\n"
"%W see 0\n"
"%W selection clear 0 end\n"
"%W selection set 0\n"
"event generate %W <<ListboxSelect>>\n"
"}\n"
"bind Listbox <Shift-Control-Home> {\n"
"tkListboxDataExtend %W 0\n"
"}\n"
"bind Listbox <Control-End> {\n"
"%W activate end\n"
"%W see end\n"
"%W selection clear 0 end\n"
"%W selection set end\n"
"event generate %W <<ListboxSelect>>\n"
"}\n"
"bind Listbox <Shift-Control-End> {\n"
"tkListboxDataExtend %W [%W index end]\n"
"}\n"
"bind Listbox <<Copy>> {\n"
"if {[string equal [selection own -displayof %W] \"%W\"]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W [selection get -displayof %W]\n"
"}\n"
"}\n"
"bind Listbox <space> {\n"
"tkListboxBeginSelect %W [%W index active]\n"
"}\n"
"bind Listbox <Select> {\n"
"tkListboxBeginSelect %W [%W index active]\n"
"}\n"
"bind Listbox <Control-Shift-space> {\n"
"tkListboxBeginExtend %W [%W index active]\n"
"}\n"
"bind Listbox <Shift-Select> {\n"
"tkListboxBeginExtend %W [%W index active]\n"
"}\n"
"bind Listbox <Escape> {\n"
"tkListboxCancel %W\n"
"}\n"
"bind Listbox <Control-slash> {\n"
"tkListboxSelectAll %W\n"
"}\n"
"bind Listbox <Control-backslash> {\n"
"if {[string compare [%W cget -selectmode] \"browse\"]} {\n"
"%W selection clear 0 end\n"
"event generate %W <<ListboxSelect>>\n"
"}\n"
"}\n"
"bind Listbox <2> {\n"
"%W scan mark %x %y\n"
"}\n"
"bind Listbox <B2-Motion> {\n"
"%W scan dragto %x %y\n"
"}\n"
"bind Listbox <MouseWheel> {\n"
"%W yview scroll [expr {- (%D / 120) * 4}] units\n"
"}\n"
"if {[string equal \"unix\" $tcl_platform(platform)]} {\n"
"bind Listbox <4> {\n"
"if {!$tk_strictMotif} {\n"
"%W yview scroll -5 units\n"
"}\n"
"}\n"
"bind Listbox <5> {\n"
"if {!$tk_strictMotif} {\n"
"%W yview scroll 5 units\n"
"}\n"
"}\n"
"}\n"
"proc tkListboxBeginSelect {w el} {\n"
"global tkPriv\n"
"if {[string equal [$w cget -selectmode] \"multiple\"]} {\n"
"if {[$w selection includes $el]} {\n"
"$w selection clear $el\n"
"} else {\n"
"$w selection set $el\n"
"}\n"
"} else {\n"
"$w selection clear 0 end\n"
"$w selection set $el\n"
"$w selection anchor $el\n"
"set tkPriv(listboxSelection) {}\n"
"set tkPriv(listboxPrev) $el\n"
"}\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"proc tkListboxMotion {w el} {\n"
"global tkPriv\n"
"if {$el == $tkPriv(listboxPrev)} {\n"
"return\n"
"}\n"
"set anchor [$w index anchor]\n"
"switch [$w cget -selectmode] {\n"
"browse {\n"
"$w selection clear 0 end\n"
"$w selection set $el\n"
"set tkPriv(listboxPrev) $el\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"extended {\n"
"set i $tkPriv(listboxPrev)\n"
"if {[string equal {} $i]} {\n"
"set i $el\n"
"$w selection set $el\n"
"}\n"
"if {[$w selection includes anchor]} {\n"
"$w selection clear $i $el\n"
"$w selection set anchor $el\n"
"} else {\n"
"$w selection clear $i $el\n"
"$w selection clear anchor $el\n"
"}\n"
"if {![info exists tkPriv(listboxSelection)]} {\n"
"set tkPriv(listboxSelection) [$w curselection]\n"
"}\n"
"while {($i < $el) && ($i < $anchor)} {\n"
"if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {\n"
"$w selection set $i\n"
"}\n"
"incr i\n"
"}\n"
"while {($i > $el) && ($i > $anchor)} {\n"
"if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {\n"
"$w selection set $i\n"
"}\n"
"incr i -1\n"
"}\n"
"set tkPriv(listboxPrev) $el\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"}\n"
"}\n"
"proc tkListboxBeginExtend {w el} {\n"
"if {[string equal [$w cget -selectmode] \"extended\"]} {\n"
"if {[$w selection includes anchor]} {\n"
"tkListboxMotion $w $el\n"
"} else {\n"
"tkListboxBeginSelect $w $el\n"
"}\n"
"}\n"
"}\n"
"proc tkListboxBeginToggle {w el} {\n"
"global tkPriv\n"
"if {[string equal [$w cget -selectmode] \"extended\"]} {\n"
"set tkPriv(listboxSelection) [$w curselection]\n"
"set tkPriv(listboxPrev) $el\n"
"$w selection anchor $el\n"
"if {[$w selection includes $el]} {\n"
"$w selection clear $el\n"
"} else {\n"
"$w selection set $el\n"
"}\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"}\n"
"proc tkListboxAutoScan {w} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"set x $tkPriv(x)\n"
"set y $tkPriv(y)\n"
"if {$y >= [winfo height $w]} {\n"
"$w yview scroll 1 units\n"
"} elseif {$y < 0} {\n"
"$w yview scroll -1 units\n"
"} elseif {$x >= [winfo width $w]} {\n"
"$w xview scroll 2 units\n"
"} elseif {$x < 0} {\n"
"$w xview scroll -2 units\n"
"} else {\n"
"return\n"
"}\n"
"tkListboxMotion $w [$w index @$x,$y]\n"
"set tkPriv(afterId) [after 50 [list tkListboxAutoScan $w]]\n"
"}\n"
"proc tkListboxUpDown {w amount} {\n"
"global tkPriv\n"
"$w activate [expr {[$w index active] + $amount}]\n"
"$w see active\n"
"switch [$w cget -selectmode] {\n"
"browse {\n"
"$w selection clear 0 end\n"
"$w selection set active\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"extended {\n"
"$w selection clear 0 end\n"
"$w selection set active\n"
"$w selection anchor active\n"
"set tkPriv(listboxPrev) [$w index active]\n"
"set tkPriv(listboxSelection) {}\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"}\n"
"}\n"
"proc tkListboxExtendUpDown {w amount} {\n"
"if {[string compare [$w cget -selectmode] \"extended\"]} {\n"
"return\n"
"}\n"
"set active [$w index active]\n"
"if {![info exists tkPriv(listboxSelection)]} {\n"
"global tkPriv\n"
"$w selection set $active\n"
"set tkPriv(listboxSelection) [$w curselection]\n"
"}\n"
"$w activate [expr {$active + $amount}]\n"
"$w see active\n"
"tkListboxMotion $w [$w index active]\n"
"}\n"
"proc tkListboxDataExtend {w el} {\n"
"set mode [$w cget -selectmode]\n"
"if {[string equal $mode \"extended\"]} {\n"
"$w activate $el\n"
"$w see $el\n"
"if {[$w selection includes anchor]} {\n"
"tkListboxMotion $w $el\n"
"}\n"
"} elseif {[string equal $mode \"multiple\"]} {\n"
"$w activate $el\n"
"$w see $el\n"
"}\n"
"}\n"
"proc tkListboxCancel w {\n"
"global tkPriv\n"
"if {[string compare [$w cget -selectmode] \"extended\"]} {\n"
"return\n"
"}\n"
"set first [$w index anchor]\n"
"set last $tkPriv(listboxPrev)\n"
"if { [string equal $last \"\"] } {\n"
"return\n"
"}\n"
"if {$first > $last} {\n"
"set tmp $first\n"
"set first $last\n"
"set last $tmp\n"
"}\n"
"$w selection clear $first $last\n"
"while {$first <= $last} {\n"
"if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {\n"
"$w selection set $first\n"
"}\n"
"incr first\n"
"}\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
"proc tkListboxSelectAll w {\n"
"set mode [$w cget -selectmode]\n"
"if {[string equal $mode \"single\"] || [string equal $mode \"browse\"]} {\n"
"$w selection clear 0 end\n"
"$w selection set active\n"
"} else {\n"
"$w selection set 0 end\n"
"}\n"
"event generate $w <<ListboxSelect>>\n"
"}\n"
;
static char Et_zFile17[] = 
"bind Menubutton <FocusIn> {}\n"
"bind Menubutton <Enter> {\n"
"tkMbEnter %W\n"
"}\n"
"bind Menubutton <Leave> {\n"
"tkMbLeave %W\n"
"}\n"
"bind Menubutton <1> {\n"
"if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
"tkMbPost $tkPriv(inMenubutton) %X %Y\n"
"}\n"
"}\n"
"bind Menubutton <Motion> {\n"
"tkMbMotion %W up %X %Y\n"
"}\n"
"bind Menubutton <B1-Motion> {\n"
"tkMbMotion %W down %X %Y\n"
"}\n"
"bind Menubutton <ButtonRelease-1> {\n"
"tkMbButtonUp %W\n"
"}\n"
"bind Menubutton <space> {\n"
"tkMbPost %W\n"
"tkMenuFirstEntry [%W cget -menu]\n"
"}\n"
"bind Menu <FocusIn> {}\n"
"bind Menu <Enter> {\n"
"set tkPriv(window) %W\n"
"if {[string equal [%W cget -type] \"tearoff\"]} {\n"
"if {[string compare \"%m\" \"NotifyUngrab\"]} {\n"
"if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
"tk_menuSetFocus %W\n"
"}\n"
"}\n"
"}\n"
"tkMenuMotion %W %x %y %s\n"
"}\n"
"bind Menu <Leave> {\n"
"tkMenuLeave %W %X %Y %s\n"
"}\n"
"bind Menu <Motion> {\n"
"tkMenuMotion %W %x %y %s\n"
"}\n"
"bind Menu <ButtonPress> {\n"
"tkMenuButtonDown %W\n"
"}\n"
"bind Menu <ButtonRelease> {\n"
"tkMenuInvoke %W 1\n"
"}\n"
"bind Menu <space> {\n"
"tkMenuInvoke %W 0\n"
"}\n"
"bind Menu <Return> {\n"
"tkMenuInvoke %W 0\n"
"}\n"
"bind Menu <Escape> {\n"
"tkMenuEscape %W\n"
"}\n"
"bind Menu <Left> {\n"
"tkMenuLeftArrow %W\n"
"}\n"
"bind Menu <Right> {\n"
"tkMenuRightArrow %W\n"
"}\n"
"bind Menu <Up> {\n"
"tkMenuUpArrow %W\n"
"}\n"
"bind Menu <Down> {\n"
"tkMenuDownArrow %W\n"
"}\n"
"bind Menu <KeyPress> {\n"
"tkTraverseWithinMenu %W %A\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
"bind all <Alt-KeyPress> {\n"
"tkTraverseToMenu %W %A\n"
"}\n"
"bind all <F10> {\n"
"tkFirstMenu %W\n"
"}\n"
"} else {\n"
"bind Menubutton <Alt-KeyPress> {\n"
"tkTraverseToMenu %W %A\n"
"}\n"
"bind Menubutton <F10> {\n"
"tkFirstMenu %W\n"
"}\n"
"}\n"
"proc tkMbEnter w {\n"
"global tkPriv\n"
"if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
"tkMbLeave $tkPriv(inMenubutton)\n"
"}\n"
"set tkPriv(inMenubutton) $w\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"$w configure -state active\n"
"}\n"
"}\n"
"proc tkMbLeave w {\n"
"global tkPriv\n"
"set tkPriv(inMenubutton) {}\n"
"if {![winfo exists $w]} {\n"
"return\n"
"}\n"
"if {[string equal [$w cget -state] \"active\"]} {\n"
"$w configure -state normal\n"
"}\n"
"}\n"
"proc tkMbPost {w {x {}} {y {}}} {\n"
"global tkPriv errorInfo\n"
"global tcl_platform\n"
"if {[string equal [$w cget -state] \"disabled\"] || \\\n"
"\011    [string equal $w $tkPriv(postedMb)]} {\n"
"return\n"
"}\n"
"set menu [$w cget -menu]\n"
"if {[string equal $menu \"\"]} {\n"
"return\n"
"}\n"
"set tearoff [expr {[string equal $tcl_platform(platform) \"unix\"] \\\n"
"\011    || [string equal [$menu cget -type] \"tearoff\"]}]\n"
"if {[string first $w $menu] != 0} {\n"
"error \"can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)\"\n"
"}\n"
"set cur $tkPriv(postedMb)\n"
"if {[string compare $cur \"\"]} {\n"
"tkMenuUnpost {}\n"
"}\n"
"set tkPriv(cursor) [$w cget -cursor]\n"
"set tkPriv(relief) [$w cget -relief]\n"
"$w configure -cursor arrow\n"
"$w configure -relief raised\n"
"set tkPriv(postedMb) $w\n"
"set tkPriv(focus) [focus]\n"
"$menu activate none\n"
"tkGenerateMenuSelect $menu\n"
"update idletasks\n"
"if {[catch {\n"
"switch [$w cget -direction] {\n"
"above {\n"
"set x [winfo rootx $w]\n"
"set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]\n"
"$menu post $x $y\n"
"}\n"
"below {\n"
"set x [winfo rootx $w]\n"
"set y [expr {[winfo rooty $w] + [winfo height $w]}]\n"
"$menu post $x $y\n"
"}\n"
"left {\n"
"set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]\n"
"set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]\n"
"set entry [tkMenuFindName $menu [$w cget -text]]\n"
"if {[$w cget -indicatoron]} {\n"
"if {$entry == [$menu index last]} {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"\011\011\011    \011+ [winfo reqheight $menu])/2}]\n"
"} else {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"\011\011\011        + [$menu yposition [expr {$entry+1}]])/2}]\n"
"}\n"
"}\n"
"$menu post $x $y\n"
"if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] \"disabled\"]} {\n"
"$menu activate $entry\n"
"tkGenerateMenuSelect $menu\n"
"}\n"
"}\n"
"right {\n"
"set x [expr {[winfo rootx $w] + [winfo width $w]}]\n"
"set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]\n"
"set entry [tkMenuFindName $menu [$w cget -text]]\n"
"if {[$w cget -indicatoron]} {\n"
"if {$entry == [$menu index last]} {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"\011\011\011    \011+ [winfo reqheight $menu])/2}]\n"
"} else {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"\011\011\011        + [$menu yposition [expr {$entry+1}]])/2}]\n"
"}\n"
"}\n"
"$menu post $x $y\n"
"if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] \"disabled\"]} {\n"
"$menu activate $entry\n"
"tkGenerateMenuSelect $menu\n"
"}\n"
"}\n"
"default {\n"
"if {[$w cget -indicatoron]} {\n"
"if {[string equal $y {}]} {\n"
"set x [expr {[winfo rootx $w] + [winfo width $w]/2}]\n"
"set y [expr {[winfo rooty $w] + [winfo height $w]/2}]\n"
"}\n"
"tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]\n"
"} else {\n"
"$menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]\n"
"}  \n"
"}\n"
"}\n"
"} msg]} {\n"
"set savedInfo $errorInfo\n"
"tkMenuUnpost {}\n"
"error $msg $savedInfo\n"
"}\n"
"set tkPriv(tearoff) $tearoff\n"
"if {$tearoff != 0} {\n"
"focus $menu\n"
"if {[winfo viewable $w]} {\n"
"tkSaveGrabInfo $w\n"
"grab -global $w\n"
"}\n"
"}\n"
"}\n"
"proc tkMenuUnpost menu {\n"
"global tcl_platform\n"
"global tkPriv\n"
"set mb $tkPriv(postedMb)\n"
"catch {focus $tkPriv(focus)}\n"
"set tkPriv(focus) \"\"\n"
"catch {\n"
"if {[string compare $mb \"\"]} {\n"
"set menu [$mb cget -menu]\n"
"$menu unpost\n"
"set tkPriv(postedMb) {}\n"
"$mb configure -cursor $tkPriv(cursor)\n"
"$mb configure -relief $tkPriv(relief)\n"
"} elseif {[string compare $tkPriv(popup) \"\"]} {\n"
"$tkPriv(popup) unpost\n"
"set tkPriv(popup) {}\n"
"} elseif {[string compare [$menu cget -type] \"menubar\"] \\\n"
"\011\011&& [string compare [$menu cget -type] \"tearoff\"]} {\n"
"while {1} {\n"
"set parent [winfo parent $menu]\n"
"if {[string compare [winfo class $parent] \"Menu\"] \\\n"
"\011\011\011|| ![winfo ismapped $parent]} {\n"
"break\n"
"}\n"
"$parent activate none\n"
"$parent postcascade none\n"
"tkGenerateMenuSelect $parent\n"
"set type [$parent cget -type]\n"
"if {[string equal $type \"menubar\"] || \\\n"
"\011\011\011[string equal $type \"tearoff\"]} {\n"
"break\n"
"}\n"
"set menu $parent\n"
"}\n"
"if {[string compare [$menu cget -type] \"menubar\"]} {\n"
"$menu unpost\n"
"}\n"
"}\n"
"}\n"
"if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) \"\"]} {\n"
"if {[string compare $menu \"\"]} {\n"
"set grab [grab current $menu]\n"
"if {[string compare $grab \"\"]} {\n"
"grab release $grab\n"
"}\n"
"}\n"
"tkRestoreOldGrab\n"
"if {[string compare $tkPriv(menuBar) \"\"]} {\n"
"$tkPriv(menuBar) configure -cursor $tkPriv(cursor)\n"
"set tkPriv(menuBar) {}\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
"set tkPriv(tearoff) 0\n"
"}\n"
"}\n"
"}\n"
"proc tkMbMotion {w upDown rootx rooty} {\n"
"global tkPriv\n"
"if {[string equal $tkPriv(inMenubutton) $w]} {\n"
"return\n"
"}\n"
"set new [winfo containing $rootx $rooty]\n"
"if {[string compare $new $tkPriv(inMenubutton)] \\\n"
"\011    && ([string equal $new \"\"] \\\n"
"\011    || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {\n"
"if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
"tkMbLeave $tkPriv(inMenubutton)\n"
"}\n"
"if {[string compare $new \"\"] \\\n"
"\011\011&& [string equal [winfo class $new] \"Menubutton\"] \\\n"
"\011\011&& ([$new cget -indicatoron] == 0) \\\n"
"\011\011&& ([$w cget -indicatoron] == 0)} {\n"
"if {[string equal $upDown \"down\"]} {\n"
"tkMbPost $new $rootx $rooty\n"
"} else {\n"
"tkMbEnter $new\n"
"}\n"
"}\n"
"}\n"
"}\n"
"proc tkMbButtonUp w {\n"
"global tkPriv\n"
"global tcl_platform\n"
"set menu [$w cget -menu]\n"
"set tearoff [expr {[string equal $tcl_platform(platform) \"unix\"] || \\\n"
"\011    ([string compare $menu {}] && \\\n"
"\011    [string equal [$menu cget -type] \"tearoff\"])}]\n"
"if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \\\n"
"\011    && [string equal $tkPriv(inMenubutton) $w]} {\n"
"tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]\n"
"} else {\n"
"tkMenuUnpost {}\n"
"}\n"
"}\n"
"proc tkMenuMotion {menu x y state} {\n"
"global tkPriv\n"
"if {[string equal $menu $tkPriv(window)]} {\n"
"if {[string equal [$menu cget -type] \"menubar\"]} {\n"
"if {[info exists tkPriv(focus)] && \\\n"
"\011\011    [string compare $menu $tkPriv(focus)]} {\n"
"$menu activate @$x,$y\n"
"tkGenerateMenuSelect $menu\n"
"}\n"
"} else {\n"
"$menu activate @$x,$y\n"
"tkGenerateMenuSelect $menu\n"
"}\n"
"}\n"
"if {($state & 0x1f00) != 0} {\n"
"$menu postcascade active\n"
"}\n"
"}\n"
"proc tkMenuButtonDown menu {\n"
"global tkPriv\n"
"global tcl_platform\n"
"if {![winfo viewable $menu]} {\n"
"return\n"
"}\n"
"$menu postcascade active\n"
"if {[string compare $tkPriv(postedMb) \"\"] && \\\n"
"\011    [winfo viewable $tkPriv(postedMb)]} {\n"
"grab -global $tkPriv(postedMb)\n"
"} else {\n"
"while {[string equal [$menu cget -type] \"normal\"] \\\n"
"\011\011&& [string equal [winfo class [winfo parent $menu]] \"Menu\"] \\\n"
"\011\011&& [winfo ismapped [winfo parent $menu]]} {\n"
"set menu [winfo parent $menu]\n"
"}\n"
"if {[string equal $tkPriv(menuBar) {}]} {\n"
"set tkPriv(menuBar) $menu\n"
"set tkPriv(cursor) [$menu cget -cursor]\n"
"$menu configure -cursor arrow\n"
"}\n"
"if {[string compare $menu [grab current $menu]]} {\n"
"tkSaveGrabInfo $menu\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
"grab -global $menu\n"
"}\n"
"}\n"
"}\n"
"proc tkMenuLeave {menu rootx rooty state} {\n"
"global tkPriv\n"
"set tkPriv(window) {}\n"
"if {[string equal [$menu index active] \"none\"]} {\n"
"return\n"
"}\n"
"if {[string equal [$menu type active] \"cascade\"]\n"
"&& [string equal [winfo containing $rootx $rooty] \\\n"
"                  [$menu entrycget active -menu]]} {\n"
"return\n"
"}\n"
"$menu activate none\n"
"tkGenerateMenuSelect $menu\n"
"}\n"
"proc tkMenuInvoke {w buttonRelease} {\n"
"global tkPriv\n"
"if {$buttonRelease && [string equal $tkPriv(window) {}]} {\n"
"$w postcascade none\n"
"$w activate none\n"
"event generate $w <<MenuSelect>>\n"
"tkMenuUnpost $w\n"
"return\n"
"}\n"
"if {[string equal [$w type active] \"cascade\"]} {\n"
"$w postcascade active\n"
"set menu [$w entrycget active -menu]\n"
"tkMenuFirstEntry $menu\n"
"} elseif {[string equal [$w type active] \"tearoff\"]} {\n"
"tkTearOffMenu $w\n"
"tkMenuUnpost $w\n"
"} elseif {[string equal [$w cget -type] \"menubar\"]} {\n"
"$w postcascade none\n"
"set active [$w index active]\n"
"set isCascade [string equal [$w type $active] \"cascade\"]\n"
"if { $isCascade } {\n"
"$w activate none\n"
"event generate $w <<MenuSelect>>\n"
"}\n"
"tkMenuUnpost $w\n"
"if { !$isCascade } {\n"
"uplevel #0 [list $w invoke $active]\n"
"}\n"
"} else {\n"
"tkMenuUnpost $w\n"
"uplevel #0 [list $w invoke active]\n"
"}\n"
"}\n"
"proc tkMenuEscape menu {\n"
"set parent [winfo parent $menu]\n"
"if {[string compare [winfo class $parent] \"Menu\"]} {\n"
"tkMenuUnpost $menu\n"
"} elseif {[string equal [$parent cget -type] \"menubar\"]} {\n"
"tkMenuUnpost $menu\n"
"tkRestoreOldGrab\n"
"} else {\n"
"tkMenuNextMenu $menu left\n"
"}\n"
"}\n"
"proc tkMenuUpArrow {menu} {\n"
"if {[string equal [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextMenu $menu left\n"
"} else {\n"
"tkMenuNextEntry $menu -1\n"
"}\n"
"}\n"
"proc tkMenuDownArrow {menu} {\n"
"if {[string equal [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextMenu $menu right\n"
"} else {\n"
"tkMenuNextEntry $menu 1\n"
"}\n"
"}\n"
"proc tkMenuLeftArrow {menu} {\n"
"if {[string equal [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextEntry $menu -1\n"
"} else {\n"
"tkMenuNextMenu $menu left\n"
"}\n"
"}\n"
"proc tkMenuRightArrow {menu} {\n"
"if {[string equal [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextEntry $menu 1\n"
"} else {\n"
"tkMenuNextMenu $menu right\n"
"}\n"
"}\n"
"proc tkMenuNextMenu {menu direction} {\n"
"global tkPriv\n"
"if {[string equal $direction \"right\"]} {\n"
"set count 1\n"
"set parent [winfo parent $menu]\n"
"set class [winfo class $parent]\n"
"if {[string equal [$menu type active] \"cascade\"]} {\n"
"$menu postcascade active\n"
"set m2 [$menu entrycget active -menu]\n"
"if {[string compare $m2 \"\"]} {\n"
"tkMenuFirstEntry $m2\n"
"}\n"
"return\n"
"} else {\n"
"set parent [winfo parent $menu]\n"
"while {[string compare $parent \".\"]} {\n"
"if {[string equal [winfo class $parent] \"Menu\"] \\\n"
"\011\011\011&& [string equal [$parent cget -type] \"menubar\"]} {\n"
"tk_menuSetFocus $parent\n"
"tkMenuNextEntry $parent 1\n"
"return\n"
"}\n"
"set parent [winfo parent $parent]\n"
"}\n"
"}\n"
"} else {\n"
"set count -1\n"
"set m2 [winfo parent $menu]\n"
"if {[string equal [winfo class $m2] \"Menu\"]} {\n"
"if {[string compare [$m2 cget -type] \"menubar\"]} {\n"
"$menu activate none\n"
"tkGenerateMenuSelect $menu\n"
"tk_menuSetFocus $m2\n"
"set tmp [$m2 index active]\n"
"$m2 activate none\n"
"$m2 activate $tmp\n"
"return\n"
"}\n"
"}\n"
"}\n"
"set m2 [winfo parent $menu]\n"
"if {[string equal [winfo class $m2] \"Menu\"]} {\n"
"if {[string equal [$m2 cget -type] \"menubar\"]} {\n"
"tk_menuSetFocus $m2\n"
"tkMenuNextEntry $m2 -1\n"
"return\n"
"}\n"
"}\n"
"set w $tkPriv(postedMb)\n"
"if {[string equal $w \"\"]} {\n"
"return\n"
"}\n"
"set buttons [winfo children [winfo parent $w]]\n"
"set length [llength $buttons]\n"
"set i [expr {[lsearch -exact $buttons $w] + $count}]\n"
"while {1} {\n"
"while {$i < 0} {\n"
"incr i $length\n"
"}\n"
"while {$i >= $length} {\n"
"incr i -$length\n"
"}\n"
"set mb [lindex $buttons $i]\n"
"if {[string equal [winfo class $mb] \"Menubutton\"] \\\n"
"\011\011&& [string compare [$mb cget -state] \"disabled\"] \\\n"
"\011\011&& [string compare [$mb cget -menu] \"\"] \\\n"
"\011\011&& [string compare [[$mb cget -menu] index last] \"none\"]} {\n"
"break\n"
"}\n"
"if {[string equal $mb $w]} {\n"
"return\n"
"}\n"
"incr i $count\n"
"}\n"
"tkMbPost $mb\n"
"tkMenuFirstEntry [$mb cget -menu]\n"
"}\n"
"proc tkMenuNextEntry {menu count} {\n"
"global tkPriv\n"
"if {[string equal [$menu index last] \"none\"]} {\n"
"return\n"
"}\n"
"set length [expr {[$menu index last]+1}]\n"
"set quitAfter $length\n"
"set active [$menu index active]\n"
"if {[string equal $active \"none\"]} {\n"
"set i 0\n"
"} else {\n"
"set i [expr {$active + $count}]\n"
"}\n"
"while {1} {\n"
"if {$quitAfter <= 0} {\n"
"return\n"
"}\n"
"while {$i < 0} {\n"
"incr i $length\n"
"}\n"
"while {$i >= $length} {\n"
"incr i -$length\n"
"}\n"
"if {[catch {$menu entrycget $i -state} state] == 0} {\n"
"if {[string compare $state \"disabled\"]} {\n"
"break\n"
"}\n"
"}\n"
"if {$i == $active} {\n"
"return\n"
"}\n"
"incr i $count\n"
"incr quitAfter -1\n"
"}\n"
"$menu activate $i\n"
"tkGenerateMenuSelect $menu\n"
"if {[string equal [$menu type $i] \"cascade\"]} {\n"
"set cascade [$menu entrycget $i -menu]\n"
"if {[string compare $cascade \"\"]} {\n"
"$menu postcascade $i\n"
"tkMenuFirstEntry $cascade\n"
"}\n"
"}\n"
"}\n"
"proc tkMenuFind {w char} {\n"
"global tkPriv\n"
"set char [string tolower $char]\n"
"set windowlist [winfo child $w]\n"
"foreach child $windowlist {\n"
"if {[string compare [winfo toplevel [focus]] \\\n"
"\011\011[winfo toplevel $child]]} {\n"
"continue\n"
"}\n"
"if {[string equal [winfo class $child] \"Menu\"] && \\\n"
"\011\011[string equal [$child cget -type] \"menubar\"]} {\n"
"if {[string equal $char \"\"]} {\n"
"return $child\n"
"}\n"
"set last [$child index last]\n"
"for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {\n"
"if {[string equal [$child type $i] \"separator\"]} {\n"
"continue\n"
"}\n"
"set char2 [string index [$child entrycget $i -label] \\\n"
"\011\011\011[$child entrycget $i -underline]]\n"
"if {[string equal $char [string tolower $char2]] \\\n"
"\011\011\011|| [string equal $char \"\"]} {\n"
"if {[string compare [$child entrycget $i -state] \"disabled\"]} {\n"
"return $child\n"
"}\n"
"}\n"
"}\n"
"}\n"
"}\n"
"foreach child $windowlist {\n"
"if {[string compare [winfo toplevel [focus]] \\\n"
"\011\011[winfo toplevel $child]]} {\n"
"continue\n"
"}\n"
"switch [winfo class $child] {\n"
"Menubutton {\n"
"set char2 [string index [$child cget -text] \\\n"
"\011\011\011[$child cget -underline]]\n"
"if {[string equal $char [string tolower $char2]] \\\n"
"\011\011\011|| [string equal $char \"\"]} {\n"
"if {[string compare [$child cget -state] \"disabled\"]} {\n"
"return $child\n"
"}\n"
"}\n"
"}\n"
"default {\n"
"set match [tkMenuFind $child $char]\n"
"if {[string compare $match \"\"]} {\n"
"return $match\n"
"}\n"
"}\n"
"}\n"
"}\n"
"return {}\n"
"}\n"
"proc tkTraverseToMenu {w char} {\n"
"global tkPriv\n"
"if {[string equal $char \"\"]} {\n"
"return\n"
"}\n"
"while {[string equal [winfo class $w] \"Menu\"]} {\n"
"if {[string compare [$w cget -type] \"menubar\"] \\\n"
"\011\011&& [string equal $tkPriv(postedMb) \"\"]} {\n"
"return\n"
"}\n"
"if {[string equal [$w cget -type] \"menubar\"]} {\n"
"break\n"
"}\n"
"set w [winfo parent $w]\n"
"}\n"
"set w [tkMenuFind [winfo toplevel $w] $char]\n"
"if {[string compare $w \"\"]} {\n"
"if {[string equal [winfo class $w] \"Menu\"]} {\n"
"tk_menuSetFocus $w\n"
"set tkPriv(window) $w\n"
"tkSaveGrabInfo $w\n"
"grab -global $w\n"
"tkTraverseWithinMenu $w $char\n"
"} else {\n"
"tkMbPost $w\n"
"tkMenuFirstEntry [$w cget -menu]\n"
"}\n"
"}\n"
"}\n"
"proc tkFirstMenu w {\n"
"set w [tkMenuFind [winfo toplevel $w] \"\"]\n"
"if {[string compare $w \"\"]} {\n"
"if {[string equal [winfo class $w] \"Menu\"]} {\n"
"tk_menuSetFocus $w\n"
"set tkPriv(window) $w\n"
"tkSaveGrabInfo $w\n"
"grab -global $w\n"
"tkMenuFirstEntry $w\n"
"} else {\n"
"tkMbPost $w\n"
"tkMenuFirstEntry [$w cget -menu]\n"
"}\n"
"}\n"
"}\n"
"proc tkTraverseWithinMenu {w char} {\n"
"if {[string equal $char \"\"]} {\n"
"return\n"
"}\n"
"set char [string tolower $char]\n"
"set last [$w index last]\n"
"if {[string equal $last \"none\"]} {\n"
"return\n"
"}\n"
"for {set i 0} {$i <= $last} {incr i} {\n"
"if {[catch {set char2 [string index \\\n"
"\011\011[$w entrycget $i -label] [$w entrycget $i -underline]]}]} {\n"
"continue\n"
"}\n"
"if {[string equal $char [string tolower $char2]]} {\n"
"if {[string equal [$w type $i] \"cascade\"]} {\n"
"$w activate $i\n"
"$w postcascade active\n"
"event generate $w <<MenuSelect>>\n"
"set m2 [$w entrycget $i -menu]\n"
"if {[string compare $m2 \"\"]} {\n"
"tkMenuFirstEntry $m2\n"
"}\n"
"} else {\n"
"tkMenuUnpost $w\n"
"uplevel #0 [list $w invoke $i]\n"
"}\n"
"return\n"
"}\n"
"}\n"
"}\n"
"proc tkMenuFirstEntry menu {\n"
"if {[string equal $menu \"\"]} {\n"
"return\n"
"}\n"
"tk_menuSetFocus $menu\n"
"if {[string compare [$menu index active] \"none\"]} {\n"
"return\n"
"}\n"
"set last [$menu index last]\n"
"if {[string equal $last \"none\"]} {\n"
"return\n"
"}\n"
"for {set i 0} {$i <= $last} {incr i} {\n"
"if {([catch {set state [$menu entrycget $i -state]}] == 0) \\\n"
"\011\011&& [string compare $state \"disabled\"] \\\n"
"\011\011&& [string compare [$menu type $i] \"tearoff\"]} {\n"
"$menu activate $i\n"
"tkGenerateMenuSelect $menu\n"
"if {[string equal [$menu type $i] \"cascade\"] && \\\n"
"\011\011[string equal [$menu cget -type] \"menubar\"]} {\n"
"set cascade [$menu entrycget $i -menu]\n"
"if {[string compare $cascade \"\"]} {\n"
"$menu postcascade $i\n"
"tkMenuFirstEntry $cascade\n"
"}\n"
"}\n"
"return\n"
"}\n"
"}\n"
"}\n"
"proc tkMenuFindName {menu s} {\n"
"set i \"\"\n"
"if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {\n"
"catch {set i [$menu index $s]}\n"
"return $i\n"
"}\n"
"set last [$menu index last]\n"
"if {[string equal $last \"none\"]} {\n"
"return\n"
"}\n"
"for {set i 0} {$i <= $last} {incr i} {\n"
"if {![catch {$menu entrycget $i -label} label]} {\n"
"if {[string equal $label $s]} {\n"
"return $i\n"
"}\n"
"}\n"
"}\n"
"return \"\"\n"
"}\n"
"proc tkPostOverPoint {menu x y {entry {}}}  {\n"
"global tcl_platform\n"
"if {[string compare $entry {}]} {\n"
"if {$entry == [$menu index last]} {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"\011\011    + [winfo reqheight $menu])/2}]\n"
"} else {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"\011\011    + [$menu yposition [expr {$entry+1}]])/2}]\n"
"}\n"
"incr x [expr {-[winfo reqwidth $menu]/2}]\n"
"}\n"
"$menu post $x $y\n"
"if {[string compare $entry {}] \\\n"
"\011    && [string compare [$menu entrycget $entry -state] \"disabled\"]} {\n"
"$menu activate $entry\n"
"tkGenerateMenuSelect $menu\n"
"}\n"
"}\n"
"proc tkSaveGrabInfo w {\n"
"global tkPriv\n"
"set tkPriv(oldGrab) [grab current $w]\n"
"if {[string compare $tkPriv(oldGrab) \"\"]} {\n"
"set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]\n"
"}\n"
"}\n"
"proc tkRestoreOldGrab {} {\n"
"global tkPriv\n"
"if {[string compare $tkPriv(oldGrab) \"\"]} {\n"
"catch {\n"
"if {[string equal $tkPriv(grabStatus) \"global\"]} {\n"
"grab set -global $tkPriv(oldGrab)\n"
"} else {\n"
"grab set $tkPriv(oldGrab)\n"
"}\n"
"}\n"
"set tkPriv(oldGrab) \"\"\n"
"}\n"
"}\n"
"proc tk_menuSetFocus {menu} {\n"
"global tkPriv\n"
"if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} {\n"
"set tkPriv(focus) [focus]\n"
"}\n"
"focus $menu\n"
"}\n"
"proc tkGenerateMenuSelect {menu} {\n"
"global tkPriv\n"
"if {[string equal $tkPriv(activeMenu) $menu] \\\n"
"          && [string equal $tkPriv(activeItem) [$menu index active]]} {\n"
"return\n"
"}\n"
"set tkPriv(activeMenu) $menu\n"
"set tkPriv(activeItem) [$menu index active]\n"
"event generate $menu <<MenuSelect>>\n"
"}\n"
"proc tk_popup {menu x y {entry {}}} {\n"
"global tkPriv\n"
"global tcl_platform\n"
"if {[string compare $tkPriv(popup) \"\"] \\\n"
"\011    || [string compare $tkPriv(postedMb) \"\"]} {\n"
"tkMenuUnpost {}\n"
"}\n"
"tkPostOverPoint $menu $x $y $entry\n"
"if {[string equal $tcl_platform(platform) \"unix\"] \\\n"
"\011    && [winfo viewable $menu]} {\n"
"tkSaveGrabInfo $menu\n"
"grab -global $menu\n"
"set tkPriv(popup) $menu\n"
"tk_menuSetFocus $menu\n"
"}\n"
"}\n"
;
static char Et_zFile18[] = 
"namespace eval ::tk::dialog {}\n"
"image create bitmap ::tk::dialog::b1 -foreground black \\\n"
"-data \"#define b1_width 32\\n#define b1_height 32\n"
"static unsigned char q1_bits[] = {\n"
"0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,\n"
"0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,\n"
"0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,\n"
"0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,\n"
"0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,\n"
"0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,\n"
"0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,\n"
"0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,\n"
"0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,\n"
"0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
"image create bitmap ::tk::dialog::b2 -foreground white \\\n"
"-data \"#define b2_width 32\\n#define b2_height 32\n"
"static unsigned char b2_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,\n"
"0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,\n"
"0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,\n"
"0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,\n"
"0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,\n"
"0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,\n"
"0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,\n"
"0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,\n"
"0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,\n"
"0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
"image create bitmap ::tk::dialog::q -foreground blue \\\n"
"-data \"#define q_width 32\\n#define q_height 32\n"
"static unsigned char q_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,\n"
"0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,\n"
"0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,\n"
"0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,\n"
"0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
"image create bitmap ::tk::dialog::i -foreground blue \\\n"
"-data \"#define i_width 32\\n#define i_height 32\n"
"static unsigned char i_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,\n"
"0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,\n"
"0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,\n"
"0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,\n"
"0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
"image create bitmap ::tk::dialog::w1 -foreground black \\\n"
"-data \"#define w1_width 32\\n#define w1_height 32\n"
"static unsigned char w1_bits[] = {\n"
"0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,\n"
"0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,\n"
"0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,\n"
"0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,\n"
"0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,\n"
"0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,\n"
"0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,\n"
"0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,\n"
"0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,\n"
"0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,\n"
"0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};\"\n"
"image create bitmap ::tk::dialog::w2 -foreground yellow \\\n"
"-data \"#define w2_width 32\\n#define w2_height 32\n"
"static unsigned char w2_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,\n"
"0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,\n"
"0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,\n"
"0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,\n"
"0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,\n"
"0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,\n"
"0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,\n"
"0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,\n"
"0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,\n"
"0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
"image create bitmap ::tk::dialog::w3 -foreground black \\\n"
"-data \"#define w3_width 32\\n#define w3_height 32\n"
"static unsigned char w3_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,\n"
"0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,\n"
"0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,\n"
"0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,\n"
"0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
"0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
"proc tkMessageBox {args} {\n"
"global tkPriv tcl_platform tk_strictMotif\n"
"set w tkPrivMsgBox\n"
"upvar #0 $w data\n"
"set specs {\n"
"{-default \"\" \"\" \"\"}\n"
"{-icon \"\" \"\" \"info\"}\n"
"{-message \"\" \"\" \"\"}\n"
"{-parent \"\" \"\" .}\n"
"{-title \"\" \"\" \" \"}\n"
"{-type \"\" \"\" \"ok\"}\n"
"}\n"
"tclParseConfigSpec $w $specs \"\" $args\n"
"if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {\n"
"error \"bad -icon value \\\"$data(-icon)\\\": must be error, info, question, or warning\"\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"switch -- $data(-icon) {\n"
"\"error\"     {set data(-icon) \"stop\"}\n"
"\"warning\"   {set data(-icon) \"caution\"}\n"
"\"info\"      {set data(-icon) \"note\"}\n"
"}\n"
"}\n"
"if {![winfo exists $data(-parent)]} {\n"
"error \"bad window path name \\\"$data(-parent)\\\"\"\n"
"}\n"
"switch -- $data(-type) {\n"
"abortretryignore {\n"
"set buttons {\n"
"{abort  -width 6 -text Abort -under 0}\n"
"{retry  -width 6 -text Retry -under 0}\n"
"{ignore -width 6 -text Ignore -under 0}\n"
"}\n"
"}\n"
"ok {\n"
"set buttons {\n"
"{ok -width 6 -text OK -under 0}\n"
"}\n"
"if {[string equal $data(-default) \"\"]} {\n"
"set data(-default) \"ok\"\n"
"}\n"
"}\n"
"okcancel {\n"
"set buttons {\n"
"{ok     -width 6 -text OK     -under 0}\n"
"{cancel -width 6 -text Cancel -under 0}\n"
"}\n"
"}\n"
"retrycancel {\n"
"set buttons {\n"
"{retry  -width 6 -text Retry  -under 0}\n"
"{cancel -width 6 -text Cancel -under 0}\n"
"}\n"
"}\n"
"yesno {\n"
"set buttons {\n"
"{yes    -width 6 -text Yes -under 0}\n"
"{no     -width 6 -text No  -under 0}\n"
"}\n"
"}\n"
"yesnocancel {\n"
"set buttons {\n"
"{yes    -width 6 -text Yes -under 0}\n"
"{no     -width 6 -text No  -under 0}\n"
"{cancel -width 6 -text Cancel -under 0}\n"
"}\n"
"}\n"
"default {\n"
"error \"bad -type value \\\"$data(-type)\\\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel\"\n"
"}\n"
"}\n"
"if {[string compare $data(-default) \"\"]} {\n"
"set valid 0\n"
"foreach btn $buttons {\n"
"if {[string equal [lindex $btn 0] $data(-default)]} {\n"
"set valid 1\n"
"break\n"
"}\n"
"}\n"
"if {!$valid} {\n"
"error \"invalid default button \\\"$data(-default)\\\"\"\n"
"}\n"
"}\n"
"if {[string compare $data(-parent) .]} {\n"
"set w $data(-parent).__tk__messagebox\n"
"} else {\n"
"set w .__tk__messagebox\n"
"}\n"
"catch {destroy $w}\n"
"toplevel $w -class Dialog\n"
"wm title $w $data(-title)\n"
"wm iconname $w Dialog\n"
"wm protocol $w WM_DELETE_WINDOW { }\n"
"if { [winfo viewable [winfo toplevel $data(-parent)]] } {\n"
"wm transient $w $data(-parent)\n"
"}    \n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"unsupported1 style $w dBoxProc\n"
"}\n"
"frame $w.bot\n"
"pack $w.bot -side bottom -fill both\n"
"frame $w.top\n"
"pack $w.top -side top -fill both -expand 1\n"
"if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"$w.bot configure -relief raised -bd 1\n"
"$w.top configure -relief raised -bd 1\n"
"}\n"
"option add *Dialog.msg.wrapLength 3i widgetDefault\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"option add *Dialog.msg.font system widgetDefault\n"
"} else {\n"
"option add *Dialog.msg.font {Times 18} widgetDefault\n"
"}\n"
"label $w.msg -anchor nw -justify left -text $data(-message)\n"
"if {[string compare $data(-icon) \"\"]} {\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"] \\\n"
"\011\011|| ([winfo depth $w] < 4) || $tk_strictMotif} {\n"
"label $w.bitmap -bitmap $data(-icon)\n"
"} else {\n"
"canvas $w.bitmap -width 32 -height 32 -highlightthickness 0\n"
"switch $data(-icon) {\n"
"error {\n"
"$w.bitmap create oval 0 0 31 31 -fill red -outline black\n"
"$w.bitmap create line 9 9 23 23 -fill white -width 4\n"
"$w.bitmap create line 9 23 23 9 -fill white -width 4\n"
"}\n"
"info {\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::b1\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::b2\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::i\n"
"}\n"
"question {\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::b1\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::b2\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::q\n"
"}\n"
"default {\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::w1\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::w2\n"
"$w.bitmap create image 0 0 -anchor nw \\\n"
"\011\011\011    -image ::tk::dialog::w3\n"
"}\n"
"}\n"
"}\n"
"}\n"
"grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m\n"
"grid columnconfigure $w.top 1 -weight 1\n"
"grid rowconfigure $w.top 0 -weight 1\n"
"set i 0\n"
"foreach but $buttons {\n"
"set name [lindex $but 0]\n"
"set opts [lrange $but 1 end]\n"
"if {![llength $opts]} {\n"
"set capName [string toupper $name 0]\n"
"set opts [list -text $capName]\n"
"}\n"
"eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]\n"
"if {[string equal $name $data(-default)]} {\n"
"$w.$name configure -default active\n"
"}\n"
"pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m\n"
"set underIdx [$w.$name cget -under]\n"
"if {$underIdx >= 0} {\n"
"set key [string index [$w.$name cget -text] $underIdx]\n"
"bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]\n"
"bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]\n"
"}\n"
"incr i\n"
"}\n"
"if {[string compare {} $data(-default)]} {\n"
"bind $w <FocusIn> {\n"
"if {[string equal Button [winfo class %W]]} {\n"
"%W configure -default active\n"
"}\n"
"}\n"
"bind $w <FocusOut> {\n"
"if {[string equal Button [winfo class %W]]} {\n"
"%W configure -default normal\n"
"}\n"
"}\n"
"}\n"
"bind $w <Return> {\n"
"if {[string equal Button [winfo class %W]]} {\n"
"tkButtonInvoke %W\n"
"}\n"
"}\n"
"::tk::PlaceWindow $w widget $data(-parent)\n"
"if {[string compare $data(-default) \"\"]} {\n"
"set focus $w.$data(-default)\n"
"} else {\n"
"set focus $w\n"
"}\n"
"::tk::SetFocusGrab $w $focus\n"
"tkwait variable tkPriv(button)\n"
"::tk::RestoreFocusGrab $w $focus\n"
"return $tkPriv(button)\n"
"}\n"
;
static char Et_zFile19[] = 
"proc tk_menuBar args {}\n"
"proc tk_bindForTraversal args {}\n"
;
static char Et_zFile20[] = 
"proc tk_optionMenu {w varName firstValue args} {\n"
"upvar #0 $varName var\n"
"if {![info exists var]} {\n"
"set var $firstValue\n"
"}\n"
"menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \\\n"
"\011    -relief raised -bd 2 -highlightthickness 2 -anchor c \\\n"
"\011    -direction flush\n"
"menu $w.menu -tearoff 0\n"
"$w.menu add radiobutton -label $firstValue -variable $varName\n"
"foreach i $args {\n"
"$w.menu add radiobutton -label $i -variable $varName\n"
"}\n"
"return $w.menu\n"
"}\n"
;
static char Et_zFile21[] = 
"proc tk_setPalette {args} {\n"
"if {[winfo depth .] == 1} {\n"
"return\n"
"}\n"
"global tkPalette\n"
"if {[llength $args] == 1} {\n"
"set new(background) [lindex $args 0]\n"
"} else {\n"
"array set new $args\n"
"}\n"
"if {![info exists new(background)]} {\n"
"error \"must specify a background color\"\n"
"}\n"
"if {![info exists new(foreground)]} {\n"
"set new(foreground) black\n"
"}\n"
"set bg [winfo rgb . $new(background)]\n"
"set fg [winfo rgb . $new(foreground)]\n"
"set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \\\n"
"\011    [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]]\n"
"foreach i {activeForeground insertBackground selectForeground \\\n"
"\011    highlightColor} {\n"
"if {![info exists new($i)]} {\n"
"set new($i) $new(foreground)\n"
"}\n"
"}\n"
"if {![info exists new(disabledForeground)]} {\n"
"set new(disabledForeground) [format #%02x%02x%02x \\\n"
"\011\011[expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \\\n"
"\011\011[expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \\\n"
"\011\011[expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]]\n"
"}\n"
"if {![info exists new(highlightBackground)]} {\n"
"set new(highlightBackground) $new(background)\n"
"}\n"
"if {![info exists new(activeBackground)]} {\n"
"foreach i {0 1 2} {\n"
"set light($i) [expr {[lindex $bg $i]/256}]\n"
"set inc1 [expr {($light($i)*15)/100}]\n"
"set inc2 [expr {(255-$light($i))/3}]\n"
"if {$inc1 > $inc2} {\n"
"incr light($i) $inc1\n"
"} else {\n"
"incr light($i) $inc2\n"
"}\n"
"if {$light($i) > 255} {\n"
"set light($i) 255\n"
"}\n"
"}\n"
"set new(activeBackground) [format #%02x%02x%02x $light(0) \\\n"
"\011\011$light(1) $light(2)]\n"
"}\n"
"if {![info exists new(selectBackground)]} {\n"
"set new(selectBackground) $darkerBg\n"
"}\n"
"if {![info exists new(troughColor)]} {\n"
"set new(troughColor) $darkerBg\n"
"}\n"
"if {![info exists new(selectColor)]} {\n"
"set new(selectColor) #b03060\n"
"}\n"
"toplevel .___tk_set_palette\n"
"wm withdraw .___tk_set_palette\n"
"foreach q {button canvas checkbutton entry frame label listbox \\\n"
"\011    menubutton menu message radiobutton scale scrollbar text} {\n"
"$q .___tk_set_palette.$q\n"
"}\n"
"eval [tkRecolorTree . new]\n"
"catch {destroy .___tk_set_palette}\n"
"foreach option [array names new] {\n"
"option add *$option $new($option) widgetDefault\n"
"}\n"
"array set tkPalette [array get new]\n"
"}\n"
"proc tkRecolorTree {w colors} {\n"
"global tkPalette\n"
"upvar $colors c\n"
"set result {}\n"
"foreach dbOption [array names c] {\n"
"set option -[string tolower $dbOption]\n"
"if {![catch {$w config $option} value]} {\n"
"set defaultcolor [option get $w $dbOption widgetDefault]\n"
"if {[string match {} $defaultcolor]} {\n"
"set defaultcolor [winfo rgb . [lindex $value 3]]\n"
"} else {\n"
"set defaultcolor [winfo rgb . $defaultcolor]\n"
"}\n"
"set chosencolor [winfo rgb . [lindex $value 4]]\n"
"if {[string match $defaultcolor $chosencolor]} {\n"
"append result \";\\noption add [list \\\n"
"\011\011    *[winfo class $w].$dbOption $c($dbOption) 60]\"\n"
"$w configure $option $c($dbOption)\n"
"}\n"
"}\n"
"}\n"
"foreach child [winfo children $w] {\n"
"append result \";\\n[tkRecolorTree $child c]\"\n"
"}\n"
"return $result\n"
"}\n"
"proc tkDarken {color percent} {\n"
"foreach {red green blue} [winfo rgb . $color] {\n"
"set red [expr {($red/256)*$percent/100}]\n"
"set green [expr {($green/256)*$percent/100}]\n"
"set blue [expr {($blue/256)*$percent/100}]\n"
"break\n"
"}\n"
"if {$red > 255} {\n"
"set red 255\n"
"}\n"
"if {$green > 255} {\n"
"set green 255\n"
"}\n"
"if {$blue > 255} {\n"
"set blue 255\n"
"}\n"
"return [format \"#%02x%02x%02x\" $red $green $blue]\n"
"}\n"
"proc tk_bisque {} {\n"
"tk_setPalette activeBackground #e6ceb1 activeForeground black \\\n"
"\011    background #ffe4c4 disabledForeground #b0b0b0 foreground black \\\n"
"\011    highlightBackground #ffe4c4 highlightColor black \\\n"
"\011    insertBackground black selectColor #b03060 \\\n"
"\011    selectBackground #e6ceb1 selectForeground black \\\n"
"\011    troughColor #cdb79e\n"
"}\n"
;
static char Et_zFile22[] = 
"package require opt 0.4.1;\n"
"namespace eval ::safe {\n"
"variable tkSafeId 0;\n"
"proc ::safe::tkInterpInit {slave argv} {\n"
"global env tk_library\n"
"allowTk $slave $argv\n"
"::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]\n"
"return $slave\n"
"}\n"
"proc ::safe::loadTk {} {}\n"
"::tcl::OptProc loadTk {\n"
"{slave -interp \"name of the slave interpreter\"}\n"
"{-use  -windowId {} \"window Id to use (new toplevel otherwise)\"}\n"
"{-display -displayName {} \"display name to use (current one otherwise)\"}\n"
"} {\n"
"set displayGiven [::tcl::OptProcArgGiven \"-display\"]\n"
"if {!$displayGiven} {\n"
"if {[catch {set display [winfo screen .]}]} {\n"
"if {[info exists ::env(DISPLAY)]} {\n"
"set display $::env(DISPLAY)\n"
"} else {\n"
"Log $slave \"no winfo screen . nor env(DISPLAY)\" WARNING\n"
"set display \":0.0\"\n"
"}\n"
"}\n"
"}\n"
"if {![::tcl::OptProcArgGiven \"-use\"]} {\n"
"::tcl::Lassign [tkTopLevel $slave $display] w use\n"
"Set [DeleteHookName $slave] [list tkDelete {} $w]\n"
"} else {\n"
"Set [DeleteHookName $slave] [list disallowTk]\n"
"if {[string match \".*\" $use]} {\n"
"set windowName $use\n"
"set use [winfo id $windowName]\n"
"set nDisplay [winfo screen $windowName]\n"
"} else {\n"
"if {![catch {winfo pathname $use} name]} {\n"
"set nDisplay [winfo screen $name]\n"
"} else {\n"
"set nDisplay $display\n"
"}\n"
"}\n"
"if {[string compare $nDisplay $display]} {\n"
"if {$displayGiven} {\n"
"error \"conflicting -display $display and -use\\\n"
"\011\011\011$use -> $nDisplay\"\n"
"} else {\n"
"set display $nDisplay\n"
"}\n"
"}\n"
"}\n"
"tkInterpInit $slave [list \"-use\" $use \"-display\" $display]\n"
"load {} Tk $slave\n"
"return $slave\n"
"}\n"
"proc ::safe::TkInit {interpPath} {\n"
"variable tkInit\n"
"if {[info exists tkInit($interpPath)]} {\n"
"set value $tkInit($interpPath)\n"
"Log $interpPath \"TkInit called, returning \\\"$value\\\"\" NOTICE\n"
"return $value\n"
"} else {\n"
"Log $interpPath \"TkInit called for interp with clearance:\\\n"
"\011\011preventing Tk init\" ERROR\n"
"error \"not allowed\"\n"
"}\n"
"}\n"
"proc ::safe::allowTk {interpPath argv} {\n"
"variable tkInit\n"
"set tkInit($interpPath) $argv\n"
"return\n"
"}\n"
"proc ::safe::disallowTk {interpPath} {\n"
"variable tkInit\n"
"if {[info exists tkInit($interpPath)]} {\n"
"unset tkInit($interpPath)\n"
"}\n"
"return\n"
"}\n"
"proc ::safe::tkDelete {W window slave} {\n"
"Log $slave \"Called tkDelete $W $window\" NOTICE\n"
"if {[::interp exists $slave]} {\n"
"if {[catch {::safe::interpDelete $slave} msg]} {\n"
"Log $slave \"Deletion error : $msg\"\n"
"}\n"
"}\n"
"if {[winfo exists $window]} {\n"
"Log $slave \"Destroy toplevel $window\" NOTICE\n"
"destroy $window\n"
"}\n"
"disallowTk $slave\n"
"return\n"
"}\n"
"proc ::safe::tkTopLevel {slave display} {\n"
"variable tkSafeId\n"
"incr tkSafeId\n"
"set w \".safe$tkSafeId\"\n"
"if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {\n"
"return -code error \"Unable to create toplevel for\\\n"
"\011\011safe slave \\\"$slave\\\" ($msg)\"\n"
"}\n"
"Log $slave \"New toplevel $w\" NOTICE\n"
"set msg \"Untrusted Tcl applet ($slave)\"\n"
"wm title $w $msg\n"
"set wc $w.fc\n"
"frame $wc -bg red -borderwidth 3 -relief ridge\n"
"bindtags $wc [concat Safe$wc [bindtags $wc]]\n"
"bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]\n"
"label $wc.l -text $msg -padx 2 -pady 0 -anchor w\n"
"frame  $wc.fb -bd 0\n"
"button $wc.fb.b -text \"Delete\" \\\n"
"\011    -bd 1  -padx 2 -pady 0 -highlightthickness 0 \\\n"
"\011    -command [list ::safe::tkDelete $w $w $slave]\n"
"pack $wc.fb.b -side right -fill both\n"
"pack $wc.fb -side right -fill both -expand 1\n"
"pack $wc.l -side left  -fill both -expand 1\n"
"pack $wc -side bottom -fill x\n"
"frame $w.c -container 1\n"
"pack $w.c -fill both -expand 1\n"
"list $w [winfo id $w.c]\n"
"}\n"
"}\n"
;
static char Et_zFile23[] = 
"bind Scale <Enter> {\n"
"if {$tk_strictMotif} {\n"
"set tkPriv(activeBg) [%W cget -activebackground]\n"
"%W config -activebackground [%W cget -background]\n"
"}\n"
"tkScaleActivate %W %x %y\n"
"}\n"
"bind Scale <Motion> {\n"
"tkScaleActivate %W %x %y\n"
"}\n"
"bind Scale <Leave> {\n"
"if {$tk_strictMotif} {\n"
"%W config -activebackground $tkPriv(activeBg)\n"
"}\n"
"if {[string equal [%W cget -state] \"active\"]} {\n"
"%W configure -state normal\n"
"}\n"
"}\n"
"bind Scale <1> {\n"
"tkScaleButtonDown %W %x %y\n"
"}\n"
"bind Scale <B1-Motion> {\n"
"tkScaleDrag %W %x %y\n"
"}\n"
"bind Scale <B1-Leave> { }\n"
"bind Scale <B1-Enter> { }\n"
"bind Scale <ButtonRelease-1> {\n"
"tkCancelRepeat\n"
"tkScaleEndDrag %W\n"
"tkScaleActivate %W %x %y\n"
"}\n"
"bind Scale <2> {\n"
"tkScaleButton2Down %W %x %y\n"
"}\n"
"bind Scale <B2-Motion> {\n"
"tkScaleDrag %W %x %y\n"
"}\n"
"bind Scale <B2-Leave> { }\n"
"bind Scale <B2-Enter> { }\n"
"bind Scale <ButtonRelease-2> {\n"
"tkCancelRepeat\n"
"tkScaleEndDrag %W\n"
"tkScaleActivate %W %x %y\n"
"}\n"
"bind Scale <Control-1> {\n"
"tkScaleControlPress %W %x %y\n"
"}\n"
"bind Scale <Up> {\n"
"tkScaleIncrement %W up little noRepeat\n"
"}\n"
"bind Scale <Down> {\n"
"tkScaleIncrement %W down little noRepeat\n"
"}\n"
"bind Scale <Left> {\n"
"tkScaleIncrement %W up little noRepeat\n"
"}\n"
"bind Scale <Right> {\n"
"tkScaleIncrement %W down little noRepeat\n"
"}\n"
"bind Scale <Control-Up> {\n"
"tkScaleIncrement %W up big noRepeat\n"
"}\n"
"bind Scale <Control-Down> {\n"
"tkScaleIncrement %W down big noRepeat\n"
"}\n"
"bind Scale <Control-Left> {\n"
"tkScaleIncrement %W up big noRepeat\n"
"}\n"
"bind Scale <Control-Right> {\n"
"tkScaleIncrement %W down big noRepeat\n"
"}\n"
"bind Scale <Home> {\n"
"%W set [%W cget -from]\n"
"}\n"
"bind Scale <End> {\n"
"%W set [%W cget -to]\n"
"}\n"
"proc tkScaleActivate {w x y} {\n"
"if {[string equal [$w cget -state] \"disabled\"]} {\n"
"return\n"
"}\n"
"if {[string equal [$w identify $x $y] \"slider\"]} {\n"
"set state active\n"
"} else {\n"
"set state normal\n"
"}\n"
"if {[string compare [$w cget -state] $state]} {\n"
"$w configure -state $state\n"
"}\n"
"}\n"
"proc tkScaleButtonDown {w x y} {\n"
"global tkPriv\n"
"set tkPriv(dragging) 0\n"
"set el [$w identify $x $y]\n"
"if {[string equal $el \"trough1\"]} {\n"
"tkScaleIncrement $w up little initial\n"
"} elseif {[string equal $el \"trough2\"]} {\n"
"tkScaleIncrement $w down little initial\n"
"} elseif {[string equal $el \"slider\"]} {\n"
"set tkPriv(dragging) 1\n"
"set tkPriv(initValue) [$w get]\n"
"set coords [$w coords]\n"
"set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]\n"
"set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]\n"
"$w configure -sliderrelief sunken\n"
"}\n"
"}\n"
"proc tkScaleDrag {w x y} {\n"
"global tkPriv\n"
"if {!$tkPriv(dragging)} {\n"
"return\n"
"}\n"
"$w set [$w get [expr {$x-$tkPriv(deltaX)}] [expr {$y-$tkPriv(deltaY)}]]\n"
"}\n"
"proc tkScaleEndDrag {w} {\n"
"global tkPriv\n"
"set tkPriv(dragging) 0\n"
"$w configure -sliderrelief raised\n"
"}\n"
"proc tkScaleIncrement {w dir big repeat} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"if {[string equal $big \"big\"]} {\n"
"set inc [$w cget -bigincrement]\n"
"if {$inc == 0} {\n"
"set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]\n"
"}\n"
"if {$inc < [$w cget -resolution]} {\n"
"set inc [$w cget -resolution]\n"
"}\n"
"} else {\n"
"set inc [$w cget -resolution]\n"
"}\n"
"if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir \"up\"]} {\n"
"set inc [expr {-$inc}]\n"
"}\n"
"$w set [expr {[$w get] + $inc}]\n"
"if {[string equal $repeat \"again\"]} {\n"
"set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n"
"\011\011[list tkScaleIncrement $w $dir $big again]]\n"
"} elseif {[string equal $repeat \"initial\"]} {\n"
"set delay [$w cget -repeatdelay]\n"
"if {$delay > 0} {\n"
"set tkPriv(afterId) [after $delay \\\n"
"\011\011    [list tkScaleIncrement $w $dir $big again]]\n"
"}\n"
"}\n"
"}\n"
"proc tkScaleControlPress {w x y} {\n"
"set el [$w identify $x $y]\n"
"if {[string equal $el \"trough1\"]} {\n"
"$w set [$w cget -from]\n"
"} elseif {[string equal $el \"trough2\"]} {\n"
"$w set [$w cget -to]\n"
"}\n"
"}\n"
"proc tkScaleButton2Down {w x y} {\n"
"global tkPriv\n"
"if {[string equal [$w cget -state] \"disabled\"]} {\n"
"return\n"
"}\n"
"$w configure -state active\n"
"$w set [$w get $x $y]\n"
"set tkPriv(dragging) 1\n"
"set tkPriv(initValue) [$w get]\n"
"set coords \"$x $y\"\n"
"set tkPriv(deltaX) 0\n"
"set tkPriv(deltaY) 0\n"
"}\n"
;
static char Et_zFile24[] = 
"if {[string compare $tcl_platform(platform) \"windows\"] && \\\n"
"\011[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Scrollbar <Enter> {\n"
"if {$tk_strictMotif} {\n"
"set tkPriv(activeBg) [%W cget -activebackground]\n"
"%W config -activebackground [%W cget -background]\n"
"}\n"
"%W activate [%W identify %x %y]\n"
"}\n"
"bind Scrollbar <Motion> {\n"
"%W activate [%W identify %x %y]\n"
"}\n"
"bind Scrollbar <Leave> {\n"
"if {$tk_strictMotif && [info exists tkPriv(activeBg)]} {\n"
"%W config -activebackground $tkPriv(activeBg)\n"
"}\n"
"%W activate {}\n"
"}\n"
"bind Scrollbar <1> {\n"
"tkScrollButtonDown %W %x %y\n"
"}\n"
"bind Scrollbar <B1-Motion> {\n"
"tkScrollDrag %W %x %y\n"
"}\n"
"bind Scrollbar <B1-B2-Motion> {\n"
"tkScrollDrag %W %x %y\n"
"}\n"
"bind Scrollbar <ButtonRelease-1> {\n"
"tkScrollButtonUp %W %x %y\n"
"}\n"
"bind Scrollbar <B1-Leave> {\n"
"}\n"
"bind Scrollbar <B1-Enter> {\n"
"}\n"
"bind Scrollbar <2> {\n"
"tkScrollButton2Down %W %x %y\n"
"}\n"
"bind Scrollbar <B1-2> {\n"
"}\n"
"bind Scrollbar <B2-1> {\n"
"}\n"
"bind Scrollbar <B2-Motion> {\n"
"tkScrollDrag %W %x %y\n"
"}\n"
"bind Scrollbar <ButtonRelease-2> {\n"
"tkScrollButtonUp %W %x %y\n"
"}\n"
"bind Scrollbar <B1-ButtonRelease-2> {\n"
"}\n"
"bind Scrollbar <B2-ButtonRelease-1> {\n"
"}\n"
"bind Scrollbar <B2-Leave> {\n"
"}\n"
"bind Scrollbar <B2-Enter> {\n"
"}\n"
"bind Scrollbar <Control-1> {\n"
"tkScrollTopBottom %W %x %y\n"
"}\n"
"bind Scrollbar <Control-2> {\n"
"tkScrollTopBottom %W %x %y\n"
"}\n"
"bind Scrollbar <Up> {\n"
"tkScrollByUnits %W v -1\n"
"}\n"
"bind Scrollbar <Down> {\n"
"tkScrollByUnits %W v 1\n"
"}\n"
"bind Scrollbar <Control-Up> {\n"
"tkScrollByPages %W v -1\n"
"}\n"
"bind Scrollbar <Control-Down> {\n"
"tkScrollByPages %W v 1\n"
"}\n"
"bind Scrollbar <Left> {\n"
"tkScrollByUnits %W h -1\n"
"}\n"
"bind Scrollbar <Right> {\n"
"tkScrollByUnits %W h 1\n"
"}\n"
"bind Scrollbar <Control-Left> {\n"
"tkScrollByPages %W h -1\n"
"}\n"
"bind Scrollbar <Control-Right> {\n"
"tkScrollByPages %W h 1\n"
"}\n"
"bind Scrollbar <Prior> {\n"
"tkScrollByPages %W hv -1\n"
"}\n"
"bind Scrollbar <Next> {\n"
"tkScrollByPages %W hv 1\n"
"}\n"
"bind Scrollbar <Home> {\n"
"tkScrollToPos %W 0\n"
"}\n"
"bind Scrollbar <End> {\n"
"tkScrollToPos %W 1\n"
"}\n"
"}\n"
"proc tkScrollButtonDown {w x y} {\n"
"global tkPriv\n"
"set tkPriv(relief) [$w cget -activerelief]\n"
"$w configure -activerelief sunken\n"
"set element [$w identify $x $y]\n"
"if {[string equal $element \"slider\"]} {\n"
"tkScrollStartDrag $w $x $y\n"
"} else {\n"
"tkScrollSelect $w $element initial\n"
"}\n"
"}\n"
"proc tkScrollButtonUp {w x y} {\n"
"global tkPriv\n"
"tkCancelRepeat\n"
"if {[info exists tkPriv(relief)]} {\n"
"$w configure -activerelief $tkPriv(relief)\n"
"tkScrollEndDrag $w $x $y\n"
"$w activate [$w identify $x $y]\n"
"}\n"
"}\n"
"proc tkScrollSelect {w element repeat} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"switch -- $element {\n"
"\"arrow1\"\011{tkScrollByUnits $w hv -1}\n"
"\"trough1\"\011{tkScrollByPages $w hv -1}\n"
"\"trough2\"\011{tkScrollByPages $w hv 1}\n"
"\"arrow2\"\011{tkScrollByUnits $w hv 1}\n"
"default\011\011{return}\n"
"}\n"
"if {[string equal $repeat \"again\"]} {\n"
"set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n"
"\011\011[list tkScrollSelect $w $element again]]\n"
"} elseif {[string equal $repeat \"initial\"]} {\n"
"set delay [$w cget -repeatdelay]\n"
"if {$delay > 0} {\n"
"set tkPriv(afterId) [after $delay \\\n"
"\011\011    [list tkScrollSelect $w $element again]]\n"
"}\n"
"}\n"
"}\n"
"proc tkScrollStartDrag {w x y} {\n"
"global tkPriv\n"
"if {[string equal [$w cget -command] \"\"]} {\n"
"return\n"
"}\n"
"set tkPriv(pressX) $x\n"
"set tkPriv(pressY) $y\n"
"set tkPriv(initValues) [$w get]\n"
"set iv0 [lindex $tkPriv(initValues) 0]\n"
"if {[llength $tkPriv(initValues)] == 2} {\n"
"set tkPriv(initPos) $iv0\n"
"} elseif {$iv0 == 0} {\n"
"set tkPriv(initPos) 0.0\n"
"} else {\n"
"set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \\\n"
"\011\011/ [lindex $tkPriv(initValues) 0]}]\n"
"}\n"
"}\n"
"proc tkScrollDrag {w x y} {\n"
"global tkPriv\n"
"if {[string equal $tkPriv(initPos) \"\"]} {\n"
"return\n"
"}\n"
"set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]\n"
"if {[$w cget -jump]} {\n"
"if {[llength $tkPriv(initValues)] == 2} {\n"
"$w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \\\n"
"\011\011    [expr {[lindex $tkPriv(initValues) 1] + $delta}]\n"
"} else {\n"
"set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]\n"
"eval [list $w] set [lreplace $tkPriv(initValues) 2 3 \\\n"
"\011\011    [expr {[lindex $tkPriv(initValues) 2] + $delta}] \\\n"
"\011\011    [expr {[lindex $tkPriv(initValues) 3] + $delta}]]\n"
"}\n"
"} else {\n"
"tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]\n"
"}\n"
"}\n"
"proc tkScrollEndDrag {w x y} {\n"
"global tkPriv\n"
"if {[string equal $tkPriv(initPos) \"\"]} {\n"
"return\n"
"}\n"
"if {[$w cget -jump]} {\n"
"set delta [$w delta [expr {$x - $tkPriv(pressX)}] \\\n"
"\011\011[expr {$y - $tkPriv(pressY)}]]\n"
"tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]\n"
"}\n"
"set tkPriv(initPos) \"\"\n"
"}\n"
"proc tkScrollByUnits {w orient amount} {\n"
"set cmd [$w cget -command]\n"
"if {[string equal $cmd \"\"] || ([string first \\\n"
"\011    [string index [$w cget -orient] 0] $orient] < 0)} {\n"
"return\n"
"}\n"
"set info [$w get]\n"
"if {[llength $info] == 2} {\n"
"uplevel #0 $cmd scroll $amount units\n"
"} else {\n"
"uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]\n"
"}\n"
"}\n"
"proc tkScrollByPages {w orient amount} {\n"
"set cmd [$w cget -command]\n"
"if {[string equal $cmd \"\"] || ([string first \\\n"
"\011    [string index [$w cget -orient] 0] $orient] < 0)} {\n"
"return\n"
"}\n"
"set info [$w get]\n"
"if {[llength $info] == 2} {\n"
"uplevel #0 $cmd scroll $amount pages\n"
"} else {\n"
"uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]\n"
"}\n"
"}\n"
"proc tkScrollToPos {w pos} {\n"
"set cmd [$w cget -command]\n"
"if {[string equal $cmd \"\"]} {\n"
"return\n"
"}\n"
"set info [$w get]\n"
"if {[llength $info] == 2} {\n"
"uplevel #0 $cmd moveto $pos\n"
"} else {\n"
"uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]\n"
"}\n"
"}\n"
"proc tkScrollTopBottom {w x y} {\n"
"global tkPriv\n"
"set element [$w identify $x $y]\n"
"if {[string match *1 $element]} {\n"
"tkScrollToPos $w 0\n"
"} elseif {[string match *2 $element]} {\n"
"tkScrollToPos $w 1\n"
"}\n"
"set tkPriv(relief) [$w cget -activerelief]\n"
"}\n"
"proc tkScrollButton2Down {w x y} {\n"
"global tkPriv\n"
"set element [$w identify $x $y]\n"
"if {[string match {arrow[12]} $element]} {\n"
"tkScrollButtonDown $w $x $y\n"
"return\n"
"}\n"
"tkScrollToPos $w [$w fraction $x $y]\n"
"set tkPriv(relief) [$w cget -activerelief]\n"
"update idletasks\n"
"$w configure -activerelief sunken\n"
"$w activate slider\n"
"tkScrollStartDrag $w $x $y\n"
"}\n"
;
static char Et_zFile25[] = 
"# Tcl autoload index file, version 2.0\n"
"# This file is generated by the \"auto_mkindex\" command\n"
"# and sourced to set up indexing information for one or\n"
"# more commands.  Typically each line is a command that\n"
"# sets an element in the auto_index array, where the\n"
"# element name is the name of a command and the value is\n"
"# a script that loads the command.\n"
"\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]\n"
"set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]\n"
"set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tk_popup) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textCut) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]\n"
"set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]\n"
"set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]\n"
"set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]\n"
"set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]\n"
"set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]\n"
"set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]\n"
"set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]\n"
"set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkDarken) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]\n"
"set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::tkFDialog) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::Update) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::SetPathSilently) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::SetPath) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::SetFilter) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::EntFocusIn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::EntFocusOut) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::ActivateEnt) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::InvokeBtn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::UpDirCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::JoinFile) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::OkCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::CancelCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::ListBrowse) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::ListInvoke) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::Done) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(::tk::dialog::file::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]]\n"
;
static char Et_zFile26[] = 
"proc tkTearOffMenu {w {x 0} {y 0}} {\n"
"if {$x == 0} {\n"
"set x [winfo rootx $w]\n"
"}\n"
"if {$y == 0} {\n"
"set y [winfo rooty $w]\n"
"}\n"
"set parent [winfo parent $w]\n"
"while {[string compare [winfo toplevel $parent] $parent] \\\n"
"\011    || [string equal [winfo class $parent] \"Menu\"]} {\n"
"set parent [winfo parent $parent]\n"
"}\n"
"if {[string equal $parent \".\"]} {\n"
"set parent \"\"\n"
"}\n"
"for {set i 1} 1 {incr i} {\n"
"set menu $parent.tearoff$i\n"
"if {![winfo exists $menu]} {\n"
"break\n"
"}\n"
"}\n"
"$w clone $menu tearoff\n"
"set parent [winfo parent $w]\n"
"if {[string compare [$menu cget -title] \"\"]} {\n"
"wm title $menu [$menu cget -title]\n"
"} else {\n"
"switch [winfo class $parent] {\n"
"Menubutton {\n"
"wm title $menu [$parent cget -text]\n"
"}\n"
"Menu {\n"
"wm title $menu [$parent entrycget active -label]\n"
"}\n"
"}\n"
"}\n"
"$menu post $x $y\n"
"if {[winfo exists $menu] == 0} {\n"
"return \"\"\n"
"}\n"
"bind $menu <Enter> {\n"
"set tkPriv(focus) %W\n"
"}\n"
"set cmd [$w cget -tearoffcommand]\n"
"if {[string compare $cmd \"\"]} {\n"
"uplevel #0 $cmd [list $w $menu]\n"
"}\n"
"return $menu\n"
"}\n"
"proc tkMenuDup {src dst type} {\n"
"set cmd [list menu $dst -type $type]\n"
"foreach option [$src configure] {\n"
"if {[llength $option] == 2} {\n"
"continue\n"
"}\n"
"if {[string equal [lindex $option 0] \"-type\"]} {\n"
"continue\n"
"}\n"
"lappend cmd [lindex $option 0] [lindex $option 4]\n"
"}\n"
"eval $cmd\n"
"set last [$src index last]\n"
"if {[string equal $last \"none\"]} {\n"
"return\n"
"}\n"
"for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {\n"
"set cmd [list $dst add [$src type $i]]\n"
"foreach option [$src entryconfigure $i]  {\n"
"lappend cmd [lindex $option 0] [lindex $option 4]\n"
"}\n"
"eval $cmd\n"
"}\n"
"set tags [bindtags $src]\n"
"set srcLen [string length $src]\n"
"while {[set index [string first $src $tags]] != -1} {\n"
"append x [string range $tags 0 [expr {$index - 1}]]$dst\n"
"set tags [string range $tags [expr {$index + $srcLen}] end]\n"
"}\n"
"append x $tags\n"
"bindtags $dst $x\n"
"foreach event [bind $src] {\n"
"unset x\n"
"set script [bind $src $event]\n"
"set eventLen [string length $event]\n"
"while {[set index [string first $event $script]] != -1} {\n"
"append x [string range $script 0 [expr {$index - 1}]]\n"
"append x $dst\n"
"set script [string range $script [expr {$index + $eventLen}] end]\n"
"}\n"
"append x $script\n"
"bind $dst $event $x\n"
"}\n"
"}\n"
;
static char Et_zFile27[] = 
"bind Text <1> {\n"
"tkTextButton1 %W %x %y\n"
"%W tag remove sel 0.0 end\n"
"}\n"
"bind Text <B1-Motion> {\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <Double-1> {\n"
"set tkPriv(selectMode) word\n"
"tkTextSelectTo %W %x %y\n"
"catch {%W mark set insert sel.last}\n"
"catch {%W mark set anchor sel.first}\n"
"}\n"
"bind Text <Triple-1> {\n"
"set tkPriv(selectMode) line\n"
"tkTextSelectTo %W %x %y\n"
"catch {%W mark set insert sel.last}\n"
"catch {%W mark set anchor sel.first}\n"
"}\n"
"bind Text <Shift-1> {\n"
"tkTextResetAnchor %W @%x,%y\n"
"set tkPriv(selectMode) char\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <Double-Shift-1>\011{\n"
"set tkPriv(selectMode) word\n"
"tkTextSelectTo %W %x %y 1\n"
"}\n"
"bind Text <Triple-Shift-1>\011{\n"
"set tkPriv(selectMode) line\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <B1-Leave> {\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"tkTextAutoScan %W\n"
"}\n"
"bind Text <B1-Enter> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Text <ButtonRelease-1> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Text <Control-1> {\n"
"%W mark set insert @%x,%y\n"
"}\n"
"bind Text <Left> {\n"
"tkTextSetCursor %W insert-1c\n"
"}\n"
"bind Text <Right> {\n"
"tkTextSetCursor %W insert+1c\n"
"}\n"
"bind Text <Up> {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W -1]\n"
"}\n"
"bind Text <Down> {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W 1]\n"
"}\n"
"bind Text <Shift-Left> {\n"
"tkTextKeySelect %W [%W index {insert - 1c}]\n"
"}\n"
"bind Text <Shift-Right> {\n"
"tkTextKeySelect %W [%W index {insert + 1c}]\n"
"}\n"
"bind Text <Shift-Up> {\n"
"tkTextKeySelect %W [tkTextUpDownLine %W -1]\n"
"}\n"
"bind Text <Shift-Down> {\n"
"tkTextKeySelect %W [tkTextUpDownLine %W 1]\n"
"}\n"
"bind Text <Control-Left> {\n"
"tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Control-Right> {\n"
"tkTextSetCursor %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Control-Up> {\n"
"tkTextSetCursor %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Control-Down> {\n"
"tkTextSetCursor %W [tkTextNextPara %W insert]\n"
"}\n"
"bind Text <Shift-Control-Left> {\n"
"tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Shift-Control-Right> {\n"
"tkTextKeySelect %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Shift-Control-Up> {\n"
"tkTextKeySelect %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Shift-Control-Down> {\n"
"tkTextKeySelect %W [tkTextNextPara %W insert]\n"
"}\n"
"bind Text <Prior> {\n"
"tkTextSetCursor %W [tkTextScrollPages %W -1]\n"
"}\n"
"bind Text <Shift-Prior> {\n"
"tkTextKeySelect %W [tkTextScrollPages %W -1]\n"
"}\n"
"bind Text <Next> {\n"
"tkTextSetCursor %W [tkTextScrollPages %W 1]\n"
"}\n"
"bind Text <Shift-Next> {\n"
"tkTextKeySelect %W [tkTextScrollPages %W 1]\n"
"}\n"
"bind Text <Control-Prior> {\n"
"%W xview scroll -1 page\n"
"}\n"
"bind Text <Control-Next> {\n"
"%W xview scroll 1 page\n"
"}\n"
"bind Text <Home> {\n"
"tkTextSetCursor %W {insert linestart}\n"
"}\n"
"bind Text <Shift-Home> {\n"
"tkTextKeySelect %W {insert linestart}\n"
"}\n"
"bind Text <End> {\n"
"tkTextSetCursor %W {insert lineend}\n"
"}\n"
"bind Text <Shift-End> {\n"
"tkTextKeySelect %W {insert lineend}\n"
"}\n"
"bind Text <Control-Home> {\n"
"tkTextSetCursor %W 1.0\n"
"}\n"
"bind Text <Control-Shift-Home> {\n"
"tkTextKeySelect %W 1.0\n"
"}\n"
"bind Text <Control-End> {\n"
"tkTextSetCursor %W {end - 1 char}\n"
"}\n"
"bind Text <Control-Shift-End> {\n"
"tkTextKeySelect %W {end - 1 char}\n"
"}\n"
"bind Text <Tab> {\n"
"tkTextInsert %W \\t\n"
"focus %W\n"
"break\n"
"}\n"
"bind Text <Shift-Tab> {\n"
"break\n"
"}\n"
"bind Text <Control-Tab> {\n"
"focus [tk_focusNext %W]\n"
"}\n"
"bind Text <Control-Shift-Tab> {\n"
"focus [tk_focusPrev %W]\n"
"}\n"
"bind Text <Control-i> {\n"
"tkTextInsert %W \\t\n"
"}\n"
"bind Text <Return> {\n"
"tkTextInsert %W \\n\n"
"}\n"
"bind Text <Delete> {\n"
"if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
"%W delete sel.first sel.last\n"
"} else {\n"
"%W delete insert\n"
"%W see insert\n"
"}\n"
"}\n"
"bind Text <BackSpace> {\n"
"if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
"%W delete sel.first sel.last\n"
"} elseif {[%W compare insert != 1.0]} {\n"
"%W delete insert-1c\n"
"%W see insert\n"
"}\n"
"}\n"
"bind Text <Control-space> {\n"
"%W mark set anchor insert\n"
"}\n"
"bind Text <Select> {\n"
"%W mark set anchor insert\n"
"}\n"
"bind Text <Control-Shift-space> {\n"
"set tkPriv(selectMode) char\n"
"tkTextKeyExtend %W insert\n"
"}\n"
"bind Text <Shift-Select> {\n"
"set tkPriv(selectMode) char\n"
"tkTextKeyExtend %W insert\n"
"}\n"
"bind Text <Control-slash> {\n"
"%W tag add sel 1.0 end\n"
"}\n"
"bind Text <Control-backslash> {\n"
"%W tag remove sel 1.0 end\n"
"}\n"
"bind Text <<Cut>> {\n"
"tk_textCut %W\n"
"}\n"
"bind Text <<Copy>> {\n"
"tk_textCopy %W\n"
"}\n"
"bind Text <<Paste>> {\n"
"tk_textPaste %W\n"
"}\n"
"bind Text <<Clear>> {\n"
"catch {%W delete sel.first sel.last}\n"
"}\n"
"bind Text <<PasteSelection>> {\n"
"if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n"
"tkTextPaste %W %x %y\n"
"}\n"
"}\n"
"bind Text <Insert> {\n"
"catch {tkTextInsert %W [selection get -displayof %W]}\n"
"}\n"
"bind Text <KeyPress> {\n"
"tkTextInsert %W %A\n"
"}\n"
"bind Text <Alt-KeyPress> {# nothing }\n"
"bind Text <Meta-KeyPress> {# nothing}\n"
"bind Text <Control-KeyPress> {# nothing}\n"
"bind Text <Escape> {# nothing}\n"
"bind Text <KP_Enter> {# nothing}\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Text <Command-KeyPress> {# nothing}\n"
"}\n"
"bind Text <Control-a> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W {insert linestart}\n"
"}\n"
"}\n"
"bind Text <Control-b> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W insert-1c\n"
"}\n"
"}\n"
"bind Text <Control-d> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert\n"
"}\n"
"}\n"
"bind Text <Control-e> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W {insert lineend}\n"
"}\n"
"}\n"
"bind Text <Control-f> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W insert+1c\n"
"}\n"
"}\n"
"bind Text <Control-k> {\n"
"if {!$tk_strictMotif} {\n"
"if {[%W compare insert == {insert lineend}]} {\n"
"%W delete insert\n"
"} else {\n"
"%W delete insert {insert lineend}\n"
"}\n"
"}\n"
"}\n"
"bind Text <Control-n> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W 1]\n"
"}\n"
"}\n"
"bind Text <Control-o> {\n"
"if {!$tk_strictMotif} {\n"
"%W insert insert \\n\n"
"%W mark set insert insert-1c\n"
"}\n"
"}\n"
"bind Text <Control-p> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W -1]\n"
"}\n"
"}\n"
"bind Text <Control-t> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextTranspose %W\n"
"}\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
"bind Text <Control-v> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextScrollPages %W 1\n"
"}\n"
"}\n"
"}\n"
"bind Text <Meta-b> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"}\n"
"bind Text <Meta-d> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert [tkTextNextWord %W insert]\n"
"}\n"
"}\n"
"bind Text <Meta-f> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextNextWord %W insert]\n"
"}\n"
"}\n"
"bind Text <Meta-less> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W 1.0\n"
"}\n"
"}\n"
"bind Text <Meta-greater> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W end-1c\n"
"}\n"
"}\n"
"bind Text <Meta-BackSpace> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert\n"
"}\n"
"}\n"
"bind Text <Meta-Delete> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert\n"
"}\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Text <FocusIn> {\n"
"%W tag configure sel -borderwidth 0\n"
"%W configure -selectbackground systemHighlight -selectforeground systemHighlightText\n"
"}\n"
"bind Text <FocusOut> {\n"
"%W tag configure sel -borderwidth 1\n"
"%W configure -selectbackground white -selectforeground black\n"
"}\n"
"bind Text <Option-Left> {\n"
"tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Option-Right> {\n"
"tkTextSetCursor %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Option-Up> {\n"
"tkTextSetCursor %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Option-Down> {\n"
"tkTextSetCursor %W [tkTextNextPara %W insert]\n"
"}\n"
"bind Text <Shift-Option-Left> {\n"
"tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Shift-Option-Right> {\n"
"tkTextKeySelect %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Shift-Option-Up> {\n"
"tkTextKeySelect %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Shift-Option-Down> {\n"
"tkTextKeySelect %W [tkTextNextPara %W insert]\n"
"}\n"
"}\n"
"bind Text <Control-h> {\n"
"if {!$tk_strictMotif} {\n"
"if {[%W compare insert != 1.0]} {\n"
"%W delete insert-1c\n"
"%W see insert\n"
"}\n"
"}\n"
"}\n"
"bind Text <2> {\n"
"if {!$tk_strictMotif} {\n"
"%W scan mark %x %y\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"set tkPriv(mouseMoved) 0\n"
"}\n"
"}\n"
"bind Text <B2-Motion> {\n"
"if {!$tk_strictMotif} {\n"
"if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {\n"
"set tkPriv(mouseMoved) 1\n"
"}\n"
"if {$tkPriv(mouseMoved)} {\n"
"%W scan dragto %x %y\n"
"}\n"
"}\n"
"}\n"
"set tkPriv(prevPos) {}\n"
"bind Text <MouseWheel> {\n"
"%W yview scroll [expr {- (%D / 120) * 4}] units\n"
"}\n"
"if {[string equal \"unix\" $tcl_platform(platform)]} {\n"
"bind Text <4> {\n"
"if {!$tk_strictMotif} {\n"
"%W yview scroll -5 units\n"
"}\n"
"}\n"
"bind Text <5> {\n"
"if {!$tk_strictMotif} {\n"
"%W yview scroll 5 units\n"
"}\n"
"}\n"
"}\n"
"proc tkTextClosestGap {w x y} {\n"
"set pos [$w index @$x,$y]\n"
"set bbox [$w bbox $pos]\n"
"if {[string equal $bbox \"\"]} {\n"
"return $pos\n"
"}\n"
"if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {\n"
"return $pos\n"
"}\n"
"$w index \"$pos + 1 char\"\n"
"}\n"
"proc tkTextButton1 {w x y} {\n"
"global tkPriv\n"
"set tkPriv(selectMode) char\n"
"set tkPriv(mouseMoved) 0\n"
"set tkPriv(pressX) $x\n"
"$w mark set insert [tkTextClosestGap $w $x $y]\n"
"$w mark set anchor insert\n"
"if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
"}\n"
"proc tkTextSelectTo {w x y {extend 0}} {\n"
"global tkPriv tcl_platform\n"
"set cur [tkTextClosestGap $w $x $y]\n"
"if {[catch {$w index anchor}]} {\n"
"$w mark set anchor $cur\n"
"}\n"
"set anchor [$w index anchor]\n"
"if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {\n"
"set tkPriv(mouseMoved) 1\n"
"}\n"
"switch $tkPriv(selectMode) {\n"
"char {\n"
"if {[$w compare $cur < anchor]} {\n"
"set first $cur\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $cur\n"
"}\n"
"}\n"
"word {\n"
"if {[$w compare $cur < anchor]} {\n"
"set first [tkTextPrevPos $w \"$cur + 1c\" tcl_wordBreakBefore]\n"
"if { !$extend } {\n"
"set last [tkTextNextPos $w \"anchor\" tcl_wordBreakAfter]\n"
"} else {\n"
"set last anchor\n"
"}\n"
"} else {\n"
"set last [tkTextNextPos $w \"$cur - 1c\" tcl_wordBreakAfter]\n"
"if { !$extend } {\n"
"set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]\n"
"} else {\n"
"set first anchor\n"
"}\n"
"}\n"
"}\n"
"line {\n"
"if {[$w compare $cur < anchor]} {\n"
"set first [$w index \"$cur linestart\"]\n"
"set last [$w index \"anchor - 1c lineend + 1c\"]\n"
"} else {\n"
"set first [$w index \"anchor linestart\"]\n"
"set last [$w index \"$cur lineend + 1c\"]\n"
"}\n"
"}\n"
"}\n"
"if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) \"char\"]} {\n"
"if {[string compare $tcl_platform(platform) \"unix\"] \\\n"
"\011\011&& [$w compare $cur < anchor]} {\n"
"$w mark set insert $first\n"
"} else {\n"
"$w mark set insert $last\n"
"}\n"
"$w tag remove sel 0.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"update idletasks\n"
"}\n"
"}\n"
"proc tkTextKeyExtend {w index} {\n"
"global tkPriv\n"
"set cur [$w index $index]\n"
"if {[catch {$w index anchor}]} {\n"
"$w mark set anchor $cur\n"
"}\n"
"set anchor [$w index anchor]\n"
"if {[$w compare $cur < anchor]} {\n"
"set first $cur\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $cur\n"
"}\n"
"$w tag remove sel 0.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"}\n"
"proc tkTextPaste {w x y} {\n"
"$w mark set insert [tkTextClosestGap $w $x $y]\n"
"catch {$w insert insert [selection get -displayof $w]}\n"
"if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
"}\n"
"proc tkTextAutoScan {w} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"if {$tkPriv(y) >= [winfo height $w]} {\n"
"$w yview scroll 2 units\n"
"} elseif {$tkPriv(y) < 0} {\n"
"$w yview scroll -2 units\n"
"} elseif {$tkPriv(x) >= [winfo width $w]} {\n"
"$w xview scroll 2 units\n"
"} elseif {$tkPriv(x) < 0} {\n"
"$w xview scroll -2 units\n"
"} else {\n"
"return\n"
"}\n"
"tkTextSelectTo $w $tkPriv(x) $tkPriv(y)\n"
"set tkPriv(afterId) [after 50 [list tkTextAutoScan $w]]\n"
"}\n"
"proc tkTextSetCursor {w pos} {\n"
"global tkPriv\n"
"if {[$w compare $pos == end]} {\n"
"set pos {end - 1 chars}\n"
"}\n"
"$w mark set insert $pos\n"
"$w tag remove sel 1.0 end\n"
"$w see insert\n"
"}\n"
"proc tkTextKeySelect {w new} {\n"
"global tkPriv\n"
"if {[string equal [$w tag nextrange sel 1.0 end] \"\"]} {\n"
"if {[$w compare $new < insert]} {\n"
"$w tag add sel $new insert\n"
"} else {\n"
"$w tag add sel insert $new\n"
"}\n"
"$w mark set anchor insert\n"
"} else {\n"
"if {[$w compare $new < anchor]} {\n"
"set first $new\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $new\n"
"}\n"
"$w tag remove sel 1.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"}\n"
"$w mark set insert $new\n"
"$w see insert\n"
"update idletasks\n"
"}\n"
"proc tkTextResetAnchor {w index} {\n"
"global tkPriv\n"
"if {[string equal [$w tag ranges sel] \"\"]} {\n"
"$w mark set anchor $index\n"
"return\n"
"}\n"
"set a [$w index $index]\n"
"set b [$w index sel.first]\n"
"set c [$w index sel.last]\n"
"if {[$w compare $a < $b]} {\n"
"$w mark set anchor sel.last\n"
"return\n"
"}\n"
"if {[$w compare $a > $c]} {\n"
"$w mark set anchor sel.first\n"
"return\n"
"}\n"
"scan $a \"%d.%d\" lineA chA\n"
"scan $b \"%d.%d\" lineB chB\n"
"scan $c \"%d.%d\" lineC chC\n"
"if {$lineB < $lineC+2} {\n"
"set total [string length [$w get $b $c]]\n"
"if {$total <= 2} {\n"
"return\n"
"}\n"
"if {[string length [$w get $b $a]] < ($total/2)} {\n"
"$w mark set anchor sel.last\n"
"} else {\n"
"$w mark set anchor sel.first\n"
"}\n"
"return\n"
"}\n"
"if {($lineA-$lineB) < ($lineC-$lineA)} {\n"
"$w mark set anchor sel.last\n"
"} else {\n"
"$w mark set anchor sel.first\n"
"}\n"
"}\n"
"proc tkTextInsert {w s} {\n"
"if {[string equal $s \"\"] || [string equal [$w cget -state] \"disabled\"]} {\n"
"return\n"
"}\n"
"catch {\n"
"if {[$w compare sel.first <= insert] \\\n"
"\011\011&& [$w compare sel.last >= insert]} {\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"$w insert insert $s\n"
"$w see insert\n"
"}\n"
"proc tkTextUpDownLine {w n} {\n"
"global tkPriv\n"
"set i [$w index insert]\n"
"scan $i \"%d.%d\" line char\n"
"if {[string compare $tkPriv(prevPos) $i]} {\n"
"set tkPriv(char) $char\n"
"}\n"
"set new [$w index [expr {$line + $n}].$tkPriv(char)]\n"
"if {[$w compare $new == end] || [$w compare $new == \"insert linestart\"]} {\n"
"set new $i\n"
"}\n"
"set tkPriv(prevPos) $new\n"
"return $new\n"
"}\n"
"proc tkTextPrevPara {w pos} {\n"
"set pos [$w index \"$pos linestart\"]\n"
"while {1} {\n"
"if {([string equal [$w get \"$pos - 1 line\"] \"\\n\"] \\\n"
"\011\011&& [string compare [$w get $pos] \"\\n\"]) \\\n"
"\011\011|| [string equal $pos \"1.0\"]} {\n"
"if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n"
"\011\011    dummy index]} {\n"
"set pos [$w index \"$pos + [lindex $index 0] chars\"]\n"
"}\n"
"if {[$w compare $pos != insert] || [string equal $pos 1.0]} {\n"
"return $pos\n"
"}\n"
"}\n"
"set pos [$w index \"$pos - 1 line\"]\n"
"}\n"
"}\n"
"proc tkTextNextPara {w start} {\n"
"set pos [$w index \"$start linestart + 1 line\"]\n"
"while {[string compare [$w get $pos] \"\\n\"]} {\n"
"if {[$w compare $pos == end]} {\n"
"return [$w index \"end - 1c\"]\n"
"}\n"
"set pos [$w index \"$pos + 1 line\"]\n"
"}\n"
"while {[string equal [$w get $pos] \"\\n\"]} {\n"
"set pos [$w index \"$pos + 1 line\"]\n"
"if {[$w compare $pos == end]} {\n"
"return [$w index \"end - 1c\"]\n"
"}\n"
"}\n"
"if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n"
"\011    dummy index]} {\n"
"return [$w index \"$pos + [lindex $index 0] chars\"]\n"
"}\n"
"return $pos\n"
"}\n"
"proc tkTextScrollPages {w count} {\n"
"set bbox [$w bbox insert]\n"
"$w yview scroll $count pages\n"
"if {[string equal $bbox \"\"]} {\n"
"return [$w index @[expr {[winfo height $w]/2}],0]\n"
"}\n"
"return [$w index @[lindex $bbox 0],[lindex $bbox 1]]\n"
"}\n"
"proc tkTextTranspose w {\n"
"set pos insert\n"
"if {[$w compare $pos != \"$pos lineend\"]} {\n"
"set pos [$w index \"$pos + 1 char\"]\n"
"}\n"
"set new [$w get \"$pos - 1 char\"][$w get  \"$pos - 2 char\"]\n"
"if {[$w compare \"$pos - 1 char\" == 1.0]} {\n"
"return\n"
"}\n"
"$w delete \"$pos - 2 char\" $pos\n"
"$w insert insert $new\n"
"$w see insert\n"
"}\n"
"proc tk_textCopy w {\n"
"if {![catch {set data [$w get sel.first sel.last]}]} {\n"
"clipboard clear -displayof $w\n"
"clipboard append -displayof $w $data\n"
"}\n"
"}\n"
"proc tk_textCut w {\n"
"if {![catch {set data [$w get sel.first sel.last]}]} {\n"
"clipboard clear -displayof $w\n"
"clipboard append -displayof $w $data\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"proc tk_textPaste w {\n"
"global tcl_platform\n"
"catch {\n"
"if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
"catch {\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"$w insert insert [selection get -displayof $w -selection CLIPBOARD]\n"
"}\n"
"}\n"
"if {[string equal $tcl_platform(platform) \"windows\"]}  {\n"
"proc tkTextNextWord {w start} {\n"
"tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \\\n"
"\011    tcl_startOfNextWord\n"
"}\n"
"} else {\n"
"proc tkTextNextWord {w start} {\n"
"tkTextNextPos $w $start tcl_endOfWord\n"
"}\n"
"}\n"
"proc tkTextNextPos {w start op} {\n"
"set text \"\"\n"
"set cur $start\n"
"while {[$w compare $cur < end]} {\n"
"set text $text[$w get $cur \"$cur lineend + 1c\"]\n"
"set pos [$op $text 0]\n"
"if {$pos >= 0} {\n"
"set dump [$w dump -image -window $start \"$start + $pos c\"]\n"
"if {[llength $dump]} {\n"
"set pos [expr {$pos + ([llength $dump]/3)}]\n"
"}\n"
"return [$w index \"$start + $pos c\"]\n"
"}\n"
"set cur [$w index \"$cur lineend +1c\"]\n"
"}\n"
"return end\n"
"}\n"
"proc tkTextPrevPos {w start op} {\n"
"set text \"\"\n"
"set cur $start\n"
"while {[$w compare $cur > 0.0]} {\n"
"set text [$w get \"$cur linestart - 1c\" $cur]$text\n"
"set pos [$op $text end]\n"
"if {$pos >= 0} {\n"
"set dump [$w dump -image -window \"$cur linestart\" \"$start - 1c\"]\n"
"if {[llength $dump]} {\n"
"if {[$w compare [lindex $dump 2] > \\\n"
"\011\011\011\"$cur linestart - 1c + $pos c\"]} {\n"
"incr pos -1\n"
"}\n"
"set pos [expr {$pos + ([llength $dump]/3)}]\n"
"}\n"
"return [$w index \"$cur linestart - 1c + $pos c\"]\n"
"}\n"
"set cur [$w index \"$cur linestart - 1c\"]\n"
"}\n"
"return 0.0\n"
"}\n"
;
static char Et_zFile28[] = 
"package require -exact Tk 8.3\n"
"package require -exact Tcl 8.3\n"
"if {[info exists auto_path] && [string compare {} $tk_library] && \\\n"
"\011[lsearch -exact $auto_path $tk_library] < 0} {\n"
"lappend auto_path $tk_library\n"
"}\n"
"set tk_strictMotif 0\n"
"namespace eval ::tk {\n"
"}\n"
"proc ::tk::PlaceWindow {w {place \"\"} {anchor \"\"}} {\n"
"wm withdraw $w\n"
"update idletasks\n"
"set checkBounds 1\n"
"if {[string equal -len [string length $place] $place \"pointer\"]} {\n"
"if {[string equal -len [string length $anchor] $anchor \"center\"]} {\n"
"set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]\n"
"set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]\n"
"} else {\n"
"set x [winfo pointerx $w]\n"
"set y [winfo pointery $w]\n"
"}\n"
"} elseif {[string equal -len [string length $place] $place \"widget\"] && \\\n"
"\011    [winfo exists $anchor] && [winfo ismapped $anchor]} {\n"
"set x [expr {[winfo rootx $anchor] + \\\n"
"\011\011([winfo width $anchor]-[winfo reqwidth $w])/2}]\n"
"set y [expr {[winfo rooty $anchor] + \\\n"
"\011\011([winfo height $anchor]-[winfo reqheight $w])/2}]\n"
"} else {\n"
"set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]\n"
"set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]\n"
"set checkBounds 0\n"
"}\n"
"if {$checkBounds} {\n"
"if {$x < 0} {\n"
"set x 0\n"
"} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {\n"
"set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]\n"
"}\n"
"if {$y < 0} {\n"
"set y 0\n"
"} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {\n"
"set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]\n"
"}\n"
"}\n"
"wm geometry $w +$x+$y\n"
"wm deiconify $w\n"
"}\n"
"proc ::tk::SetFocusGrab {grab {focus {}}} {\n"
"set index \"$grab,$focus\"\n"
"upvar ::tk::FocusGrab($index) data\n"
"lappend data [focus]\n"
"set oldGrab [grab current $grab]\n"
"lappend data $oldGrab\n"
"if {[winfo exists $oldGrab]} {\n"
"lappend data [grab status $oldGrab]\n"
"}\n"
"grab $grab\n"
"if {[winfo exists $focus]} {\n"
"focus $focus\n"
"}\n"
"}\n"
"proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {\n"
"set index \"$grab,$focus\"\n"
"foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }\n"
"unset ::tk::FocusGrab($index)\n"
"catch {focus $oldFocus}\n"
"grab release $grab\n"
"if {[string equal $destroy \"withdraw\"]} {\n"
"wm withdraw $grab\n"
"} else {\n"
"destroy $grab\n"
"}\n"
"if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {\n"
"if {[string equal $oldStatus \"global\"]} {\n"
"grab -global $oldGrab\n"
"} else {\n"
"grab $oldGrab\n"
"}\n"
"}\n"
"}\n"
"proc tkScreenChanged screen {\n"
"set x [string last . $screen]\n"
"if {$x > 0} {\n"
"set disp [string range $screen 0 [expr {$x - 1}]]\n"
"} else {\n"
"set disp $screen\n"
"}\n"
"uplevel #0 upvar #0 tkPriv.$disp tkPriv\n"
"global tkPriv\n"
"global tcl_platform\n"
"if {[info exists tkPriv]} {\n"
"set tkPriv(screen) $screen\n"
"return\n"
"}\n"
"array set tkPriv {\n"
"activeMenu\011{}\n"
"activeItem\011{}\n"
"afterId\011\011{}\n"
"buttons\011\0110\n"
"buttonWindow\011{}\n"
"dragging\0110\n"
"focus\011\011{}\n"
"grab\011\011{}\n"
"initPos\011\011{}\n"
"inMenubutton\011{}\n"
"listboxPrev\011{}\n"
"menuBar\011\011{}\n"
"mouseMoved\0110\n"
"oldGrab\011\011{}\n"
"popup\011\011{}\n"
"postedMb\011{}\n"
"pressX\011\0110\n"
"pressY\011\0110\n"
"prevPos\011\0110\n"
"selectMode\011char\n"
"}\n"
"set tkPriv(screen) $screen\n"
"set tkPriv(tearoff) [string equal $tcl_platform(platform) \"unix\"]\n"
"set tkPriv(window) {}\n"
"}\n"
"tkScreenChanged [winfo screen .]\n"
"proc tkEventMotifBindings {n1 dummy dummy} {\n"
"upvar $n1 name\n"
"if {$name} {\n"
"set op delete\n"
"} else {\n"
"set op add\n"
"}\n"
"event $op <<Cut>> <Control-Key-w>\n"
"event $op <<Copy>> <Meta-Key-w> \n"
"event $op <<Paste>> <Control-Key-y>\n"
"}\n"
"if {[string equal [info commands tk_chooseColor] \"\"]} {\n"
"proc tk_chooseColor {args} {\n"
"return [eval tkColorDialog $args]\n"
"}\n"
"}\n"
"if {[string equal [info commands tk_getOpenFile] \"\"]} {\n"
"proc tk_getOpenFile {args} {\n"
"if {$::tk_strictMotif} {\n"
"return [eval tkMotifFDialog open $args]\n"
"} else {\n"
"return [eval ::tk::dialog::file::tkFDialog open $args]\n"
"}\n"
"}\n"
"}\n"
"if {[string equal [info commands tk_getSaveFile] \"\"]} {\n"
"proc tk_getSaveFile {args} {\n"
"if {$::tk_strictMotif} {\n"
"return [eval tkMotifFDialog save $args]\n"
"} else {\n"
"return [eval ::tk::dialog::file::tkFDialog save $args]\n"
"}\n"
"}\n"
"}\n"
"if {[string equal [info commands tk_messageBox] \"\"]} {\n"
"proc tk_messageBox {args} {\n"
"return [eval tkMessageBox $args]\n"
"}\n"
"}\n"
"if {[string equal [info command tk_chooseDirectory] \"\"]} {\n"
"proc tk_chooseDirectory {args} {\n"
"return [eval ::tk::dialog::file::chooseDir::tkChooseDirectory $args]\n"
"}\n"
"}\n"
"switch $tcl_platform(platform) {\n"
"\"unix\" {\n"
"event add <<Cut>> <Control-Key-x> <Key-F20> \n"
"event add <<Copy>> <Control-Key-c> <Key-F16>\n"
"event add <<Paste>> <Control-Key-v> <Key-F18>\n"
"event add <<PasteSelection>> <ButtonRelease-2>\n"
"if {[info exists tcl_platform(os)]} {\n"
"switch $tcl_platform(os) {\n"
"\"IRIX\"  -\n"
"\"Linux\" { event add <<PrevWindow>> <ISO_Left_Tab> }\n"
"\"HP-UX\" { event add <<PrevWindow>> <hpBackTab> }\n"
"}\n"
"}\n"
"trace variable tk_strictMotif w tkEventMotifBindings\n"
"set tk_strictMotif $tk_strictMotif\n"
"}\n"
"\"windows\" {\n"
"event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>\n"
"event add <<Copy>> <Control-Key-c> <Control-Key-Insert>\n"
"event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>\n"
"event add <<PasteSelection>> <ButtonRelease-2>\n"
"}\n"
"\"macintosh\" {\n"
"event add <<Cut>> <Control-Key-x> <Key-F2> \n"
"event add <<Copy>> <Control-Key-c> <Key-F3>\n"
"event add <<Paste>> <Control-Key-v> <Key-F4>\n"
"event add <<PasteSelection>> <ButtonRelease-2>\n"
"event add <<Clear>> <Clear>\n"
"}\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"macintosh\"] && \\\n"
"\011[string compare {} $tk_library]} {\n"
"source [file join $tk_library button.tcl]\n"
"source [file join $tk_library entry.tcl]\n"
"source [file join $tk_library listbox.tcl]\n"
"source [file join $tk_library menu.tcl]\n"
"source [file join $tk_library scale.tcl]\n"
"source [file join $tk_library scrlbar.tcl]\n"
"source [file join $tk_library text.tcl]\n"
"}\n"
"event add <<PrevWindow>> <Shift-Tab>\n"
"bind all <Tab> {tkTabToWindow [tk_focusNext %W]}\n"
"bind all <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}\n"
"proc tkCancelRepeat {} {\n"
"global tkPriv\n"
"after cancel $tkPriv(afterId)\n"
"set tkPriv(afterId) {}\n"
"}\n"
"proc tkTabToWindow {w} {\n"
"if {[string equal [winfo class $w] Entry]} {\n"
"$w selection range 0 end\n"
"$w icursor end\n"
"}\n"
"focus $w\n"
"}\n"
;
static char Et_zFile29[] = 
"proc tkIconList {w args} {\n"
"upvar #0 $w data\n"
"tkIconList_Config $w $args\n"
"tkIconList_Create $w\n"
"}\n"
"proc tkIconList_Config {w argList} {\n"
"upvar #0 $w data\n"
"set specs {\n"
"{-browsecmd \"\" \"\" \"\"}\n"
"{-command \"\" \"\" \"\"}\n"
"}\n"
"tclParseConfigSpec $w $specs \"\" $argList\n"
"}\n"
"proc tkIconList_Create {w} {\n"
"upvar #0 $w data\n"
"frame $w\n"
"set data(sbar)   [scrollbar $w.sbar -orient horizontal \\\n"
"\011-highlightthickness 0 -takefocus 0]\n"
"set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \\\n"
"\011-width 400 -height 120 -takefocus 1]\n"
"pack $data(sbar) -side bottom -fill x -padx 2\n"
"pack $data(canvas) -expand yes -fill both\n"
"$data(sbar) config -command [list $data(canvas) xview]\n"
"$data(canvas) config -xscrollcommand [list $data(sbar) set]\n"
"set data(maxIW) 1\n"
"set data(maxIH) 1\n"
"set data(maxTW) 1\n"
"set data(maxTH) 1\n"
"set data(numItems) 0\n"
"set data(curItem)  {}\n"
"set data(noScroll) 1\n"
"bind $data(canvas) <Configure>\011[list tkIconList_Arrange $w]\n"
"bind $data(canvas) <1>\011\011[list tkIconList_Btn1 $w %x %y]\n"
"bind $data(canvas) <B1-Motion>\011[list tkIconList_Motion1 $w %x %y]\n"
"bind $data(canvas) <B1-Leave>\011[list tkIconList_Leave1 $w %x %y]\n"
"bind $data(canvas) <B1-Enter>\011[list tkCancelRepeat]\n"
"bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat]\n"
"bind $data(canvas) <Double-ButtonRelease-1> \\\n"
"\011    [list tkIconList_Double1 $w %x %y]\n"
"bind $data(canvas) <Up>\011\011[list tkIconList_UpDown $w -1]\n"
"bind $data(canvas) <Down>\011\011[list tkIconList_UpDown $w  1]\n"
"bind $data(canvas) <Left>\011\011[list tkIconList_LeftRight $w -1]\n"
"bind $data(canvas) <Right>\011\011[list tkIconList_LeftRight $w  1]\n"
"bind $data(canvas) <Return>\011\011[list tkIconList_ReturnKey $w]\n"
"bind $data(canvas) <KeyPress>\011[list tkIconList_KeyPress $w %A]\n"
"bind $data(canvas) <Control-KeyPress> \";\"\n"
"bind $data(canvas) <Alt-KeyPress>\011\";\"\n"
"bind $data(canvas) <FocusIn>\011[list tkIconList_FocusIn $w]\n"
"return $w\n"
"}\n"
"proc tkIconList_AutoScan {w} {\n"
"upvar #0 $w data\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"set x $tkPriv(x)\n"
"set y $tkPriv(y)\n"
"if {$data(noScroll)} {\n"
"return\n"
"}\n"
"if {$x >= [winfo width $data(canvas)]} {\n"
"$data(canvas) xview scroll 1 units\n"
"} elseif {$x < 0} {\n"
"$data(canvas) xview scroll -1 units\n"
"} elseif {$y >= [winfo height $data(canvas)]} {\n"
"} elseif {$y < 0} {\n"
"} else {\n"
"return\n"
"}\n"
"tkIconList_Motion1 $w $x $y\n"
"set tkPriv(afterId) [after 50 [list tkIconList_AutoScan $w]]\n"
"}\n"
"proc tkIconList_DeleteAll {w} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"$data(canvas) delete all\n"
"catch {unset data(selected)}\n"
"catch {unset data(rect)}\n"
"catch {unset data(list)}\n"
"catch {unset itemList}\n"
"set data(maxIW) 1\n"
"set data(maxIH) 1\n"
"set data(maxTW) 1\n"
"set data(maxTH) 1\n"
"set data(numItems) 0\n"
"set data(curItem)  {}\n"
"set data(noScroll) 1\n"
"$data(sbar) set 0.0 1.0\n"
"$data(canvas) xview moveto 0\n"
"}\n"
"proc tkIconList_Add {w image text} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"upvar #0 $w:textList textList\n"
"set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]\n"
"set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \\\n"
"\011-font $data(font)]\n"
"set rTag [$data(canvas) create rect  0 0 0 0 -fill \"\" -outline \"\"]\n"
"set b [$data(canvas) bbox $iTag]\n"
"set iW [expr {[lindex $b 2]-[lindex $b 0]}]\n"
"set iH [expr {[lindex $b 3]-[lindex $b 1]}]\n"
"if {$data(maxIW) < $iW} {\n"
"set data(maxIW) $iW\n"
"}\n"
"if {$data(maxIH) < $iH} {\n"
"set data(maxIH) $iH\n"
"}\n"
"set b [$data(canvas) bbox $tTag]\n"
"set tW [expr {[lindex $b 2]-[lindex $b 0]}]\n"
"set tH [expr {[lindex $b 3]-[lindex $b 1]}]\n"
"if {$data(maxTW) < $tW} {\n"
"set data(maxTW) $tW\n"
"}\n"
"if {$data(maxTH) < $tH} {\n"
"set data(maxTH) $tH\n"
"}\n"
"lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]\n"
"set itemList($rTag) [list $iTag $tTag $text $data(numItems)]\n"
"set textList($data(numItems)) [string tolower $text]\n"
"incr data(numItems)\n"
"}\n"
"proc tkIconList_Arrange {w} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {\n"
"set data(noScroll) 1\n"
"$data(sbar) config -command \"\"\n"
"}\n"
"return\n"
"}\n"
"set W [winfo width  $data(canvas)]\n"
"set H [winfo height $data(canvas)]\n"
"set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n"
"\011    [$data(canvas) cget -bd]}]\n"
"if {$pad < 2} {\n"
"set pad 2\n"
"}\n"
"incr W -[expr {$pad*2}]\n"
"incr H -[expr {$pad*2}]\n"
"set dx [expr {$data(maxIW) + $data(maxTW) + 8}]\n"
"if {$data(maxTH) > $data(maxIH)} {\n"
"set dy $data(maxTH)\n"
"} else {\n"
"set dy $data(maxIH)\n"
"}\n"
"incr dy 2\n"
"set shift [expr {$data(maxIW) + 4}]\n"
"set x [expr {$pad * 2}]\n"
"set y [expr {$pad * 1}] ; # Why * 1 ?\n"
"set usedColumn 0\n"
"foreach sublist $data(list) {\n"
"set usedColumn 1\n"
"set iTag [lindex $sublist 0]\n"
"set tTag [lindex $sublist 1]\n"
"set rTag [lindex $sublist 2]\n"
"set iW   [lindex $sublist 3]\n"
"set iH   [lindex $sublist 4]\n"
"set tW   [lindex $sublist 5]\n"
"set tH   [lindex $sublist 6]\n"
"set i_dy [expr {($dy - $iH)/2}]\n"
"set t_dy [expr {($dy - $tH)/2}]\n"
"$data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]\n"
"$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]\n"
"$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]\n"
"$data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]\n"
"incr y $dy\n"
"if {($y + $dy) > $H} {\n"
"set y [expr {$pad * 1}] ; # *1 ?\n"
"incr x $dx\n"
"set usedColumn 0\n"
"}\n"
"}\n"
"if {$usedColumn} {\n"
"set sW [expr {$x + $dx}]\n"
"} else {\n"
"set sW $x\n"
"}\n"
"if {$sW < $W} {\n"
"$data(canvas) config -scrollregion [list $pad $pad $sW $H]\n"
"$data(sbar) config -command \"\"\n"
"$data(canvas) xview moveto 0\n"
"set data(noScroll) 1\n"
"} else {\n"
"$data(canvas) config -scrollregion [list $pad $pad $sW $H]\n"
"$data(sbar) config -command [list $data(canvas) xview]\n"
"set data(noScroll) 0\n"
"}\n"
"set data(itemsPerColumn) [expr {($H-$pad)/$dy}]\n"
"if {$data(itemsPerColumn) < 1} {\n"
"set data(itemsPerColumn) 1\n"
"}\n"
"if {$data(curItem) != \"\"} {\n"
"tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0\n"
"}\n"
"}\n"
"proc tkIconList_Invoke {w} {\n"
"upvar #0 $w data\n"
"if {$data(-command) != \"\" && [info exists data(selected)]} {\n"
"uplevel #0 $data(-command)\n"
"}\n"
"}\n"
"proc tkIconList_See {w rTag} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"if {$data(noScroll)} {\n"
"return\n"
"}\n"
"set sRegion [$data(canvas) cget -scrollregion]\n"
"if {[string equal $sRegion {}]} {\n"
"return\n"
"}\n"
"if {![info exists itemList($rTag)]} {\n"
"return\n"
"}\n"
"set bbox [$data(canvas) bbox $rTag]\n"
"set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n"
"\011    [$data(canvas) cget -bd]}]\n"
"set x1 [lindex $bbox 0]\n"
"set x2 [lindex $bbox 2]\n"
"incr x1 -[expr {$pad * 2}]\n"
"incr x2 -[expr {$pad * 1}] ; # *1 ?\n"
"set cW [expr {[winfo width $data(canvas)] - $pad*2}]\n"
"set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]\n"
"set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]\n"
"set oldDispX $dispX\n"
"if {($x2 - $dispX) >= $cW} {\n"
"set dispX [expr {$x2 - $cW}]\n"
"}\n"
"if {($x1 - $dispX) < 0} {\n"
"set dispX $x1\n"
"}\n"
"if {$oldDispX != $dispX} {\n"
"set fraction [expr {double($dispX)/double($scrollW)}]\n"
"$data(canvas) xview moveto $fraction\n"
"}\n"
"}\n"
"proc tkIconList_SelectAtXY {w x y} {\n"
"upvar #0 $w data\n"
"tkIconList_Select $w [$data(canvas) find closest \\\n"
"\011    [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]\n"
"}\n"
"proc tkIconList_Select {w rTag {callBrowse 1}} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"if {![info exists itemList($rTag)]} {\n"
"return\n"
"}\n"
"set iTag   [lindex $itemList($rTag) 0]\n"
"set tTag   [lindex $itemList($rTag) 1]\n"
"set text   [lindex $itemList($rTag) 2]\n"
"set serial [lindex $itemList($rTag) 3]\n"
"if {![info exists data(rect)]} {\n"
"set data(rect) [$data(canvas) create rect 0 0 0 0 \\\n"
"\011\011-fill #a0a0ff -outline #a0a0ff]\n"
"}\n"
"$data(canvas) lower $data(rect)\n"
"set bbox [$data(canvas) bbox $tTag]\n"
"eval [list $data(canvas) coords $data(rect)] $bbox\n"
"set data(curItem) $serial\n"
"set data(selected) $text\n"
"if {$callBrowse && $data(-browsecmd) != \"\"} {\n"
"eval $data(-browsecmd) [list $text]\n"
"}\n"
"}\n"
"proc tkIconList_Unselect {w} {\n"
"upvar #0 $w data\n"
"if {[info exists data(rect)]} {\n"
"$data(canvas) delete $data(rect)\n"
"unset data(rect)\n"
"}\n"
"if {[info exists data(selected)]} {\n"
"unset data(selected)\n"
"}\n"
"#set data(curItem)  {}\n"
"}\n"
"proc tkIconList_Get {w} {\n"
"upvar #0 $w data\n"
"if {[info exists data(selected)]} {\n"
"return $data(selected)\n"
"} else {\n"
"return \"\"\n"
"}\n"
"}\n"
"proc tkIconList_Btn1 {w x y} {\n"
"upvar #0 $w data\n"
"focus $data(canvas)\n"
"tkIconList_SelectAtXY $w $x $y\n"
"}\n"
"proc tkIconList_Motion1 {w x y} {\n"
"global tkPriv\n"
"set tkPriv(x) $x\n"
"set tkPriv(y) $y\n"
"tkIconList_SelectAtXY $w $x $y\n"
"}\n"
"proc tkIconList_Double1 {w x y} {\n"
"upvar #0 $w data\n"
"if {[string compare $data(curItem) {}]} {\n"
"tkIconList_Invoke $w\n"
"}\n"
"}\n"
"proc tkIconList_ReturnKey {w} {\n"
"tkIconList_Invoke $w\n"
"}\n"
"proc tkIconList_Leave1 {w x y} {\n"
"global tkPriv\n"
"set tkPriv(x) $x\n"
"set tkPriv(y) $y\n"
"tkIconList_AutoScan $w\n"
"}\n"
"proc tkIconList_FocusIn {w} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {[string compare $data(curItem) {}]} {\n"
"tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 1\n"
"}\n"
"}\n"
"proc tkIconList_UpDown {w amount} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {[string equal $data(curItem) {}]} {\n"
"set rTag [lindex [lindex $data(list) 0] 2]\n"
"} else {\n"
"set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]\n"
"set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]\n"
"if {[string equal $rTag \"\"]} {\n"
"set rTag $oldRTag\n"
"}\n"
"}\n"
"if {[string compare $rTag \"\"]} {\n"
"tkIconList_Select $w $rTag\n"
"tkIconList_See $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_LeftRight {w amount} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {[string equal $data(curItem) {}]} {\n"
"set rTag [lindex [lindex $data(list) 0] 2]\n"
"} else {\n"
"set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]\n"
"set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]\n"
"set rTag [lindex [lindex $data(list) $newItem] 2]\n"
"if {[string equal $rTag \"\"]} {\n"
"set rTag $oldRTag\n"
"}\n"
"}\n"
"if {[string compare $rTag \"\"]} {\n"
"tkIconList_Select $w $rTag\n"
"tkIconList_See $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_KeyPress {w key} {\n"
"global tkPriv\n"
"append tkPriv(ILAccel,$w) $key\n"
"tkIconList_Goto $w $tkPriv(ILAccel,$w)\n"
"catch {\n"
"after cancel $tkPriv(ILAccel,$w,afterId)\n"
"}\n"
"set tkPriv(ILAccel,$w,afterId) [after 500 [list tkIconList_Reset $w]]\n"
"}\n"
"proc tkIconList_Goto {w text} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:textList textList\n"
"global tkPriv\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {[string equal {} $text]} {\n"
"return\n"
"}\n"
"if {$data(curItem) == \"\" || $data(curItem) == 0} {\n"
"set start  0\n"
"} else {\n"
"set start  $data(curItem)\n"
"}\n"
"set text [string tolower $text]\n"
"set theIndex -1\n"
"set less 0\n"
"set len [string length $text]\n"
"set len0 [expr {$len-1}]\n"
"set i $start\n"
"while {1} {\n"
"set sub [string range $textList($i) 0 $len0]\n"
"if {[string equal $text $sub]} {\n"
"set theIndex $i\n"
"break\n"
"}\n"
"incr i\n"
"if {$i == $data(numItems)} {\n"
"set i 0\n"
"}\n"
"if {$i == $start} {\n"
"break\n"
"}\n"
"}\n"
"if {$theIndex > -1} {\n"
"set rTag [lindex [lindex $data(list) $theIndex] 2]\n"
"tkIconList_Select $w $rTag\n"
"tkIconList_See $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_Reset {w} {\n"
"global tkPriv\n"
"catch {unset tkPriv(ILAccel,$w)}\n"
"}\n"
"namespace eval ::tk::dialog {}\n"
"namespace eval ::tk::dialog::file {}\n"
"proc ::tk::dialog::file::tkFDialog {type args} {\n"
"global tkPriv\n"
"set dataName __tk_filedialog\n"
"upvar ::tk::dialog::file::$dataName data\n"
"::tk::dialog::file::Config $dataName $type $args\n"
"if {[string equal $data(-parent) .]} {\n"
"set w .$dataName\n"
"} else {\n"
"set w $data(-parent).$dataName\n"
"}\n"
"if {![winfo exists $w]} {\n"
"::tk::dialog::file::Create $w TkFDialog\n"
"} elseif {[string compare [winfo class $w] TkFDialog]} {\n"
"destroy $w\n"
"::tk::dialog::file::Create $w TkFDialog\n"
"} else {\n"
"set data(dirMenuBtn) $w.f1.menu\n"
"set data(dirMenu) $w.f1.menu.menu\n"
"set data(upBtn) $w.f1.up\n"
"set data(icons) $w.icons\n"
"set data(ent) $w.f2.ent\n"
"set data(typeMenuLab) $w.f3.lab\n"
"set data(typeMenuBtn) $w.f3.menu\n"
"set data(typeMenu) $data(typeMenuBtn).m\n"
"set data(okBtn) $w.f2.ok\n"
"set data(cancelBtn) $w.f3.cancel\n"
"}\n"
"wm transient $w $data(-parent)\n"
"trace variable data(selectPath) w \"::tk::dialog::file::SetPath $w\"\n"
"$data(dirMenuBtn) configure \\\n"
"\011    -textvariable ::tk::dialog::file::${dataName}(selectPath)\n"
"if {[llength $data(-filetypes)]} {\n"
"$data(typeMenu) delete 0 end\n"
"foreach type $data(-filetypes) {\n"
"set title  [lindex $type 0]\n"
"set filter [lindex $type 1]\n"
"$data(typeMenu) add command -label $title \\\n"
"\011\011-command [list ::tk::dialog::file::SetFilter $w $type]\n"
"}\n"
"::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]\n"
"$data(typeMenuBtn) config -state normal\n"
"$data(typeMenuLab) config -state normal\n"
"} else {\n"
"set data(filter) \"*\"\n"
"$data(typeMenuBtn) config -state disabled -takefocus 0\n"
"$data(typeMenuLab) config -state disabled\n"
"}\n"
"::tk::dialog::file::UpdateWhenIdle $w\n"
"::tk::PlaceWindow $w widget $data(-parent)\n"
"wm title $w $data(-title)\n"
"::tk::SetFocusGrab $w $data(ent)\n"
"$data(ent) delete 0 end\n"
"$data(ent) insert 0 $data(selectFile)\n"
"$data(ent) selection range 0 end\n"
"$data(ent) icursor end\n"
"tkwait variable tkPriv(selectFilePath)\n"
"::tk::RestoreFocusGrab $w $data(ent) withdraw\n"
"foreach trace [trace vinfo data(selectPath)] {\n"
"trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]\n"
"}\n"
"$data(dirMenuBtn) configure -textvariable {}\n"
"return $tkPriv(selectFilePath)\n"
"}\n"
"proc ::tk::dialog::file::Config {dataName type argList} {\n"
"upvar ::tk::dialog::file::$dataName data\n"
"set data(type) $type\n"
"foreach trace [trace vinfo data(selectPath)] {\n"
"trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]\n"
"}\n"
"set specs {\n"
"{-defaultextension \"\" \"\" \"\"}\n"
"{-filetypes \"\" \"\" \"\"}\n"
"{-initialdir \"\" \"\" \"\"}\n"
"{-initialfile \"\" \"\" \"\"}\n"
"{-parent \"\" \"\" \".\"}\n"
"{-title \"\" \"\" \"\"}\n"
"}\n"
"if {![info exists data(selectPath)]} {\n"
"set data(selectPath) [pwd]\n"
"set data(selectFile) \"\"\n"
"}\n"
"tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n"
"if {$data(-title) == \"\"} {\n"
"if {[string equal $type \"open\"]} {\n"
"set data(-title) \"Open\"\n"
"} else {\n"
"set data(-title) \"Save As\"\n"
"}\n"
"}\n"
"if {$data(-initialdir) != \"\"} {\n"
"if {[file isdirectory $data(-initialdir)]} {\n"
"set old [pwd]\n"
"cd $data(-initialdir)\n"
"set data(selectPath) [pwd]\n"
"cd $old\n"
"} else {\n"
"set data(selectPath) [pwd]\n"
"}\n"
"}\n"
"set data(selectFile) $data(-initialfile)\n"
"set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]\n"
"if {![winfo exists $data(-parent)]} {\n"
"error \"bad window path name \\\"$data(-parent)\\\"\"\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::Create {w class} {\n"
"set dataName [lindex [split $w .] end]\n"
"upvar ::tk::dialog::file::$dataName data\n"
"global tk_library tkPriv\n"
"toplevel $w -class $class\n"
"set f1 [frame $w.f1]\n"
"label $f1.lab -text \"Directory:\" -under 0\n"
"set data(dirMenuBtn) $f1.menu\n"
"set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] \"\"]\n"
"set data(upBtn) [button $f1.up]\n"
"if {![info exists tkPriv(updirImage)]} {\n"
"set tkPriv(updirImage) [image create bitmap -data {\n"
"#define updir_width 28\n"
"#define updir_height 16\n"
"static char updir_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,\n"
"0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,\n"
"0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,\n"
"0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,\n"
"0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,\n"
"0xf0, 0xff, 0xff, 0x01};}]\n"
"}\n"
"$data(upBtn) config -image $tkPriv(updirImage)\n"
"$f1.menu config -takefocus 1 -highlightthickness 2\n"
"pack $data(upBtn) -side right -padx 4 -fill both\n"
"pack $f1.lab -side left -padx 4 -fill both\n"
"pack $f1.menu -expand yes -fill both -padx 4\n"
"if { [string equal $class TkFDialog] } {\n"
"set fNameCaption \"File name:\"\n"
"set fNameUnder 5\n"
"set iconListCommand [list ::tk::dialog::file::OkCmd $w]\n"
"} else {\n"
"set fNameCaption \"Selection:\"\n"
"set fNameUnder 0\n"
"set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]\n"
"}\n"
"set data(icons) [tkIconList $w.icons \\\n"
"\011-browsecmd [list ::tk::dialog::file::ListBrowse $w] \\\n"
"\011-command   $iconListCommand]\n"
"set f2 [frame $w.f2 -bd 0]\n"
"label $f2.lab -text $fNameCaption -anchor e -width 14 \\\n"
"\011    -under $fNameUnder -pady 0\n"
"set data(ent) [entry $f2.ent]\n"
"global $w.icons\n"
"set $w.icons(font) [$data(ent) cget -font]\n"
"set f3 [frame $w.f3 -bd 0]\n"
"if { [string equal $class TkFDialog] } {\n"
"set data(typeMenuLab) [button $f3.lab -text \"Files of type:\" \\\n"
"\011\011-anchor e -width 14 -under 9 \\\n"
"\011\011-bd [$f2.lab cget -bd] \\\n"
"\011\011-highlightthickness [$f2.lab cget -highlightthickness] \\\n"
"\011\011-relief [$f2.lab cget -relief] \\\n"
"\011\011-padx [$f2.lab cget -padx] \\\n"
"\011\011-pady [$f2.lab cget -pady]]\n"
"bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \\\n"
"\011\011[winfo toplevel $data(typeMenuLab)] all]\n"
"set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 \\\n"
"\011\011-menu $f3.menu.m]\n"
"set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]\n"
"$data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \\\n"
"\011\011-relief raised -bd 2 -anchor w\n"
"}\n"
"set data(okBtn)     [button $f2.ok     -text OK     -under 0 -width 6 \\\n"
"\011-default active -pady 3]\n"
"set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\\\n"
"\011-default normal -pady 3]\n"
"pack $data(okBtn) -side right -padx 4 -anchor e\n"
"pack $f2.lab -side left -padx 4\n"
"pack $f2.ent -expand yes -fill x -padx 2 -pady 0\n"
"pack $data(cancelBtn) -side right -padx 4 -anchor w\n"
"if { [string equal $class TkFDialog] } {\n"
"pack $data(typeMenuLab) -side left -padx 4\n"
"pack $data(typeMenuBtn) -expand yes -fill x -side right\n"
"}\n"
"pack $f1 -side top -fill x -pady 4\n"
"pack $f3 -side bottom -fill x\n"
"pack $f2 -side bottom -fill x\n"
"pack $data(icons) -expand yes -fill both -padx 4 -pady 1\n"
"wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]\n"
"$data(upBtn)     config -command [list ::tk::dialog::file::UpDirCmd $w]\n"
"$data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w]\n"
"bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]\n"
"bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]\n"
"bind $w <Alt-d> [list focus $data(dirMenuBtn)]\n"
"if { [string equal $class TkFDialog] } {\n"
"bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]\n"
"$data(okBtn)     config -command [list ::tk::dialog::file::OkCmd $w]\n"
"bind $w <Alt-t> [format {\n"
"if {[string equal [%s cget -state] \"normal\"]} {\n"
"focus %s\n"
"}\n"
"} $data(typeMenuBtn) $data(typeMenuBtn)]\n"
"bind $w <Alt-n> [list focus $data(ent)]\n"
"bind $w <Alt-o> [list ::tk::dialog::file::InvokeBtn $w Open]\n"
"bind $w <Alt-s> [list ::tk::dialog::file::InvokeBtn $w Save]\n"
"} else {\n"
"set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]\n"
"bind $data(ent) <Return> $okCmd\n"
"$data(okBtn) config -command $okCmd\n"
"bind $w <Alt-s> [list focus $data(ent)]\n"
"bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]\n"
"}\n"
"tkFocusGroup_Create $w\n"
"tkFocusGroup_BindIn $w  $data(ent) [list ::tk::dialog::file::EntFocusIn $w]\n"
"tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]\n"
"}\n"
"proc ::tk::dialog::file::UpdateWhenIdle {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[info exists data(updateId)]} {\n"
"return\n"
"} else {\n"
"set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::Update {w} {\n"
"if {![winfo exists $w]} {\n"
"return\n"
"}\n"
"set class [winfo class $w]\n"
"if { [string compare $class TkFDialog] && \\\n"
"\011    [string compare $class TkChooseDir] } {\n"
"return\n"
"}\n"
"set dataName [winfo name $w]\n"
"upvar ::tk::dialog::file::$dataName data\n"
"global tk_library tkPriv\n"
"catch {unset data(updateId)}\n"
"if {![info exists tkPriv(folderImage)]} {\n"
"set tkPriv(folderImage) [image create photo -data {\n"
"R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB\n"
"QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]\n"
"set tkPriv(fileImage)   [image create photo -data {\n"
"R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO\n"
"rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]\n"
"}\n"
"set folder $tkPriv(folderImage)\n"
"set file   $tkPriv(fileImage)\n"
"set appPWD [pwd]\n"
"if {[catch {\n"
"cd $data(selectPath)\n"
"}]} {\n"
"tk_messageBox -type ok -parent $w -message \\\n"
"\011    \"Cannot change to the directory \\\"$data(selectPath)\\\".\\nPermission denied.\"\\\n"
"\011    -icon warning\n"
"cd $appPWD\n"
"return\n"
"}\n"
"set entCursor [$data(ent) cget -cursor]\n"
"set dlgCursor [$w         cget -cursor]\n"
"$data(ent) config -cursor watch\n"
"$w         config -cursor watch\n"
"update idletasks\n"
"tkIconList_DeleteAll $data(icons)\n"
"foreach f [lsort -dictionary [glob -nocomplain .* *]] {\n"
"if {[string equal $f .]} {\n"
"continue\n"
"}\n"
"if {[string equal $f ..]} {\n"
"continue\n"
"}\n"
"if {[file isdir ./$f]} {\n"
"if {![info exists hasDoneDir($f)]} {\n"
"tkIconList_Add $data(icons) $folder $f\n"
"set hasDoneDir($f) 1\n"
"}\n"
"}\n"
"}\n"
"if { [string equal $class TkFDialog] } {\n"
"if {[string equal $data(filter) *]} {\n"
"set files [lsort -dictionary \\\n"
"\011\011    [glob -nocomplain .* *]]\n"
"} else {\n"
"set files [lsort -dictionary \\\n"
"\011\011    [eval glob -nocomplain $data(filter)]]\n"
"}\n"
"foreach f $files {\n"
"if {![file isdir ./$f]} {\n"
"if {![info exists hasDoneFile($f)]} {\n"
"tkIconList_Add $data(icons) $file $f\n"
"set hasDoneFile($f) 1\n"
"}\n"
"}\n"
"}\n"
"}\n"
"tkIconList_Arrange $data(icons)\n"
"set list \"\"\n"
"set dir \"\"\n"
"foreach subdir [file split $data(selectPath)] {\n"
"set dir [file join $dir $subdir]\n"
"lappend list $dir\n"
"}\n"
"$data(dirMenu) delete 0 end\n"
"set var [format %s(selectPath) ::tk::dialog::file::$dataName]\n"
"foreach path $list {\n"
"$data(dirMenu) add command -label $path -command [list set $var $path]\n"
"}\n"
"cd $appPWD\n"
"if { [string equal $class TkFDialog] } {\n"
"if {[string equal $data(type) open]} {\n"
"$data(okBtn) config -text \"Open\"\n"
"} else {\n"
"$data(okBtn) config -text \"Save\"\n"
"}\n"
"}\n"
"$data(ent) config -cursor $entCursor\n"
"$w         config -cursor $dlgCursor\n"
"}\n"
"proc ::tk::dialog::file::SetPathSilently {w path} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"trace vdelete  data(selectPath) w [list ::tk::dialog::file::SetPath $w]\n"
"set data(selectPath) $path\n"
"trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]\n"
"}\n"
"proc ::tk::dialog::file::SetPath {w name1 name2 op} {\n"
"if {[winfo exists $w]} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"::tk::dialog::file::UpdateWhenIdle $w\n"
"if { [string equal [winfo class $w] TkChooseDir] } {\n"
"$data(ent) delete 0 end\n"
"$data(ent) insert end $data(selectPath)\n"
"}\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::SetFilter {w type} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"upvar \\#0 $data(icons) icons\n"
"set data(filter) [lindex $type 1]\n"
"$data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1\n"
"$icons(sbar) set 0.0 0.0\n"
"::tk::dialog::file::UpdateWhenIdle $w\n"
"}\n"
"proc ::tk::dialog::file::ResolveFile {context text defaultext} {\n"
"set appPWD [pwd]\n"
"set path [::tk::dialog::file::JoinFile $context $text]\n"
"if {![file isdirectory $path] && [string equal [file ext $path] \"\"]} {\n"
"set path \"$path$defaultext\"\n"
"}\n"
"if {[catch {file exists $path}]} {\n"
"return [list ERROR $path \"\"]\n"
"}\n"
"if {[file exists $path]} {\n"
"if {[file isdirectory $path]} {\n"
"if {[catch {cd $path}]} {\n"
"return [list CHDIR $path \"\"]\n"
"}\n"
"set directory [pwd]\n"
"set file \"\"\n"
"set flag OK\n"
"cd $appPWD\n"
"} else {\n"
"if {[catch {cd [file dirname $path]}]} {\n"
"return [list CHDIR [file dirname $path] \"\"]\n"
"}\n"
"set directory [pwd]\n"
"set file [file tail $path]\n"
"set flag OK\n"
"cd $appPWD\n"
"}\n"
"} else {\n"
"set dirname [file dirname $path]\n"
"if {[file exists $dirname]} {\n"
"if {[catch {cd $dirname}]} {\n"
"return [list CHDIR $dirname \"\"]\n"
"}\n"
"set directory [pwd]\n"
"set file [file tail $path]\n"
"if {[regexp {[*]|[?]} $file]} {\n"
"set flag PATTERN\n"
"} else {\n"
"set flag FILE\n"
"}\n"
"cd $appPWD\n"
"} else {\n"
"set directory $dirname\n"
"set file [file tail $path]\n"
"set flag PATH\n"
"}\n"
"}\n"
"return [list $flag $directory $file]\n"
"}\n"
"proc ::tk::dialog::file::EntFocusIn {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string compare [$data(ent) get] \"\"]} {\n"
"$data(ent) selection range 0 end\n"
"$data(ent) icursor end\n"
"} else {\n"
"$data(ent) selection clear\n"
"}\n"
"tkIconList_Unselect $data(icons)\n"
"if { [string equal [winfo class $w] TkFDialog] } {\n"
"if {[string equal $data(type) open]} {\n"
"$data(okBtn) config -text \"Open\"\n"
"} else {\n"
"$data(okBtn) config -text \"Save\"\n"
"}\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::EntFocusOut {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"$data(ent) selection clear\n"
"}\n"
"proc ::tk::dialog::file::ActivateEnt {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"set text [string trim [$data(ent) get]]\n"
"set list [::tk::dialog::file::ResolveFile $data(selectPath) $text \\\n"
"\011\011  $data(-defaultextension)]\n"
"set flag [lindex $list 0]\n"
"set path [lindex $list 1]\n"
"set file [lindex $list 2]\n"
"switch -- $flag {\n"
"OK {\n"
"if {[string equal $file \"\"]} {\n"
"set data(selectPath) $path\n"
"$data(ent) delete 0 end\n"
"} else {\n"
"::tk::dialog::file::SetPathSilently $w $path\n"
"set data(selectFile) $file\n"
"::tk::dialog::file::Done $w\n"
"}\n"
"}\n"
"PATTERN {\n"
"set data(selectPath) $path\n"
"set data(filter) $file\n"
"}\n"
"FILE {\n"
"if {[string equal $data(type) open]} {\n"
"tk_messageBox -icon warning -type ok -parent $w \\\n"
"\011\011    -message \"File \\\"[file join $path $file]\\\" does not exist.\"\n"
"$data(ent) selection range 0 end\n"
"$data(ent) icursor end\n"
"} else {\n"
"::tk::dialog::file::SetPathSilently $w $path\n"
"set data(selectFile) $file\n"
"::tk::dialog::file::Done $w\n"
"}\n"
"}\n"
"PATH {\n"
"tk_messageBox -icon warning -type ok -parent $w \\\n"
"\011\011-message \"Directory \\\"$path\\\" does not exist.\"\n"
"$data(ent) selection range 0 end\n"
"$data(ent) icursor end\n"
"}\n"
"CHDIR {\n"
"tk_messageBox -type ok -parent $w -message \\\n"
"\011       \"Cannot change to the directory \\\"$path\\\".\\nPermission denied.\"\\\n"
"\011\011-icon warning\n"
"$data(ent) selection range 0 end\n"
"$data(ent) icursor end\n"
"}\n"
"ERROR {\n"
"tk_messageBox -type ok -parent $w -message \\\n"
"\011       \"Invalid file name \\\"$path\\\".\"\\\n"
"\011\011-icon warning\n"
"$data(ent) selection range 0 end\n"
"$data(ent) icursor end\n"
"}\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::InvokeBtn {w key} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string equal [$data(okBtn) cget -text] $key]} {\n"
"tkButtonInvoke $data(okBtn)\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::UpDirCmd {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string compare $data(selectPath) \"/\"]} {\n"
"set data(selectPath) [file dirname $data(selectPath)]\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::JoinFile {path file} {\n"
"if {[string match {~*} $file] && [file exists $path/$file]} {\n"
"return [file join $path ./$file]\n"
"} else {\n"
"return [file join $path $file]\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::OkCmd {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"set text [tkIconList_Get $data(icons)]\n"
"if {[string compare $text \"\"]} {\n"
"set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n"
"if {[file isdirectory $file]} {\n"
"::tk::dialog::file::ListInvoke $w $text\n"
"return\n"
"}\n"
"}\n"
"::tk::dialog::file::ActivateEnt $w\n"
"}\n"
"proc ::tk::dialog::file::CancelCmd {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"global tkPriv\n"
"set tkPriv(selectFilePath) \"\"\n"
"}\n"
"proc ::tk::dialog::file::ListBrowse {w text} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string equal $text \"\"]} {\n"
"return\n"
"}\n"
"set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n"
"if {![file isdirectory $file]} {\n"
"$data(ent) delete 0 end\n"
"$data(ent) insert 0 $text\n"
"if { [string equal [winfo class $w] TkFDialog] } {\n"
"if {[string equal $data(type) open]} {\n"
"$data(okBtn) config -text \"Open\"\n"
"} else {\n"
"$data(okBtn) config -text \"Save\"\n"
"}\n"
"}\n"
"} else {\n"
"if { [string equal [winfo class $w] TkFDialog] } {\n"
"$data(okBtn) config -text \"Open\"\n"
"}\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::ListInvoke {w text} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string equal $text \"\"]} {\n"
"return\n"
"}\n"
"set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n"
"set class [winfo class $w]\n"
"if {[string equal $class TkChooseDir] || [file isdirectory $file]} {\n"
"set appPWD [pwd]\n"
"if {[catch {cd $file}]} {\n"
"tk_messageBox -type ok -parent $w -message \\\n"
"\011       \"Cannot change to the directory \\\"$file\\\".\\nPermission denied.\"\\\n"
"\011\011-icon warning\n"
"} else {\n"
"cd $appPWD\n"
"set data(selectPath) $file\n"
"}\n"
"} else {\n"
"set data(selectFile) $file\n"
"::tk::dialog::file::Done $w\n"
"}\n"
"}\n"
"proc ::tk::dialog::file::Done {w {selectFilePath \"\"}} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"global tkPriv\n"
"if {[string equal $selectFilePath \"\"]} {\n"
"set selectFilePath [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
"\011\011$data(selectFile)]\n"
"set tkPriv(selectFile)     $data(selectFile)\n"
"set tkPriv(selectPath)     $data(selectPath)\n"
"if {[file exists $selectFilePath] && [string equal $data(type) save]} {\n"
"set reply [tk_messageBox -icon warning -type yesno\\\n"
"\011\011    -parent $w -message \"File\\\n"
"\011\011    \\\"$selectFilePath\\\" already exists.\\nDo\\\n"
"\011\011    you want to overwrite it?\"]\n"
"if {[string equal $reply \"no\"]} {\n"
"return\n"
"}\n"
"}\n"
"}\n"
"set tkPriv(selectFilePath) $selectFilePath\n"
"}\n"
;
static char Et_zFile30[] = 
"namespace eval ::tk::dialog {}\n"
"namespace eval ::tk::dialog::file {}\n"
"proc tkMotifFDialog {type args} {\n"
"global tkPriv\n"
"set dataName __tk_filedialog\n"
"upvar ::tk::dialog::file::$dataName data\n"
"set w [tkMotifFDialog_Create $dataName $type $args]\n"
"::tk::SetFocusGrab $w $data(sEnt)\n"
"$data(sEnt) selection range 0 end\n"
"tkwait variable tkPriv(selectFilePath)\n"
"::tk::RestoreFocusGrab $w $data(sEnt) withdraw\n"
"return $tkPriv(selectFilePath)\n"
"}\n"
"proc tkMotifFDialog_Create {dataName type argList} {\n"
"global tkPriv\n"
"upvar ::tk::dialog::file::$dataName data\n"
"tkMotifFDialog_Config $dataName $type $argList\n"
"if {[string equal $data(-parent) .]} {\n"
"set w .$dataName\n"
"} else {\n"
"set w $data(-parent).$dataName\n"
"}\n"
"if {![winfo exists $w]} {\n"
"tkMotifFDialog_BuildUI $w\n"
"} elseif {[string compare [winfo class $w] TkMotifFDialog]} {\n"
"destroy $w\n"
"tkMotifFDialog_BuildUI $w\n"
"} else {\n"
"set data(fEnt) $w.top.f1.ent\n"
"set data(dList) $w.top.f2.a.l\n"
"set data(fList) $w.top.f2.b.l\n"
"set data(sEnt) $w.top.f3.ent\n"
"set data(okBtn) $w.bot.ok\n"
"set data(filterBtn) $w.bot.filter\n"
"set data(cancelBtn) $w.bot.cancel\n"
"}\n"
"wm transient $w $data(-parent)\n"
"tkMotifFDialog_Update $w\n"
"::tk::PlaceWindow $w\n"
"wm title $w $data(-title)\n"
"return $w\n"
"}\n"
"proc tkMotifFDialog_Config {dataName type argList} {\n"
"upvar ::tk::dialog::file::$dataName data\n"
"set data(type) $type\n"
"set specs {\n"
"{-defaultextension \"\" \"\" \"\"}\n"
"{-filetypes \"\" \"\" \"\"}\n"
"{-initialdir \"\" \"\" \"\"}\n"
"{-initialfile \"\" \"\" \"\"}\n"
"{-parent \"\" \"\" \".\"}\n"
"{-title \"\" \"\" \"\"}\n"
"}\n"
"if {![info exists data(selectPath)]} {\n"
"set data(selectPath) [pwd]\n"
"set data(selectFile) \"\"\n"
"}\n"
"tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n"
"if {[string equal $data(-title) \"\"]} {\n"
"if {[string equal $type \"open\"]} {\n"
"set data(-title) \"Open\"\n"
"} else {\n"
"set data(-title) \"Save As\"\n"
"}\n"
"}\n"
"if {[string compare $data(-initialdir) \"\"]} {\n"
"if {[file isdirectory $data(-initialdir)]} {\n"
"set data(selectPath) [glob $data(-initialdir)]\n"
"} else {\n"
"set data(selectPath) [pwd]\n"
"}\n"
"set old [pwd]\n"
"cd $data(selectPath)\n"
"set data(selectPath) [pwd]\n"
"cd $old\n"
"}\n"
"set data(selectFile) $data(-initialfile)\n"
"set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]\n"
"if {![info exists data(filter)]} {\n"
"set data(filter) *\n"
"}\n"
"if {![winfo exists $data(-parent)]} {\n"
"error \"bad window path name \\\"$data(-parent)\\\"\"\n"
"}\n"
"}\n"
"proc tkMotifFDialog_BuildUI {w} {\n"
"set dataName [lindex [split $w .] end]\n"
"upvar ::tk::dialog::file::$dataName data\n"
"toplevel $w -class TkMotifFDialog\n"
"set top [frame $w.top -relief raised -bd 1]\n"
"set bot [frame $w.bot -relief raised -bd 1]\n"
"pack $w.bot -side bottom -fill x\n"
"pack $w.top -side top -expand yes -fill both\n"
"set f1 [frame $top.f1]\n"
"set f2 [frame $top.f2]\n"
"set f3 [frame $top.f3]\n"
"pack $f1 -side top    -fill x\n"
"pack $f3 -side bottom -fill x\n"
"pack $f2 -expand yes -fill both\n"
"set f2a [frame $f2.a]\n"
"set f2b [frame $f2.b]\n"
"grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n"
"\011-sticky news\n"
"grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n"
"\011-sticky news\n"
"grid rowconfig $f2 0    -minsize 0   -weight 1\n"
"grid columnconfig $f2 0 -minsize 0   -weight 1\n"
"grid columnconfig $f2 1 -minsize 150 -weight 2\n"
"label $f1.lab -text \"Filter:\" -under 3 -anchor w\n"
"entry $f1.ent\n"
"pack $f1.lab -side top -fill x -padx 6 -pady 4\n"
"pack $f1.ent -side top -fill x -padx 4 -pady 0\n"
"set data(fEnt) $f1.ent\n"
"set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]\n"
"set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files:     2 FList]\n"
"label $f3.lab -text \"Selection:\" -under 0 -anchor w\n"
"entry $f3.ent\n"
"pack $f3.lab -side top -fill x -padx 6 -pady 0\n"
"pack $f3.ent -side top -fill x -padx 4 -pady 4\n"
"set data(sEnt) $f3.ent\n"
"set data(okBtn) [button $bot.ok     -text OK     -width 6 -under 0 \\\n"
"\011-command [list tkMotifFDialog_OkCmd $w]]\n"
"set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \\\n"
"\011-command [list tkMotifFDialog_FilterCmd $w]]\n"
"set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \\\n"
"\011-command [list tkMotifFDialog_CancelCmd $w]]\n"
"pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \\\n"
"\011-side left\n"
"bind $w <Alt-t> [list focus $data(fEnt)]\n"
"bind $w <Alt-d> [list focus $data(dList)]\n"
"bind $w <Alt-l> [list focus $data(fList)]\n"
"bind $w <Alt-s> [list focus $data(sEnt)]\n"
"bind $w <Alt-o> [list tkButtonInvoke $bot.ok]\n"
"bind $w <Alt-f> [list tkButtonInvoke $bot.filter]\n"
"bind $w <Alt-c> [list tkButtonInvoke $bot.cancel]\n"
"bind $data(fEnt) <Return> [list tkMotifFDialog_ActivateFEnt $w]\n"
"bind $data(sEnt) <Return> [list tkMotifFDialog_ActivateSEnt $w]\n"
"wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w]\n"
"}\n"
"proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {\n"
"label $f.lab -text $label -under $under -anchor w\n"
"listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\\\n"
"\011-xscrollcommand [list $f.h set]\011-yscrollcommand [list $f.v set]\n"
"scrollbar $f.v -orient vertical   -takefocus 0 -command [list $f.l yview]\n"
"scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]\n"
"grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \\\n"
"\011-padx 2 -pady 2\n"
"grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news\n"
"grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news\n"
"grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news\n"
"grid rowconfig    $f 0 -weight 0 -minsize 0\n"
"grid rowconfig    $f 1 -weight 1 -minsize 0\n"
"grid columnconfig $f 0 -weight 1 -minsize 0\n"
"set list $f.l\n"
"bind $list <Up>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
"bind $list <Down>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
"bind $list <space>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
"bind $list <1>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
"bind $list <B1-Motion>\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
"bind $list <Double-ButtonRelease-1> \\\n"
"\011    [list tkMotifFDialog_Activate$cmdPrefix $w]\n"
"bind $list <Return>    \"tkMotifFDialog_Browse$cmdPrefix [list $w]; \\\n"
"\011    tkMotifFDialog_Activate$cmdPrefix [list $w]\"\n"
"bindtags $list [list Listbox $list [winfo toplevel $list] all]\n"
"tkListBoxKeyAccel_Set $list\n"
"return $f.l\n"
"}\n"
"proc tkMotifFDialog_InterpFilter {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"set text [string trim [$data(fEnt) get]]\n"
"set badTilde 0\n"
"if {[string equal [string index $text 0] ~]} {\n"
"set list [file split $text]\n"
"set tilde [lindex $list 0]\n"
"if {[catch {set tilde [glob $tilde]}]} {\n"
"set badTilde 1\n"
"} else {\n"
"set text [eval file join [concat $tilde [lrange $list 1 end]]]\n"
"}\n"
"}\n"
"set relative 0\n"
"if {[string equal [file pathtype $text] \"relative\"]} {\n"
"set relative 1\n"
"} elseif {$badTilde} {\n"
"set relative 1\011\n"
"}\n"
"if {$relative} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"\011    -message \"\\\"$text\\\" must be an absolute pathname\"\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
"\011\011$data(filter)]\n"
"return [list $data(selectPath) $data(filter)]\n"
"}\n"
"set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]\n"
"if {[file isdirectory $resolved]} {\n"
"set dir $resolved\n"
"set fil $data(filter)\n"
"} else {\n"
"set dir [file dirname $resolved]\n"
"set fil [file tail    $resolved]\n"
"}\n"
"return [list $dir $fil]\n"
"}\n"
"proc tkMotifFDialog_Update {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n"
"$data(sEnt) delete 0 end\n"
"$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
"\011    $data(selectFile)]\n"
"tkMotifFDialog_LoadFiles $w\n"
"}\n"
"proc tkMotifFDialog_LoadFiles {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"$data(dList) delete 0 end\n"
"$data(fList) delete 0 end\n"
"set appPWD [pwd]\n"
"if {[catch {cd $data(selectPath)}]} {\n"
"cd $appPWD\n"
"$data(dList) insert end \"..\"\n"
"return\n"
"}\n"
"foreach f [lsort -dictionary [glob -nocomplain .* *]] {\n"
"if {[file isdir ./$f]} {\n"
"$data(dList) insert end $f\n"
"}\n"
"}\n"
"if {[string equal $data(filter) *]} {\n"
"set files [lsort -dictionary [glob -nocomplain .* *]]\n"
"} else {\n"
"set files [lsort -dictionary \\\n"
"\011    [glob -nocomplain $data(filter)]]\n"
"}\n"
"set top 0\n"
"foreach f $files {\n"
"if {![file isdir ./$f]} {\n"
"regsub {^[.]/} $f \"\" f\n"
"$data(fList) insert end $f\n"
"if {[string match .* $f]} {\n"
"incr top\n"
"}\n"
"}\n"
"}\n"
"$data(fList) yview $top\n"
"cd $appPWD\n"
"}\n"
"proc tkMotifFDialog_BrowseDList {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"focus $data(dList)\n"
"if {[string equal [$data(dList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set subdir [$data(dList) get [$data(dList) curselection]]\n"
"if {[string equal $subdir \"\"]} {\n"
"return\n"
"}\n"
"$data(fList) selection clear 0 end\n"
"set list [tkMotifFDialog_InterpFilter $w]\n"
"set data(filter) [lindex $list 1]\n"
"switch -- $subdir {\n"
". {\n"
"set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n"
"}\n"
".. {\n"
"set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \\\n"
"\011\011$data(filter)]\n"
"}\n"
"default {\n"
"set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \\\n"
"\011\011    $data(selectPath) $subdir] $data(filter)]\n"
"}\n"
"}\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 $newSpec\n"
"}\n"
"proc tkMotifFDialog_ActivateDList {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string equal [$data(dList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set subdir [$data(dList) get [$data(dList) curselection]]\n"
"if {[string equal $subdir \"\"]} {\n"
"return\n"
"}\n"
"$data(fList) selection clear 0 end\n"
"switch -- $subdir {\n"
". {\n"
"set newDir $data(selectPath)\n"
"}\n"
".. {\n"
"set newDir [file dirname $data(selectPath)]\n"
"}\n"
"default {\n"
"set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]\n"
"}\n"
"}\n"
"set data(selectPath) $newDir\n"
"tkMotifFDialog_Update $w\n"
"if {[string compare $subdir ..]} {\n"
"$data(dList) selection set 0\n"
"$data(dList) activate 0\n"
"} else {\n"
"$data(dList) selection set 1\n"
"$data(dList) activate 1\n"
"}\n"
"}\n"
"proc tkMotifFDialog_BrowseFList {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"focus $data(fList)\n"
"if {[string equal [$data(fList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n"
"if {[string equal $data(selectFile) \"\"]} {\n"
"return\n"
"}\n"
"$data(dList) selection clear 0 end\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n"
"$data(fEnt) xview end\n"
"$data(sEnt) delete 0 end\n"
"$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
"\011    $data(selectFile)]\n"
"$data(sEnt) xview end\n"
"}\n"
"proc tkMotifFDialog_ActivateFList {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"if {[string equal [$data(fList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n"
"if {[string equal $data(selectFile) \"\"]} {\n"
"return\n"
"} else {\n"
"tkMotifFDialog_ActivateSEnt $w\n"
"}\n"
"}\n"
"proc tkMotifFDialog_ActivateFEnt {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"set list [tkMotifFDialog_InterpFilter $w]\n"
"set data(selectPath) [lindex $list 0]\n"
"set data(filter)    [lindex $list 1]\n"
"tkMotifFDialog_Update $w\n"
"}\n"
"proc tkMotifFDialog_ActivateSEnt {w} {\n"
"global tkPriv\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"set selectFilePath [string trim [$data(sEnt) get]]\n"
"set selectFile     [file tail    $selectFilePath]\n"
"set selectPath     [file dirname $selectFilePath]\n"
"if {[string equal $selectFilePath \"\"]} {\n"
"tkMotifFDialog_FilterCmd $w\n"
"return\n"
"}\n"
"if {[file isdirectory $selectFilePath]} {\n"
"set data(selectPath) [glob $selectFilePath]\n"
"set data(selectFile) \"\"\n"
"tkMotifFDialog_Update $w\n"
"return\n"
"}\n"
"if {[string compare [file pathtype $selectFilePath] \"absolute\"]} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"\011    -message \"\\\"$selectFilePath\\\" must be an absolute pathname\"\n"
"return\n"
"}\n"
"if {![file exists $selectPath]} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"\011    -message \"Directory \\\"$selectPath\\\" does not exist.\"\n"
"return\n"
"}\n"
"if {![file exists $selectFilePath]} {\n"
"if {[string equal $data(type) open]} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"\011\011-message \"File \\\"$selectFilePath\\\" does not exist.\"\n"
"return\n"
"}\n"
"} else {\n"
"if {[string equal $data(type) save]} {\n"
"set message [format %s%s \\\n"
"\011\011\"File \\\"$selectFilePath\\\" already exists.\\n\\n\" \\\n"
"\011\011\"Replace existing file?\"]\n"
"set answer [tk_messageBox -icon warning -type yesno \\\n"
"\011\011-message $message]\n"
"if {[string equal $answer \"no\"]} {\n"
"return\n"
"}\n"
"}\n"
"}\n"
"set tkPriv(selectFilePath) $selectFilePath\n"
"set tkPriv(selectFile)     $selectFile\n"
"set tkPriv(selectPath)     $selectPath\n"
"}\n"
"proc tkMotifFDialog_OkCmd {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"tkMotifFDialog_ActivateSEnt $w\n"
"}\n"
"proc tkMotifFDialog_FilterCmd {w} {\n"
"upvar ::tk::dialog::file::[winfo name $w] data\n"
"tkMotifFDialog_ActivateFEnt $w\n"
"}\n"
"proc tkMotifFDialog_CancelCmd {w} {\n"
"global tkPriv\n"
"set tkPriv(selectFilePath) \"\"\n"
"set tkPriv(selectFile)     \"\"\n"
"set tkPriv(selectPath)     \"\"\n"
"}\n"
"proc tkListBoxKeyAccel_Set {w} {\n"
"bind Listbox <Any-KeyPress> \"\"\n"
"bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w]\n"
"bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A]\n"
"}\n"
"proc tkListBoxKeyAccel_Unset {w} {\n"
"global tkPriv\n"
"catch {after cancel $tkPriv(lbAccel,$w,afterId)}\n"
"catch {unset tkPriv(lbAccel,$w)}\n"
"catch {unset tkPriv(lbAccel,$w,afterId)}\n"
"}\n"
"proc tkListBoxKeyAccel_Key {w key} {\n"
"global tkPriv\n"
"append tkPriv(lbAccel,$w) $key\n"
"tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)\n"
"catch {\n"
"after cancel $tkPriv(lbAccel,$w,afterId)\n"
"}\n"
"set tkPriv(lbAccel,$w,afterId) [after 500 \\\n"
"\011    [list tkListBoxKeyAccel_Reset $w]]\n"
"}\n"
"proc tkListBoxKeyAccel_Goto {w string} {\n"
"global tkPriv\n"
"set string [string tolower $string]\n"
"set end [$w index end]\n"
"set theIndex -1\n"
"for {set i 0} {$i < $end} {incr i} {\n"
"set item [string tolower [$w get $i]]\n"
"if {[string compare $string $item] >= 0} {\n"
"set theIndex $i\n"
"}\n"
"if {[string compare $string $item] <= 0} {\n"
"set theIndex $i\n"
"break\n"
"}\n"
"}\n"
"if {$theIndex >= 0} {\n"
"$w selection clear 0 end\n"
"$w selection set $theIndex $theIndex\n"
"$w activate $theIndex\n"
"$w see $theIndex\n"
"}\n"
"}\n"
"proc tkListBoxKeyAccel_Reset {w} {\n"
"global tkPriv\n"
"catch {unset tkPriv(lbAccel,$w)}\n"
"}\n"
;
struct EtFile {
  char *zName;
  char *zData;
  int nData;
  int shrouded;
  struct EtFile *pNext;
};
static struct EtFile Et_FileSet[] = {
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/auto.tcl", Et_zFile0, sizeof(Et_zFile0)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/history.tcl", Et_zFile1, sizeof(Et_zFile1)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/init.tcl", Et_zFile2, sizeof(Et_zFile2)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/package.tcl", Et_zFile3, sizeof(Et_zFile3)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/parray.tcl", Et_zFile4, sizeof(Et_zFile4)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/safe.tcl", Et_zFile5, sizeof(Et_zFile5)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/tclIndex", Et_zFile6, sizeof(Et_zFile6)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tcl8.3/word.tcl", Et_zFile7, sizeof(Et_zFile7)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/bgerror.tcl", Et_zFile8, sizeof(Et_zFile8)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/button.tcl", Et_zFile9, sizeof(Et_zFile9)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/clrpick.tcl", Et_zFile10, sizeof(Et_zFile10)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/comdlg.tcl", Et_zFile11, sizeof(Et_zFile11)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/console.tcl", Et_zFile12, sizeof(Et_zFile12)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/dialog.tcl", Et_zFile13, sizeof(Et_zFile13)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/entry.tcl", Et_zFile14, sizeof(Et_zFile14)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/focus.tcl", Et_zFile15, sizeof(Et_zFile15)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/listbox.tcl", Et_zFile16, sizeof(Et_zFile16)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/menu.tcl", Et_zFile17, sizeof(Et_zFile17)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/msgbox.tcl", Et_zFile18, sizeof(Et_zFile18)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/obsolete.tcl", Et_zFile19, sizeof(Et_zFile19)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/optMenu.tcl", Et_zFile20, sizeof(Et_zFile20)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/palette.tcl", Et_zFile21, sizeof(Et_zFile21)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/safetk.tcl", Et_zFile22, sizeof(Et_zFile22)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/scale.tcl", Et_zFile23, sizeof(Et_zFile23)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/scrlbar.tcl", Et_zFile24, sizeof(Et_zFile24)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/tclIndex", Et_zFile25, sizeof(Et_zFile25)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/tearoff.tcl", Et_zFile26, sizeof(Et_zFile26)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/text.tcl", Et_zFile27, sizeof(Et_zFile27)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/tk.tcl", Et_zFile28, sizeof(Et_zFile28)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/tkfbox.tcl", Et_zFile29, sizeof(Et_zFile29)-1, 0, 0 },
  { "C:/PROGRAM FILES/TCL/lib/tk8.3/xmfbox.tcl", Et_zFile30, sizeof(Et_zFile30)-1, 0, 0 },
{0, 0}};
static struct EtFile *Et_FileHashTable[71];
/* The following copyright notice applies to code generated by
** "mktclapp".  The "mktclapp" program itself is covered by the
** GNU Public License.
**
** Copyright (c) 1998 D. Richard Hipp
**
** The author hereby grants permission to use, copy, modify, distribute,
** and license this software and its documentation for any purpose, provided
** that existing copyright notices are retained in all copies and that this
** notice is included verbatim in any distributions. No written agreement,
** license, or royalty fee is required for any of the authorized uses.
** Modifications to this software may be copyrighted by their authors
** and need not follow the licensing terms described here, provided that
** the new terms are clearly indicated on the first page of each file where
** they apply.
**
** In no event shall the author or the distributors be liable to any party
** for direct, indirect, special, incidental, or consequential damages
** arising out of the use of this software, its documentation, or any
** derivatives thereof, even if the author has been advised of the 
** possibility of such damage.  The author and distributors specifically
** disclaim any warranties, including but not limited to the implied
** warranties of merchantability, fitness for a particular purpose, and
** non-infringment.  This software is provided at no fee on an
** "as is" basis.  The author and/or distritutors have no obligation
** to provide maintenance, support, updates, enhancements and/or
** modifications.
**
** GOVERNMENT USE: If you are acquiring this software on behalf of the
** U.S. government, the Government shall have only "Restricted Rights"
** in the software and related documentation as defined in the Federal 
** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
** are acquiring the software on behalf of the Department of Defense, the
** software shall be classified as "Commercial Computer Software" and the
** Government shall have only "Restricted Rights" as defined in Clause
** 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
** author grants the U.S. Government and others acting in its behalf
** permission to use and distribute the software in accordance with the
** terms specified in this license. 
*/
#include <ctype.h>
#include <string.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>

/* Include either the Tcl or the Tk header file.  Use the "Internal"
** version of the header file if and only if we are generating an
** extension  that is linking against the Stub library.
** Many installations do not have the internal header files
** available, so using the internal headers only when absolutely
** necessary will help to reduce compilation problems.
*/
#if ET_EXTENSION && defined(TCL_USE_STUBS)
# if ET_ENABLE_TK
#   include <tkInt.h>
# else
#   include <tclInt.h>
# endif
#else
# if ET_ENABLE_TK
#   include <tk.h>
# else
#   include <tcl.h>
# endif
#endif

/*
** ET_WIN32 is true if we are running Tk under windows.  The
** <tcl.h> module will define __WIN32__ for us if we are compiling
** for windows.
*/
#if defined(__WIN32__) && ET_ENABLE_TK
# define ET_WIN32 1
# include <windows.h>
#else
# define ET_WIN32 0
#endif

/*
** Always disable ET_AUTO_FORK under windows.  Windows doesn't
** fork well.
*/
#if defined(__WIN32__)
# undef ET_AUTO_FORK
# define ET_AUTO_FORK 0
#endif

/*
** Omit <unistd.h> under windows.  But we need it for Unix.
*/
#if !defined(__WIN32__)
# include <unistd.h>
#endif

/*
** The Tcl*InsertProc functions allow the system calls "stat",
** "access" and "open" to be overloaded.  This in turns allows us
** to substituted compiled-in strings for files in the filesystem.
** But the Tcl*InsertProc functions are only available in Tcl8.0.3
** and later.
**
** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing
** with Tcl8.0.3 or later.
*/
#if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 || TCL_RELEASE_SERIAL>=3)
# define ET_HAVE_INSERTPROC
#endif

/*
** If we are using the Tcl*InsertProc() functions, we should provide
** prototypes for them.  But the prototypes are in the tclInt.h include
** file, which we don't want to require the user to have on hand.  So
** we provide our own prototypes here.
**
** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required
** anyway, so these prototypes are not included if TCL_USE_STUBS is
** defined.  
*/
#if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS)
#ifdef __cplusplus
  extern "C" int TclStatInsertProc(int (*)(char*, struct stat *));
  extern "C" int TclAccessInsertProc(int (*)(char*, int));
  extern "C" int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
                                                          char*,int));
#else
  extern int TclStatInsertProc(int (*)(char*, struct stat *));
  extern int TclAccessInsertProc(int (*)(char*, int));
  extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
                                                          char*,int));
#endif
#endif


/*
** Don't allow Win32 applications to read from stdin.  Nor
** programs that automatically go into the background.  Force
** the use of a console in these cases.
*/
#if (ET_WIN32 || ET_AUTO_FORK) && ET_READ_STDIN
# undef ET_READ_STDIN
# undef ET_CONSOLE
# define ET_READ_STDIN 0
# define ET_CONSOLE 1
#endif

/*
** The console won't work without Tk.
*/
#if ET_ENABLE_TK==0 && ET_CONSOLE
# undef ET_CONSOLE
# define ET_CONSOLE 0
# undef ET_READ_STDIN
# define ET_READ_STDIN 1
#endif

/*
** We MUST start using Tcl_GetStringResult() in Tcl8.3
** But these functions didn't exists in Tcl 7.6.  So make
** them macros.
*/
#if TCL_MAJOR_VERSION<8
# define Tcl_GetStringResult(I)  ((I)->result)
#endif

/*
** Set ET_HAVE_OBJ to true if we are able to link against the
** new Tcl_Obj interface.  This is only the case for Tcl version
** 8.0 and later.
*/
#if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8
# define ET_HAVE_OBJ 1
#else
# define ET_HAVE_OBJ 0
#endif

/*
** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1
** and later.  Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X
*/
#if ET_HAVE_OBJ && TCL_MINOR_VERSION==0
# define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj
#endif

/*
** Tcl code to implement the console.
**
** This code is written and tested separately, then run through
** "mktclapp -stringify" and then pasted in here.
*/
#if ET_ENABLE_TK && !ET_EXTENSION
static char zEtConsole[] =
"proc console:create {w prompt title} {\n"
"upvar #0 $w.t v\n"
"if {[winfo exists $w]} {destroy $w}\n"
"if {[info exists v]} {unset v}\n"
"toplevel $w\n"
"wm title $w $title\n"
"wm iconname $w $title\n"
"frame $w.mb -bd 2 -relief raised\n"
"pack $w.mb -side top -fill x\n"
"menubutton $w.mb.file -text File -menu $w.mb.file.m\n"
"menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\n"
"pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\n"
"set m [menu $w.mb.file.m]\n"
"$m add command -label {Source...} -command \"console:SourceFile $w.t\"\n"
"$m add command -label {Save As...} -command \"console:SaveFile $w.t\"\n"
"$m add separator\n"
"$m add command -label {Close} -command \"destroy $w\"\n"
"$m add command -label {Exit} -command exit\n"
"set m [menu $w.mb.edit.m]\n"
"$m add command -label Cut -command \"console:Cut $w.t\"\n"
"$m add command -label Copy -command \"console:Copy $w.t\"\n"
"$m add command -label Paste -command \"console:Paste $w.t\"\n"
"$m add command -label {Clear Screen} -command \"console:Clear $w.t\"\n"
"catch {$m config -postcommand \"console:EnableEditMenu $w\"}\n"
"scrollbar $w.sb -orient vertical -command \"$w.t yview\"\n"
"pack $w.sb -side right -fill y\n"
"text $w.t -font fixed -yscrollcommand \"$w.sb set\"\n"
"pack $w.t -side right -fill both -expand 1\n"
"bindtags $w.t Console\n"
"set v(text) $w.t\n"
"set v(history) 0\n"
"set v(historycnt) 0\n"
"set v(current) -1\n"
"set v(prompt) $prompt\n"
"set v(prior) {}\n"
"set v(plength) [string length $v(prompt)]\n"
"set v(x) 0\n"
"set v(y) 0\n"
"$w.t mark set insert end\n"
"$w.t tag config ok -foreground blue\n"
"$w.t tag config err -foreground red\n"
"$w.t insert end $v(prompt)\n"
"$w.t mark set out 1.0\n"
"catch {rename puts console:oldputs$w}\n"
"proc puts args [format {\n"
"if {![winfo exists %s]} {\n"
"rename puts {}\n"
"rename console:oldputs%s puts\n"
"return [uplevel #0 puts $args]\n"
"}\n"
"switch -glob -- \"[llength $args] $args\" {\n"
"{1 *} {\n"
"set msg [lindex $args 0]\\n\n"
"set tag ok\n"
"}\n"
"{2 stdout *} {\n"
"set msg [lindex $args 1]\\n\n"
"set tag ok\n"
"}\n"
"{2 stderr *} {\n"
"set msg [lindex $args 1]\\n\n"
"set tag err\n"
"}\n"
"{2 -nonewline *} {\n"
"set msg [lindex $args 1]\n"
"set tag ok\n"
"}\n"
"{3 -nonewline stdout *} {\n"
"set msg [lindex $args 2]\n"
"set tag ok\n"
"}\n"
"{3 -nonewline stderr *} {\n"
"set msg [lindex $args 2]\n"
"set tag err\n"
"}\n"
"default {\n"
"uplevel #0 console:oldputs%s $args\n"
"return\n"
"}\n"
"}\n"
"console:Puts %s $msg $tag\n"
"} $w $w $w $w.t]\n"
"after idle \"focus $w.t\"\n"
"}\n"
"bind Console <1> {console:Button1 %W %x %y}\n"
"bind Console <B1-Motion> {console:B1Motion %W %x %y}\n"
"bind Console <B1-Leave> {console:B1Leave %W %x %y}\n"
"bind Console <B1-Enter> {console:cancelMotor %W}\n"
"bind Console <ButtonRelease-1> {console:cancelMotor %W}\n"
"bind Console <KeyPress> {console:Insert %W %A}\n"
"bind Console <Left> {console:Left %W}\n"
"bind Console <Control-b> {console:Left %W}\n"
"bind Console <Right> {console:Right %W}\n"
"bind Console <Control-f> {console:Right %W}\n"
"bind Console <BackSpace> {console:Backspace %W}\n"
"bind Console <Control-h> {console:Backspace %W}\n"
"bind Console <Delete> {console:Delete %W}\n"
"bind Console <Control-d> {console:Delete %W}\n"
"bind Console <Home> {console:Home %W}\n"
"bind Console <Control-a> {console:Home %W}\n"
"bind Console <End> {console:End %W}\n"
"bind Console <Control-e> {console:End %W}\n"
"bind Console <Return> {console:Enter %W}\n"
"bind Console <KP_Enter> {console:Enter %W}\n"
"bind Console <Up> {console:Prior %W}\n"
"bind Console <Control-p> {console:Prior %W}\n"
"bind Console <Down> {console:Next %W}\n"
"bind Console <Control-n> {console:Next %W}\n"
"bind Console <Control-k> {console:EraseEOL %W}\n"
"bind Console <<Cut>> {console:Cut %W}\n"
"bind Console <<Copy>> {console:Copy %W}\n"
"bind Console <<Paste>> {console:Paste %W}\n"
"bind Console <<Clear>> {console:Clear %W}\n"
"proc console:Puts {w t tag} {\n"
"set nc [string length $t]\n"
"set endc [string index $t [expr $nc-1]]\n"
"if {$endc==\"\\n\"} {\n"
"if {[$w index out]<[$w index {insert linestart}]} {\n"
"$w insert out [string range $t 0 [expr $nc-2]] $tag\n"
"$w mark set out {out linestart +1 lines}\n"
"} else {\n"
"$w insert out $t $tag\n"
"}\n"
"} else {\n"
"if {[$w index out]<[$w index {insert linestart}]} {\n"
"$w insert out $t $tag\n"
"} else {\n"
"$w insert out $t\\n $tag\n"
"$w mark set out {out -1 char}\n"
"}\n"
"}\n"
"$w yview insert\n"
"}\n"
"proc console:Insert {w a} {\n"
"$w insert insert $a\n"
"$w yview insert\n"
"}\n"
"proc console:Left {w} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"if {$col>$v(plength)} {\n"
"$w mark set insert \"insert -1c\"\n"
"}\n"
"}\n"
"proc console:Backspace {w} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"if {$col>$v(plength)} {\n"
"$w delete {insert -1c}\n"
"}\n"
"}\n"
"proc console:EraseEOL {w} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"if {$col>=$v(plength)} {\n"
"$w delete insert {insert lineend}\n"
"}\n"
"}\n"
"proc console:Right {w} {\n"
"$w mark set insert \"insert +1c\"\n"
"}\n"
"proc console:Delete w {\n"
"$w delete insert\n"
"}\n"
"proc console:Home w {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"$w mark set insert $row.$v(plength)\n"
"}\n"
"proc console:End w {\n"
"$w mark set insert {insert lineend}\n"
"}\n"
"proc console:Enter w {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"set start $row.$v(plength)\n"
"set line [$w get $start \"$start lineend\"]\n"
"if {$v(historycnt)>0} {\n"
"set last [lindex $v(history) [expr $v(historycnt)-1]]\n"
"if {[string compare $last $line]} {\n"
"lappend v(history) $line\n"
"incr v(historycnt)\n"
"}\n"
"} else {\n"
"set v(history) [list $line]\n"
"set v(historycnt) 1\n"
"}\n"
"set v(current) $v(historycnt)\n"
"$w insert end \\n\n"
"$w mark set out end\n"
"if {$v(prior)==\"\"} {\n"
"set cmd $line\n"
"} else {\n"
"set cmd $v(prior)\\n$line\n"
"}\n"
"if {[info complete $cmd]} {\n"
"set rc [catch {uplevel #0 $cmd} res]\n"
"if {![winfo exists $w]} return\n"
"if {$rc} {\n"
"$w insert end $res\\n err\n"
"} elseif {[string length $res]>0} {\n"
"$w insert end $res\\n ok\n"
"}\n"
"set v(prior) {}\n"
"$w insert end $v(prompt)\n"
"} else {\n"
"set v(prior) $cmd\n"
"regsub -all {[^ ]} $v(prompt) . x\n"
"$w insert end $x\n"
"}\n"
"$w mark set insert end\n"
"$w mark set out {insert linestart}\n"
"$w yview insert\n"
"}\n"
"proc console:Prior w {\n"
"upvar #0 $w v\n"
"if {$v(current)<=0} return\n"
"incr v(current) -1\n"
"set line [lindex $v(history) $v(current)]\n"
"console:SetLine $w $line\n"
"}\n"
"proc console:Next w {\n"
"upvar #0 $w v\n"
"if {$v(current)>=$v(historycnt)} return\n"
"incr v(current) 1\n"
"set line [lindex $v(history) $v(current)]\n"
"console:SetLine $w $line\n"
"}\n"
"proc console:SetLine {w line} {\n"
"upvar #0 $w v\n"
"scan [$w index insert] %d.%d row col\n"
"set start $row.$v(plength)\n"
"$w delete $start end\n"
"$w insert end $line\n"
"$w mark set insert end\n"
"$w yview insert\n"
"}\n"
"proc console:Button1 {w x y} {\n"
"global tkPriv\n"
"upvar #0 $w v\n"
"set v(mouseMoved) 0\n"
"set v(pressX) $x\n"
"set p [console:nearestBoundry $w $x $y]\n"
"scan [$w index insert] %d.%d ix iy\n"
"scan $p %d.%d px py\n"
"if {$px==$ix} {\n"
"$w mark set insert $p\n"
"}\n"
"$w mark set anchor $p\n"
"focus $w\n"
"}\n"
"proc console:nearestBoundry {w x y} {\n"
"set p [$w index @$x,$y]\n"
"set bb [$w bbox $p]\n"
"if {![string compare $bb \"\"]} {return $p}\n"
"if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\n"
"$w index \"$p + 1 char\"\n"
"}\n"
"proc console:SelectTo {w x y} {\n"
"upvar #0 $w v\n"
"set cur [console:nearestBoundry $w $x $y]\n"
"if {[catch {$w index anchor}]} {\n"
"$w mark set anchor $cur\n"
"}\n"
"set anchor [$w index anchor]\n"
"if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {\n"
"if {$v(mouseMoved)==0} {\n"
"$w tag remove sel 0.0 end\n"
"}\n"
"set v(mouseMoved) 1\n"
"}\n"
"if {[$w compare $cur < anchor]} {\n"
"set first $cur\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $cur\n"
"}\n"
"if {$v(mouseMoved)} {\n"
"$w tag remove sel 0.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"update idletasks\n"
"}\n"
"}\n"
"proc console:B1Motion {w x y} {\n"
"upvar #0 $w v\n"
"set v(y) $y\n"
"set v(x) $x\n"
"console:SelectTo $w $x $y\n"
"}\n"
"proc console:B1Leave {w x y} {\n"
"upvar #0 $w v\n"
"set v(y) $y\n"
"set v(x) $x\n"
"console:motor $w\n"
"}\n"
"proc console:motor w {\n"
"upvar #0 $w v\n"
"if {![winfo exists $w]} return\n"
"if {$v(y)>=[winfo height $w]} {\n"
"$w yview scroll 1 units\n"
"} elseif {$v(y)<0} {\n"
"$w yview scroll -1 units\n"
"} else {\n"
"return\n"
"}\n"
"console:SelectTo $w $v(x) $v(y)\n"
"set v(timer) [after 50 console:motor $w]\n"
"}\n"
"proc console:cancelMotor w {\n"
"upvar #0 $w v\n"
"catch {after cancel $v(timer)}\n"
"catch {unset v(timer)}\n"
"}\n"
"proc console:Copy w {\n"
"if {![catch {set text [$w get sel.first sel.last]}]} {\n"
"clipboard clear -displayof $w\n"
"clipboard append -displayof $w $text\n"
"}\n"
"}\n"
"proc console:canCut w {\n"
"set r [catch {\n"
"scan [$w index sel.first] %d.%d s1x s1y\n"
"scan [$w index sel.last] %d.%d s2x s2y\n"
"scan [$w index insert] %d.%d ix iy\n"
"}]\n"
"if {$r==1} {return 0}\n"
"if {$s1x==$ix && $s2x==$ix} {return 1}\n"
"return 2\n"
"}\n"
"proc console:Cut w {\n"
"if {[console:canCut $w]==1} {\n"
"console:Copy $w\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"proc console:Paste w {\n"
"if {[console:canCut $w]==1} {\n"
"$w delete sel.first sel.last\n"
"}\n"
"if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\n"
"return\n"
"}\n"
"set prior 0\n"
"foreach line [split $topaste \\n] {\n"
"if {$prior} {\n"
"console:Enter $w\n"
"update\n"
"}\n"
"set prior 1\n"
"$w insert insert $line\n"
"}\n"
"}\n"
"proc console:EnableEditMenu w {\n"
"set m $w.mb.edit.m\n"
"switch [console:canCut $w.t] {\n"
"0 {\n"
"$m entryconf Copy -state disabled\n"
"$m entryconf Cut -state disabled\n"
"}\n"
"1 {\n"
"$m entryconf Copy -state normal\n"
"$m entryconf Cut -state normal\n"
"}\n"
"2 {\n"
"$m entryconf Copy -state normal\n"
"$m entryconf Cut -state disabled\n"
"}\n"
"}\n"
"}\n"
"proc console:SourceFile w {\n"
"set types {\n"
"{{TCL Scripts}  {.tcl}}\n"
"{{All Files}    *}\n"
"}\n"
"set f [tk_getOpenFile -filetypes $types -title \"TCL Script To Source...\"]\n"
"if {$f!=\"\"} {\n"
"uplevel #0 source $f\n"
"}\n"
"}\n"
"proc console:SaveFile w {\n"
"set types {\n"
"{{Text Files}  {.txt}}\n"
"{{All Files}    *}\n"
"}\n"
"set f [tk_getSaveFile -filetypes $types -title \"Write Screen To...\"]\n"
"if {$f!=\"\"} {\n"
"if {[catch {open $f w} fd]} {\n"
"tk_messageBox -type ok -icon error -message $fd\n"
"} else {\n"
"puts $fd [string trimright [$w get 1.0 end] \\n]\n"
"close $fd\n"
"}\n"
"}\n"
"}\n"
"proc console:Clear w {\n"
"$w delete 1.0 {insert linestart}\n"
"}\n"
;  /* End of the console code */
#endif /* ET_ENABLE_TK */

/*
** The "printf" code that follows dates from the 1980's.  It is in
** the public domain.  The original comments are included here for
** completeness.  They are slightly out-of-date.
**
** The following modules is an enhanced replacement for the "printf" programs
** found in the standard library.  The following enhancements are
** supported:
**
**      +  Additional functions.  The standard set of "printf" functions
**         includes printf, fprintf, sprintf, vprintf, vfprintf, and
**         vsprintf.  This module adds the following:
**
**           *  snprintf -- Works like sprintf, but has an extra argument
**                          which is the size of the buffer written to.
**
**           *  mprintf --  Similar to sprintf.  Writes output to memory
**                          obtained from malloc.
**
**           *  xprintf --  Calls a function to dispose of output.
**
**           *  nprintf --  No output, but returns the number of characters
**                          that would have been output by printf.
**
**           *  A v- version (ex: vsnprintf) of every function is also
**              supplied.
**
**      +  A few extensions to the formatting notation are supported:
**
**           *  The "=" flag (similar to "-") causes the output to be
**              be centered in the appropriately sized field.
**
**           *  The %b field outputs an integer in binary notation.
**
**           *  The %c field now accepts a precision.  The character output
**              is repeated by the number of times the precision specifies.
**
**           *  The %' field works like %c, but takes as its character the
**              next character of the format string, instead of the next
**              argument.  For example,  printf("%.78'-")  prints 78 minus
**              signs, the same as  printf("%.78c",'-').
**
**      +  When compiled using GCC on a SPARC, this version of printf is
**         faster than the library printf for SUN OS 4.1.
**
**      +  All functions are fully reentrant.
**
*/
/*
** Undefine COMPATIBILITY to make some slight changes in the way things
** work.  I think the changes are an improvement, but they are not
** backwards compatible.
*/
/* #define COMPATIBILITY       / * Compatible with SUN OS 4.1 */

/*
** Characters that need to be escaped inside a TCL string.
*/
static char NeedEsc[] = {
  1,   1,   1,   1,   1,   1,   1,   1, 'b', 't', 'n',   1, 'f', 'r',   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  0,   0, '"',   0, '$',   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0, '[','\\', ']',   0,   0,
  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   1,   0,   1,   0,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
  1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,
};

/*
** Conversion types fall into various categories as defined by the
** following enumeration.
*/
enum et_type {    /* The type of the format field */
   etRADIX,            /* Integer types.  %d, %x, %o, and so forth */
   etFLOAT,            /* Floating point.  %f */
   etEXP,              /* Exponentional notation. %e and %E */
   etGENERIC,          /* Floating or exponential, depending on exponent. %g */
   etSIZE,             /* Return number of characters processed so far. %n */
   etSTRING,           /* Strings. %s */
   etPERCENT,          /* Percent symbol. %% */
   etCHARX,            /* Characters. %c */
   etERROR,            /* Used to indicate no such conversion type */
/* The rest are extensions, not normally found in printf() */
   etCHARLIT,          /* Literal characters.  %' */
   etTCLESCAPE,        /* Strings with special characters escaped.  %q */
   etMEMSTRING,        /* A string which should be deleted after use. %z */
   etORDINAL           /* 1st, 2nd, 3rd and so forth */
};

/*
** Each builtin conversion character (ex: the 'd' in "%d") is described
** by an instance of the following structure
*/
typedef struct et_info {   /* Information about each format field */
  int  fmttype;              /* The format field code letter */
  int  base;                 /* The base for radix conversion */
  char *charset;             /* The character set for conversion */
  int  flag_signed;          /* Is the quantity signed? */
  char *prefix;              /* Prefix on non-zero values in alt format */
  enum et_type type;          /* Conversion paradigm */
} et_info;

/*
** The following table is searched linearly, so it is good to put the
** most frequently used conversion types first.
*/
static et_info fmtinfo[] = {
  { 'd',  10,  "0123456789",       1,    0, etRADIX,      },
  { 's',   0,  0,                  0,    0, etSTRING,     }, 
  { 'q',   0,  0,                  0,    0, etTCLESCAPE,  },
  { 'z',   0,  0,                  0,    0, etMEMSTRING, },
  { 'c',   0,  0,                  0,    0, etCHARX,      },
  { 'o',   8,  "01234567",         0,  "0", etRADIX,      },
  { 'u',  10,  "0123456789",       0,    0, etRADIX,      },
  { 'x',  16,  "0123456789abcdef", 0, "x0", etRADIX,      },
  { 'X',  16,  "0123456789ABCDEF", 0, "X0", etRADIX,      },
  { 'r',  10,  "0123456789",       0,    0, etORDINAL,    },
  { 'f',   0,  0,                  1,    0, etFLOAT,      },
  { 'e',   0,  "e",                1,    0, etEXP,        },
  { 'E',   0,  "E",                1,    0, etEXP,        },
  { 'g',   0,  "e",                1,    0, etGENERIC,    },
  { 'G',   0,  "E",                1,    0, etGENERIC,    },
  { 'i',  10,  "0123456789",       1,    0, etRADIX,      },
  { 'n',   0,  0,                  0,    0, etSIZE,       },
  { '%',   0,  0,                  0,    0, etPERCENT,    },
  { 'b',   2,  "01",               0, "b0", etRADIX,      }, /* Binary */
  { 'p',  10,  "0123456789",       0,    0, etRADIX,      }, /* Pointers */
  { '\'',  0,  0,                  0,    0, etCHARLIT,    }, /* Literal char */
};
#define etNINFO  (sizeof(fmtinfo)/sizeof(fmtinfo[0]))

/*
** If NOFLOATINGPOINT is defined, then none of the floating point
** conversions will work.
*/
#ifndef etNOFLOATINGPOINT
/*
** "*val" is a double such that 0.1 <= *val < 10.0
** Return the ascii code for the leading digit of *val, then
** multiply "*val" by 10.0 to renormalize.
**
** Example:
**     input:     *val = 3.14159
**     output:    *val = 1.4159    function return = '3'
**
** The counter *cnt is incremented each time.  After counter exceeds
** 16 (the number of significant digits in a 64-bit float) '0' is
** always returned.
*/
static int et_getdigit(double *val, int *cnt){
  int digit;
  double d;
  if( (*cnt)++ >= 16 ) return '0';
  digit = (int)*val;
  d = digit;
  digit += '0';
  *val = (*val - d)*10.0;
  return digit;
}
#endif

#define etBUFSIZE 1000  /* Size of the output buffer */

/*
** The root program.  All variations call this core.
**
** INPUTS:
**   func   This is a pointer to a function taking three arguments
**            1. A pointer to anything.  Same as the "arg" parameter.
**            2. A pointer to the list of characters to be output
**               (Note, this list is NOT null terminated.)
**            3. An integer number of characters to be output.
**               (Note: This number might be zero.)
**
**   arg    This is the pointer to anything which will be passed as the
**          first argument to "func".  Use it for whatever you like.
**
**   fmt    This is the format string, as in the usual print.
**
**   ap     This is a pointer to a list of arguments.  Same as in
**          vfprint.
**
** OUTPUTS:
**          The return value is the total number of characters sent to
**          the function "func".  Returns -1 on a error.
**
** Note that the order in which automatic variables are declared below
** seems to make a big difference in determining how fast this beast
** will run.
*/
int vxprintf(
  void (*func)(void*,char*,int),
  void *arg,
  const char *format,
  va_list ap
){
  register const char *fmt; /* The format string. */
  register int c;           /* Next character in the format string */
  register char *bufpt;     /* Pointer to the conversion buffer */
  register int  precision;  /* Precision of the current field */
  register int  length;     /* Length of the field */
  register int  idx;        /* A general purpose loop counter */
  int count;                /* Total number of characters output */
  int width;                /* Width of the current field */
  int flag_leftjustify;     /* True if "-" flag is present */
  int flag_plussign;        /* True if "+" flag is present */
  int flag_blanksign;       /* True if " " flag is present */
  int flag_alternateform;   /* True if "#" flag is present */
  int flag_zeropad;         /* True if field width constant starts with zero */
  int flag_long;            /* True if "l" flag is present */
  int flag_center;          /* True if "=" flag is present */
  unsigned long longvalue;  /* Value for integer types */
  double realvalue;         /* Value for real types */
  et_info *infop;           /* Pointer to the appropriate info structure */
  char buf[etBUFSIZE];      /* Conversion buffer */
  char prefix;              /* Prefix character.  "+" or "-" or " " or '\0'. */
  int  errorflag = 0;       /* True if an error is encountered */
  enum et_type xtype;       /* Conversion paradigm */
  char *zMem;               /* String to be freed */
  char *zExtra;             /* Extra memory used for etTCLESCAPE conversions */
  static char spaces[] = "                                                  "
     "                                                                      ";
#define etSPACESIZE (sizeof(spaces)-1)
#ifndef etNOFLOATINGPOINT
  int  exp;                 /* exponent of real numbers */
  double rounder;           /* Used for rounding floating point values */
  int flag_dp;              /* True if decimal point should be shown */
  int flag_rtz;             /* True if trailing zeros should be removed */
  int flag_exp;             /* True to force display of the exponent */
  int nsd;                  /* Number of significant digits returned */
#endif

  fmt = format;                     /* Put in a register for speed */
  count = length = 0;
  bufpt = 0;
  for(; (c=(*fmt))!=0; ++fmt){
    if( c!='%' ){
      register int amt;
      bufpt = (char *)fmt;
      amt = 1;
      while( (c=(*++fmt))!='%' && c!=0 ) amt++;
      (*func)(arg,bufpt,amt);
      count += amt;
      if( c==0 ) break;
    }
    if( (c=(*++fmt))==0 ){
      errorflag = 1;
      (*func)(arg,"%",1);
      count++;
      break;
    }
    /* Find out what flags are present */
    flag_leftjustify = flag_plussign = flag_blanksign = 
     flag_alternateform = flag_zeropad = flag_center = 0;
    do{
      switch( c ){
        case '-':   flag_leftjustify = 1;     c = 0;   break;
        case '+':   flag_plussign = 1;        c = 0;   break;
        case ' ':   flag_blanksign = 1;       c = 0;   break;
        case '#':   flag_alternateform = 1;   c = 0;   break;
        case '0':   flag_zeropad = 1;         c = 0;   break;
        case '=':   flag_center = 1;          c = 0;   break;
        default:                                       break;
      }
    }while( c==0 && (c=(*++fmt))!=0 );
    if( flag_center ) flag_leftjustify = 0;
    /* Get the field width */
    width = 0;
    if( c=='*' ){
      width = va_arg(ap,int);
      if( width<0 ){
        flag_leftjustify = 1;
        width = -width;
      }
      c = *++fmt;
    }else{
      while( isdigit(c) ){
        width = width*10 + c - '0';
        c = *++fmt;
      }
    }
    if( width > etBUFSIZE-10 ){
      width = etBUFSIZE-10;
    }
    /* Get the precision */
    if( c=='.' ){
      precision = 0;
      c = *++fmt;
      if( c=='*' ){
        precision = va_arg(ap,int);
#ifndef etCOMPATIBILITY
        /* This is sensible, but SUN OS 4.1 doesn't do it. */
        if( precision<0 ) precision = -precision;
#endif
        c = *++fmt;
      }else{
        while( isdigit(c) ){
          precision = precision*10 + c - '0';
          c = *++fmt;
        }
      }
      /* Limit the precision to prevent overflowing buf[] during conversion */
      if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;
    }else{
      precision = -1;
    }
    /* Get the conversion type modifier */
    if( c=='l' ){
      flag_long = 1;
      c = *++fmt;
    }else{
      flag_long = 0;
    }
    /* Fetch the info entry for the field */
    infop = 0;
    for(idx=0; idx<etNINFO; idx++){
      if( c==fmtinfo[idx].fmttype ){
        infop = &fmtinfo[idx];
        break;
      }
    }
    /* No info entry found.  It must be an error. */
    if( infop==0 ){
      xtype = etERROR;
    }else{
      xtype = infop->type;
    }
    zExtra = 0;

    /*
    ** At this point, variables are initialized as follows:
    **
    **   flag_alternateform          TRUE if a '#' is present.
    **   flag_plussign               TRUE if a '+' is present.
    **   flag_leftjustify            TRUE if a '-' is present or if the
    **                               field width was negative.
    **   flag_zeropad                TRUE if the width began with 0.
    **   flag_long                   TRUE if the letter 'l' (ell) prefixed
    **                               the conversion character.
    **   flag_blanksign              TRUE if a ' ' is present.
    **   width                       The specified field width.  This is
    **                               always non-negative.  Zero is the default.
    **   precision                   The specified precision.  The default
    **                               is -1.
    **   xtype                       The class of the conversion.
    **   infop                       Pointer to the appropriate info struct.
    */
    switch( xtype ){
      case etORDINAL:
      case etRADIX:
        if( flag_long )  longvalue = va_arg(ap,long);
	else             longvalue = va_arg(ap,int);
#ifdef etCOMPATIBILITY
        /* For the format %#x, the value zero is printed "0" not "0x0".
        ** I think this is stupid. */
        if( longvalue==0 ) flag_alternateform = 0;
#else
        /* More sensible: turn off the prefix for octal (to prevent "00"),
        ** but leave the prefix for hex. */
        if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;
#endif
        if( infop->flag_signed ){
          if( *(long*)&longvalue<0 ){
            longvalue = -*(long*)&longvalue;
            prefix = '-';
          }else if( flag_plussign )  prefix = '+';
          else if( flag_blanksign )  prefix = ' ';
          else                       prefix = 0;
        }else                        prefix = 0;
        if( flag_zeropad && precision<width-(prefix!=0) ){
          precision = width-(prefix!=0);
	}
        bufpt = &buf[etBUFSIZE];
        if( xtype==etORDINAL ){
          long a,b;
          a = longvalue%10;
          b = longvalue%100;
          bufpt -= 2;
          if( a==0 || a>3 || (b>10 && b<14) ){
            bufpt[0] = 't';
            bufpt[1] = 'h';
          }else if( a==1 ){
            bufpt[0] = 's';
            bufpt[1] = 't';
          }else if( a==2 ){
            bufpt[0] = 'n';
            bufpt[1] = 'd';
          }else if( a==3 ){
            bufpt[0] = 'r';
            bufpt[1] = 'd';
          }
        }
        {
          register char *cset;      /* Use registers for speed */
          register int base;
          cset = infop->charset;
          base = infop->base;
          do{                                           /* Convert to ascii */
            *(--bufpt) = cset[longvalue%base];
            longvalue = longvalue/base;
          }while( longvalue>0 );
	}
        length = (long)&buf[etBUFSIZE]-(long)bufpt;
        for(idx=precision-length; idx>0; idx--){
          *(--bufpt) = '0';                             /* Zero pad */
	}
        if( prefix ) *(--bufpt) = prefix;               /* Add sign */
        if( flag_alternateform && infop->prefix ){      /* Add "0" or "0x" */
          char *pre, x;
          pre = infop->prefix;
          if( *bufpt!=pre[0] ){
            for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x;
	  }
        }
        length = (long)&buf[etBUFSIZE]-(long)bufpt;
        break;
      case etFLOAT:
      case etEXP:
      case etGENERIC:
        realvalue = va_arg(ap,double);
#ifndef etNOFLOATINGPOINT
        if( precision<0 ) precision = 6;         /* Set default precision */
        if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;
        if( realvalue<0.0 ){
          realvalue = -realvalue;
          prefix = '-';
	}else{
          if( flag_plussign )          prefix = '+';
          else if( flag_blanksign )    prefix = ' ';
          else                         prefix = 0;
	}
        if( infop->type==etGENERIC && precision>0 ) precision--;
        rounder = 0.0;
#ifdef COMPATIBILITY
        /* Rounding works like BSD when the constant 0.4999 is used.  Wierd! */
        for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);
#else
        /* It makes more sense to use 0.5 */
        for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);
#endif
        if( infop->type==etFLOAT ) realvalue += rounder;
        /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */
        exp = 0;
        if( realvalue>0.0 ){
          int k = 0;
          while( realvalue>=1e8 && k++<100 ){ realvalue *= 1e-8; exp+=8; }
          while( realvalue>=10.0 && k++<100 ){ realvalue *= 0.1; exp++; }
          while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; }
          while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; }
          if( k>=100 ){
            bufpt = "NaN";
            length = 3;
            break;
          }
	}
        bufpt = buf;
        /*
        ** If the field type is etGENERIC, then convert to either etEXP
        ** or etFLOAT, as appropriate.
        */
        flag_exp = xtype==etEXP;
        if( xtype!=etFLOAT ){
          realvalue += rounder;
          if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }
        }
        if( xtype==etGENERIC ){
          flag_rtz = !flag_alternateform;
          if( exp<-4 || exp>precision ){
            xtype = etEXP;
          }else{
            precision = precision - exp;
            xtype = etFLOAT;
          }
	}else{
          flag_rtz = 0;
	}
        /*
        ** The "exp+precision" test causes output to be of type etEXP if
        ** the precision is too large to fit in buf[].
        */
        nsd = 0;
        if( xtype==etFLOAT && exp+precision<etBUFSIZE-30 ){
          flag_dp = (precision>0 || flag_alternateform);
          if( prefix ) *(bufpt++) = prefix;         /* Sign */
          if( exp<0 )  *(bufpt++) = '0';            /* Digits before "." */
          else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);
          if( flag_dp ) *(bufpt++) = '.';           /* The decimal point */
          for(exp++; exp<0 && precision>0; precision--, exp++){
            *(bufpt++) = '0';
          }
          while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
          *(bufpt--) = 0;                           /* Null terminate */
          if( flag_rtz && flag_dp ){     /* Remove trailing zeros and "." */
            while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
            if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
          }
          bufpt++;                            /* point to next free slot */
	}else{    /* etEXP or etGENERIC */
          flag_dp = (precision>0 || flag_alternateform);
          if( prefix ) *(bufpt++) = prefix;   /* Sign */
          *(bufpt++) = et_getdigit(&realvalue,&nsd);  /* First digit */
          if( flag_dp ) *(bufpt++) = '.';     /* Decimal point */
          while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
          bufpt--;                            /* point to last digit */
          if( flag_rtz && flag_dp ){          /* Remove tail zeros */
            while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
            if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
          }
          bufpt++;                            /* point to next free slot */
          if( exp || flag_exp ){
            *(bufpt++) = infop->charset[0];
            if( exp<0 ){ *(bufpt++) = '-'; exp = -exp; } /* sign of exp */
            else       { *(bufpt++) = '+'; }
            if( exp>=100 ){
              *(bufpt++) = (exp/100)+'0';                /* 100's digit */
              exp %= 100;
  	    }
            *(bufpt++) = exp/10+'0';                     /* 10's digit */
            *(bufpt++) = exp%10+'0';                     /* 1's digit */
          }
	}
        /* The converted number is in buf[] and zero terminated. Output it.
        ** Note that the number is in the usual order, not reversed as with
        ** integer conversions. */
        length = (long)bufpt-(long)buf;
        bufpt = buf;

        /* Special case:  Add leading zeros if the flag_zeropad flag is
        ** set and we are not left justified */
        if( flag_zeropad && !flag_leftjustify && length < width){
          int i;
          int nPad = width - length;
          for(i=width; i>=nPad; i--){
            bufpt[i] = bufpt[i-nPad];
          }
          i = prefix!=0;
          while( nPad-- ) bufpt[i++] = '0';
          length = width;
        }
#endif
        break;
      case etSIZE:
        *(va_arg(ap,int*)) = count;
        length = width = 0;
        break;
      case etPERCENT:
        buf[0] = '%';
        bufpt = buf;
        length = 1;
        break;
      case etCHARLIT:
      case etCHARX:
        c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt);
        if( precision>=0 ){
          for(idx=1; idx<precision; idx++) buf[idx] = c;
          length = precision;
	}else{
          length =1;
	}
        bufpt = buf;
        break;
      case etSTRING:
      case etMEMSTRING:
        zMem = bufpt = va_arg(ap,char*);
        if( bufpt==0 ) bufpt = "(null)";
        length = strlen(bufpt);
        if( precision>=0 && precision<length ) length = precision;
        break;
      case etTCLESCAPE:
        {
          int i, j, n, c, k;
          char *arg = va_arg(ap,char*);
          if( arg==0 ) arg = "(NULL)";
          for(i=n=0; (c=arg[i])!=0; i++){
            k = NeedEsc[c&0xff];
            if( k==0 ){
              n++;
            }else if( k==1 ){
              n+=4;
            }else{
              n+=2;
            }
          }
          n++;
          if( n>etBUFSIZE ){
            bufpt = zExtra = Tcl_Alloc( n );
          }else{
            bufpt = buf;
          }
          for(i=j=0; (c=arg[i])!=0; i++){
            k = NeedEsc[c&0xff];
            if( k==0 ){
              bufpt[j++] = c;
            }else if( k==1 ){
              bufpt[j++] = '\\';
              bufpt[j++] = ((c>>6) & 3) + '0';
              bufpt[j++] = ((c>>3) & 7) + '0';
              bufpt[j++] = (c & 7) + '0';
            }else{
              bufpt[j++] = '\\';
              bufpt[j++] = k;
            }
          }
          bufpt[j] = 0;
          length = j;
          if( precision>=0 && precision<length ) length = precision;
        }
        break;
      case etERROR:
        buf[0] = '%';
        buf[1] = c;
        errorflag = 0;
        idx = 1+(c!=0);
        (*func)(arg,"%",idx);
        count += idx;
        if( c==0 ) fmt--;
        break;
    }/* End switch over the format type */
    /*
    ** The text of the conversion is pointed to by "bufpt" and is
    ** "length" characters long.  The field width is "width".  Do
    ** the output.
    */
    if( !flag_leftjustify ){
      register int nspace;
      nspace = width-length;
      if( nspace>0 ){
        if( flag_center ){
          nspace = nspace/2;
          width -= nspace;
          flag_leftjustify = 1;
	}
        count += nspace;
        while( nspace>=etSPACESIZE ){
          (*func)(arg,spaces,etSPACESIZE);
          nspace -= etSPACESIZE;
        }
        if( nspace>0 ) (*func)(arg,spaces,nspace);
      }
    }
    if( length>0 ){
      (*func)(arg,bufpt,length);
      count += length;
    }
    if( xtype==etMEMSTRING && zMem ){
      Tcl_Free(zMem);
    }
    if( flag_leftjustify ){
      register int nspace;
      nspace = width-length;
      if( nspace>0 ){
        count += nspace;
        while( nspace>=etSPACESIZE ){
          (*func)(arg,spaces,etSPACESIZE);
          nspace -= etSPACESIZE;
        }
        if( nspace>0 ) (*func)(arg,spaces,nspace);
      }
    }
    if( zExtra ){
      Tcl_Free(zExtra);
    }
  }/* End for loop over the format string */
  return errorflag ? -1 : count;
} /* End of function */

/*
** The following section of code handles the mprintf routine, that
** writes to memory obtained from malloc().
*/

/* This structure is used to store state information about the
** write to memory that is currently in progress.
*/
struct sgMprintf {
  char *zBase;     /* A base allocation */
  char *zText;     /* The string collected so far */
  int  nChar;      /* Length of the string so far */
  int  nAlloc;     /* Amount of space allocated in zText */
};

/* 
** The xprintf callback function. 
**
** This routine add nNewChar characters of text in zNewText to
** the sgMprintf structure pointed to by "arg".
*/
static void mout(void *arg, char *zNewText, int nNewChar){
  struct sgMprintf *pM = (struct sgMprintf*)arg;
  if( pM->nChar + nNewChar + 1 > pM->nAlloc ){
    pM->nAlloc = pM->nChar + nNewChar*2 + 1;
    if( pM->zText==pM->zBase ){
      pM->zText = Tcl_Alloc(pM->nAlloc);
      if( pM->zText && pM->nChar ) memcpy(pM->zText,pM->zBase,pM->nChar);
    }else{
      pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc);
    }
  }
  if( pM->zText ){
    memcpy(&pM->zText[pM->nChar], zNewText, nNewChar);
    pM->nChar += nNewChar;
    pM->zText[pM->nChar] = 0;
  }
}

/*
** mprintf() works like printf(), but allocations memory to hold the
** resulting string and returns a pointer to the allocated memory.
*/
char *mprintf(const char *zFormat, ...){
  va_list ap;
  struct sgMprintf sMprintf;
  char *zNew;
  char zBuf[200];

  sMprintf.nChar = 0;
  sMprintf.nAlloc = sizeof(zBuf);
  sMprintf.zText = zBuf;
  sMprintf.zBase = zBuf;
  va_start(ap,zFormat);
  vxprintf(mout,&sMprintf,zFormat,ap);
  va_end(ap);
  sMprintf.zText[sMprintf.nChar] = 0;
  if( sMprintf.zText==sMprintf.zBase ){
    zNew = Tcl_Alloc( sMprintf.nChar+1 );
    if( zNew ) strcpy(zNew,zBuf);
  }else{
    zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);
  }
  return zNew;
}

/* This is the varargs version of mprintf.  
*/
char *vmprintf(const char *zFormat, va_list ap){
  struct sgMprintf sMprintf;
  char zBuf[200];
  sMprintf.nChar = 0;
  sMprintf.zText = zBuf;
  sMprintf.nAlloc = sizeof(zBuf);
  sMprintf.zBase = zBuf;
  vxprintf(mout,&sMprintf,zFormat,ap);
  sMprintf.zText[sMprintf.nChar] = 0;
  if( sMprintf.zText==sMprintf.zBase ){
    sMprintf.zText = Tcl_Alloc( strlen(zBuf)+1 );
    if( sMprintf.zText ) strcpy(sMprintf.zText,zBuf);
  }else{
    sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);
  }
  return sMprintf.zText;
}

/*
** Add text output to a Tcl_DString.
**
** This routine is called by vxprintf().  It's job is to add
** nNewChar characters of text from zNewText to the Tcl_DString
** that "arg" is pointing to.
*/
static void dstringout(void *arg, char *zNewText, int nNewChar){
  Tcl_DString *str = (Tcl_DString*)arg;
  Tcl_DStringAppend(str,zNewText,nNewChar);
}

/*
** Append formatted output to a DString.
*/
char *Et_DStringAppendF(Tcl_DString *str, const char *zFormat, ...){
  va_list ap;
  va_start(ap,zFormat);
  vxprintf(dstringout,str,zFormat,ap);
  va_end(ap);
  return Tcl_DStringValue(str);
}

/*
** Make this variable true to trace all calls to EvalF
*/
int Et_EvalTrace = 0;

/*
** Eval the results of a string.
*/
int Et_EvalF(Tcl_Interp *interp, const char *zFormat, ...){
  char *zCmd;
  va_list ap;
  int result;
  va_start(ap,zFormat);
  zCmd = vmprintf(zFormat,ap);
  if( Et_EvalTrace ) printf("%s\n",zCmd);
  result = Tcl_Eval(interp,zCmd);
  if( Et_EvalTrace ) printf("%d %s\n",result,Tcl_GetStringResult(interp));
  Tcl_Free(zCmd);
  return result;
}
int Et_GlobalEvalF(Tcl_Interp *interp, const char *zFormat, ...){
  char *zCmd;
  va_list ap;
  int result;
  va_start(ap,zFormat);
  zCmd = vmprintf(zFormat,ap);
  if( Et_EvalTrace ) printf("%s\n",zCmd);
  result = Tcl_GlobalEval(interp,zCmd);
  if( Et_EvalTrace ) printf("%d %s\n",result,Tcl_GetStringResult(interp));
  Tcl_Free(zCmd);
  return result;
}

/*
** Set the result of an interpreter using printf-like arguments.
*/
void Et_ResultF(Tcl_Interp *interp, const char *zFormat, ...){
  Tcl_DString str;
  va_list ap;

  Tcl_DStringInit(&str);
  va_start(ap,zFormat);
  vxprintf(dstringout,&str,zFormat,ap);
  va_end(ap);
  Tcl_DStringResult(interp,&str);  
}

#if ET_HAVE_OBJ
/*
** Append text to a string object.
*/
int Et_AppendObjF(Tcl_Obj *pObj, const char *zFormat, ...){
  va_list ap;
  int rc;

  va_start(ap,zFormat);
  rc = vxprintf((void(*)(void*,char*,int))Tcl_AppendToObj, pObj, zFormat, ap);
  va_end(ap);
  return rc;
}
#endif


#if ET_WIN32
/*
** This array translates all characters into themselves.  Except
** for the \ which gets translated into /.  And all upper-case
** characters are translated into lower case.  This is used for
** hashing and comparing filenames, to work around the Windows
** bug of ignoring filename case and using the wrong separator
** character for directories.
**
** The array is initialized by FilenameHashInit().
**
** We also define a macro ET_TRANS() that actually does
** the character translation.  ET_TRANS() is a no-op under
** unix.
*/
static char charTrans[256];
#define ET_TRANS(X) (charTrans[0xff&(int)(X)])
#else
#define ET_TRANS(X) (X)
#endif

/*
** Hash a filename.  The value returned is appropriate for
** indexing into the Et_FileHashTable[] array.
*/
static int FilenameHash(char *zName){
  int h = 0;
  while( *zName ){
    h = h ^ (h<<5) ^ ET_TRANS(*(zName++));
  }
  if( h<0 ) h = -h;
  return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0]));
}

/*
** Compare two filenames.  Return 0 if they are the same and
** non-zero if they are different.
*/
static int FilenameCmp(char *z1, char *z2){
  int diff;
  while( (diff = ET_TRANS(*z1)-ET_TRANS(*z2))==0 && *z1!=0){
    z1++;
    z2++;
  }
  return diff;
}

/*
** Initialize the file hash table
*/
static void FilenameHashInit(void){
  int i;
#if ET_WIN32
  for(i=0; i<sizeof(charTrans); i++){
    charTrans[i] = i;
  }
  for(i='A'; i<='Z'; i++){
    charTrans[i] = i + 'a' - 'A';
  }
  charTrans['\\'] = '/';
#endif
  for(i=0; i<sizeof(Et_FileSet)/sizeof(Et_FileSet[0]) - 1; i++){
    struct EtFile *p;
    int h;
    p = &Et_FileSet[i];
    h = FilenameHash(p->zName);
    p->pNext = Et_FileHashTable[h];
    Et_FileHashTable[h] = p;
  }
}

/*
** Locate the text of a built-in file given its name.  
** Return 0 if not found.  Return this size of the file (not
** counting the null-terminator) in *pSize if pSize!=NULL.
**
** If deshroud==1 and the file is shrouded, then descramble
** the text.
*/
static char *FindBuiltinFile(char *zName, int deshroud, int *pSize){
  int h;
  struct EtFile *p;

  h = FilenameHash(zName);
  p = Et_FileHashTable[h];
  while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; }
#if ET_SHROUD_KEY>0
  if( p && p->shrouded && deshroud ){
    char *z;
    int xor = ET_SHROUD_KEY;
    for(z=p->zData; *z; z++){
      if( *z>=0x20 ){ *z ^= xor; xor = (xor+1)&0x1f; }
    }
    p->shrouded = 0;
  }
#endif
  if( p && pSize ){
    *pSize = p->nData;
  }
  return p ? p->zData : 0;
}

/*
** Add a new file to the list of built-in files.
**
** This routine makes a copy of zFilename.  But it does NOT make
** a copy of zData.  It just holds a pointer to zData and uses
** that for all file access.  So after calling this routine,
** you should never change zData!
*/
void Et_NewBuiltinFile(
  char *zFilename,  /* Name of the new file */
  char *zData,      /* Data for the new file */
  int nData         /* Number of bytes in the new file */
){
  int h;
  struct EtFile *p;

  p = (struct EtFile*)Tcl_Alloc( sizeof(struct EtFile) + strlen(zFilename) + 1);
  if( p==0 ) return;
  p->zName = (char*)&p[1];
  strcpy(p->zName, zFilename);
  p->zData = zData;
  p->nData = nData;
  p->shrouded = 0;
  h = FilenameHash(zFilename);
  p->pNext = Et_FileHashTable[h];
  Et_FileHashTable[h] = p;
}

/*
** A TCL interface to the Et_NewBuiltinFile function.  For Tcl8.0
** and later, we make this an Obj command so that it can deal with
** binary data.
*/
#if ET_HAVE_OBJ
static int Et_NewBuiltinFileCmd(ET_OBJARGS){
  char *zData, *zNew;
  int nData;
  if( objc!=3 ){
    Tcl_WrongNumArgs(interp, 1, objv, "filename data");
    return TCL_ERROR;
  }
  zData = (char*)Tcl_GetByteArrayFromObj(objv[2], &nData);
  zNew = Tcl_Alloc( nData + 1 );
  if( zNew ){
    memcpy(zNew, zData, nData);
    zNew[nData] = 0;
    Et_NewBuiltinFile(Tcl_GetStringFromObj(objv[1], 0), zNew, nData);
  }
  return TCL_OK;
}
#else
static int Et_NewBuiltinFileCmd(ET_TCLARGS){
  char *zData;
  int nData;
  if( argc!=3 ){
    Et_ResultF(interp,"wrong # args: should be \"%s FILENAME DATA\"", argv[0]);
    return TCL_ERROR;
  }
  nData = strlen(argv[2]) + 1;
  zData = Tcl_Alloc( nData );
  if( zData ){
    strcpy(zData, argv[2]);
    Et_NewBuiltinFile(argv[1], zData, nData);
  }
  return TCL_OK;
}
#endif

/*
** The following section implements the InsertProc functionality.  The
** new InsertProc feature of Tcl8.0.3 and later allows us to overload
** the usual system call commands for file I/O and replace them with
** commands that operate on the built-in files.
*/
#ifdef ET_HAVE_INSERTPROC

/* 
** Each open channel to a built-in file is an instance of the
** following structure.
*/
typedef struct Et_FileStruct {
  char *zData;     /* All of the data */
  int nData;       /* Bytes of data, not counting the null terminator */
  int cursor;      /* How much of the data has been read so far */
} Et_FileStruct;

/*
** Close a previously opened built-in file.
*/
static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){
  Et_FileStruct *p = (Et_FileStruct*)instanceData;
  Tcl_Free((char*)p);
  return 0;
}

/*
** Read from a built-in file.
*/
static int Et_FileInput(
  ClientData instanceData,    /* The file structure */
  char *buf,                  /* Write the data read here */
  int bufSize,                /* Read this much data */
  int *pErrorCode             /* Write the error code here */
){
  Et_FileStruct *p = (Et_FileStruct*)instanceData;
  *pErrorCode = 0;
  if( p->cursor+bufSize>p->nData ){
    bufSize = p->nData - p->cursor;
  }
  memcpy(buf, &p->zData[p->cursor], bufSize);
  p->cursor += bufSize;
  return bufSize;
}

/*
** Writes to a built-in file always return EOF.
*/
static int Et_FileOutput(
  ClientData instanceData,    /* The file structure */
  char *buf,                  /* Read the data from here */
  int toWrite,                /* Write this much data */
  int *pErrorCode             /* Write the error code here */
){
  *pErrorCode = 0;
  return 0;
}

/*
** Move the cursor around within the built-in file.
*/
static int Et_FileSeek(
  ClientData instanceData,    /* The file structure */
  long offset,                /* Offset to seek to */
  int mode,                   /* One of SEEK_CUR, SEEK_SET or SEEK_END */
  int *pErrorCode             /* Write the error code here */
){
  Et_FileStruct *p = (Et_FileStruct*)instanceData;
  switch( mode ){
    case SEEK_CUR:     offset += p->cursor;   break;
    case SEEK_END:     offset += p->nData;    break;
    default:           break;
  }
  if( offset<0 ) offset = 0;
  if( offset>p->nData ) offset = p->nData;
  p->cursor = offset;
  return offset;
}

/*
** The Watch method is a no-op
*/
static void Et_FileWatch(ClientData instanceData, int mask){
}

/*
** The Handle method always returns an error.
*/
static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){
  return TCL_ERROR;
}

/*
** This is the channel type that will access the built-in files.
*/
static Tcl_ChannelType builtinChannelType = {
    "builtin",			/* Type name. */
    NULL,			/* Always non-blocking.*/
    Et_FileClose,		/* Close proc. */
    Et_FileInput,		/* Input proc. */
    Et_FileOutput,		/* Output proc. */
    Et_FileSeek,		/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    Et_FileWatch,		/* Watch for events on console. */
    Et_FileHandle,		/* Get a handle from the device. */
};

/*
** This routine attempts to do an open of a built-in file.
*/
static Tcl_Channel Et_FileOpen(
  Tcl_Interp *interp,     /* The TCL interpreter doing the open */
  char *zFilename,        /* Name of the file to open */
  char *modeString,       /* Mode string for the open (ignored) */
  int permissions         /* Permissions for a newly created file (ignored) */
){
  char *zData;
  Et_FileStruct *p;
  int nData;
  char zName[50];
  Tcl_Channel chan;
  static int count = 1;

  zData = FindBuiltinFile(zFilename, 1, &nData);
  if( zData==0 ) return NULL;
  p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );
  if( p==0 ) return NULL;
  p->zData = zData;
  p->nData = nData;
  p->cursor = 0;
  sprintf(zName,"etbi_%x_%x",((int)Et_FileOpen)>>12,count++);
  chan = Tcl_CreateChannel(&builtinChannelType, zName, 
                           (ClientData)p, TCL_READABLE);
  return chan;
}

/*
** This routine does a stat() system call for a built-in file.
*/
static int Et_FileStat(char *path, struct stat *buf){
  char *zData;
  int nData;

  zData = FindBuiltinFile(path, 0, &nData);
  if( zData==0 ){
    return -1;
  }
  memset(buf, 0, sizeof(*buf));
  buf->st_mode = 0400;
  buf->st_size = nData;
  return 0;
}

/*
** This routien does an access() system call for a built-in file.
*/
static int Et_FileAccess(char *path, int mode){
  char *zData;

  if( mode & 3 ){
    return -1;
  }
  zData = FindBuiltinFile(path, 0, 0);
  if( zData==0 ){
    return -1;
  }
  return 0; 
}
#endif  /* ET_HAVE_INSERTPROC */

/*
** An overloaded version of "source".  First check for the file
** is one of the built-ins.  If it isn't a built-in, then check the
** disk.  But if ET_STANDALONE is set (which corresponds to the
** "Strict" option in the user interface) then never check the disk.
** This gives us a quick way to check for the common error of
** sourcing a file that exists on the development by mistake, 
** and only discovering the mistake when you move the program
** to your customer's machine.
*/
static int Et_Source(ET_TCLARGS){
  char *z;

  if( argc!=2 ){
    Et_ResultF(interp,"wrong # args: should be \"%s FILENAME\"", argv[0]);
    return TCL_ERROR;
  }
  z = FindBuiltinFile(argv[1], 1, 0);
  if( z ){
    int rc;
    rc = Tcl_Eval(interp,z);
    if (rc == TCL_ERROR) {
      char msg[200];
      sprintf(msg, "\n    (file \"%.150s\" line %d)", argv[1],
        interp->errorLine);
      Tcl_AddErrorInfo(interp, msg);
    } else {
      rc = TCL_OK;
    }
    return rc;
  }
#if ET_STANDALONE
  Et_ResultF(interp,"no such file: \"%s\"", argv[1]);
  return TCL_ERROR;
#else
  return Tcl_EvalFile(interp,argv[1]);
#endif
}

#ifndef ET_HAVE_INSERTPROC
/*
** An overloaded version of "file exists".  First check for the file
** in the file table, then go to disk.
**
** We only overload "file exists" if we don't have InsertProc() 
** procedures.  If we do have InsertProc() procedures, they will
** handle this more efficiently.
*/
static int Et_FileExists(ET_TCLARGS){
  int i, rc;
  Tcl_DString str;
  if( argc==3 && strncmp(argv[1],"exis",4)==0 ){
    if( FindBuiltinFile(argv[2], 0, 0)!=0 ){
      Tcl_SetResult(interp, "1", TCL_STATIC);
      return TCL_OK;
    }
  }
  Tcl_DStringInit(&str);
  Tcl_DStringAppendElement(&str,"Et_FileCmd");
  for(i=1; i<argc; i++){
    Tcl_DStringAppendElement(&str, argv[i]);
  }
  rc = Tcl_Eval(interp, Tcl_DStringValue(&str));
  Tcl_DStringFree(&str);
  return rc;
}
#endif

/*
** This is the main Tcl interpreter.  It's a global variable so it
** can be accessed easily from C code.
*/
Tcl_Interp *Et_Interp = 0;


#if ET_WIN32
/*
** Implement the Et_MessageBox command on Windows platforms.  We
** use the MessageBox() function from the Win32 API so that the
** error message will be displayed as a dialog box.  Writing to
** standard error doesn't do anything on windows.
*/
int Et_MessageBox(ET_TCLARGS){
  char *zMsg = "(Empty Message)";
  char *zTitle = "Message...";

  if( argc>1 ){
    zTitle = argv[1];
  }
  if( argc>2 ){
    zMsg = argv[2];
  }
  MessageBox(0, zMsg, zTitle, MB_ICONSTOP | MB_OK);
  return TCL_OK;
}
#endif

/*
** A default implementation for "bgerror"
*/
static char zBgerror[] = 
  "proc Et_Bgerror err {\n"
  "  global errorInfo tk_library\n"
  "  if {[info exists errorInfo]} {\n"
  "    set ei $errorInfo\n"
  "  } else {\n"
  "    set ei {}\n"
  "  }\n"
  "  if {[catch {bgerror $err}]==0} return\n"
  "  if {[string length $ei]>0} {\n"
  "    set err $ei\n"
  "  }\n"
  "  if {[catch {Et_MessageBox {Error} $err}]} {\n"
  "    puts stderr $err\n"
  "  }\n"
  "  exit\n"
  "}\n"
;

/*
** Do the initialization.
**
** This routine is called after the interpreter is created, but
** before Et_PreInit() or Et_AppInit() have been run.
*/
int Et_DoInit(Tcl_Interp *interp){
  extern int Et_PreInit(Tcl_Interp*);
  extern int Et_AppInit(Tcl_Interp*);


  /* Insert our alternative stat(), access() and open() procedures
  ** so that any attempt to work with a file will check our built-in
  ** scripts first.
  */
  TclStatInsertProc(Et_FileStat);
  TclAccessInsertProc(Et_FileAccess);
  TclOpenFileChannelInsertProc(Et_FileOpen);

  /* Initialize the hash-table for built-in scripts
  */
  FilenameHashInit();


  /* Overload the "file" and "source" commands
  */
  Tcl_CreateCommand(interp,"source",Et_Source,0,0);


  /* Define the variable Et_Interp to hold the interpreter.
  ** Not sure if this is ever used.
  */
  Et_Interp = interp;

  /* Not sure if these variables are used.  Need to
  ** research.
  */
  Tcl_SetVar(interp,"tcl_library",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
  Tcl_SetVar(interp,"tcl_libPath",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
  Tcl_SetVar2(interp,"env","TCL_LIBRARY",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);

  
  /* Not sure if these variables are used.  Need to research.
  */
  Tcl_SetVar(interp,"tk_library",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
  Tcl_SetVar2(interp,"env","TK_LIBRARY",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);

  /* Not sure of the purpose of this line.  Need to research.
  */
  Tcl_Eval(interp,zBgerror);


  /* Not sure of the purpose of this line.  Need to research.
  */
  Et_GlobalEvalF(interp,"set dir $tcl_library;source $dir/tclIndex;unset dir");

  /* Unsure of function of following lines.  Need to research.
  */
  Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
  Tcl_SetVar(interp,"et_version",ET_VERSION,TCL_GLOBAL_ONLY);

  return TCL_OK;

  /* Put in a dummy goto, just to keep the compiler happy.  Might want to keep
  ** the code below, just in case.
  */
  goto initerr;

initerr:
  Et_EvalF(interp,"Et_Bgerror \"%q\"", Tcl_GetStringResult(interp));
  return TCL_ERROR;
}


#if ET_EXTENSION
/*
** If the -extension flag is used, then generate code that will be
** turned into a loadable shared library or DLL, not a standalone
** executable.
*/
int ET_EXTENSION_NAME(Tcl_Interp *interp){
  int i;
#ifndef ET_HAVE_INSERTPROC
  Tcl_AppendResult(interp,
       "mktclapp can only generate extensions for Tcl/Tk version "
       "8.0.3 and later. This is version "
       TCL_MAJOR_VERSION "." TCL_MINOR_VERSION "." TCL_RELEASE_SERIAL, 0);
  return TCL_ERROR;
#endif
#ifdef ET_HAVE_INSERTPROC
#ifdef USE_TCL_STUBS
  if( Tcl_InitStubs(interp,"8.0",0)==0 ){
    return TCL_ERROR;
  }
  if( Tk_InitStubs(interp,"8.0",0)==0 ){
    return TCL_ERROR;
  }
#endif
  Et_Interp = interp;
  TclStatInsertProc(Et_FileStat);
  TclAccessInsertProc(Et_FileAccess);
  TclOpenFileChannelInsertProc(Et_FileOpen);
  FilenameHashInit();
  for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){
    Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
  }
#if ET_ENABLE_OBJ
  for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){
    Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
  }
#endif
  Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
  Tcl_SetVar(interp,"et_version",ET_VERSION,TCL_GLOBAL_ONLY);
#if ET_HAVE_APPINIT
  if( Et_AppInit(interp) == TCL_ERROR ){
    return TCL_ERROR;
  }
#endif
#ifdef ET_MAIN_SCRIPT
  if( Et_EvalF(interp,"source \"%q\"", ET_MAIN_SCRIPT)!=TCL_OK ){
    return TCL_ERROR;
  }
#endif
  return TCL_OK;
#endif  /* ET_HAVE_INSERTPROC */
}
int ET_SAFE_EXTENSION_NAME(Tcl_Interp *interp){
  return ET_EXTENSION_NAME(interp);
}
#endif

/* End of appinit.c */