shared_source/tk_base/appinit.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/appinit.c,v 1.6 2002/04/23 06:26:42 dtashley Exp $ */

#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"