/* This code is automatically generated by "mktclapp" */
/* DO NOT EDIT */
#include <tcl.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 1
#define ET_ENABLE_TK 1
#define ET_AUTO_FORK 0
#define ET_STANDALONE 1
#define ET_HAVE_APPINIT 1
#define ET_HAVE_PREINIT 0
#define ET_HAVE_MAIN 0
#define ET_HAVE_CUSTOM_MAINLOOP 0
#define ET_TCL_LIBRARY "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl"
#define ET_TK_LIBRARY "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk"
#define ET_MAIN_SCRIPT "nlv.tcl"
#define ET_SHROUD_KEY 0
#define ET_READ_STDIN 0
#define ET_CONSOLE 0
extern int ET_COMMAND_Exit(ET_TCLARGS);
extern int ET_COMMAND_PrintGnuplot(ET_TCLARGS);
extern int ET_COMMAND_GetAnnotation(ET_TCLARGS);
extern int ET_COMMAND_SLSize(ET_TCLARGS);
extern int ET_COMMAND_SLScanDone(ET_TCLARGS);
extern int ET_COMMAND_SLScanNext(ET_TCLARGS);
extern int ET_COMMAND_SLScanStart(ET_TCLARGS);
extern int ET_COMMAND_SLHighest(ET_TCLARGS);
extern int ET_COMMAND_SkipToNextData(ET_TCLARGS);
extern int ET_COMMAND_ClearAllHighlights(ET_TCLARGS);
extern int ET_COMMAND_SetFilePosSymbols(ET_TCLARGS);
extern int ET_COMMAND_Recolor(ET_TCLARGS);
extern int ET_COMMAND_Decolor(ET_TCLARGS);
extern int ET_COMMAND_TickScale(ET_TCLARGS);
extern int ET_COMMAND_TickLabel(ET_TCLARGS);
extern int ET_COMMAND_YAxisMax(ET_TCLARGS);
extern int ET_COMMAND_ClearCachedLines(ET_TCLARGS);
extern int ET_COMMAND_SetVisibleClients(ET_TCLARGS);
extern int ET_COMMAND_SetGraphSymbols(ET_TCLARGS);
extern int ET_COMMAND_WindowChanged(ET_TCLARGS);
extern int ET_COMMAND_JumpTime(ET_TCLARGS);
extern int ET_COMMAND_GetKeys(ET_TCLARGS);
extern int ET_COMMAND_RemapKeys(ET_TCLARGS);
extern int ET_COMMAND_PlayFile(ET_TCLARGS);
extern int ET_COMMAND_GraphToggleAutoResize(ET_TCLARGS);
extern int ET_COMMAND_GraphFlush(ET_TCLARGS);
extern int ET_COMMAND_PauseFile(ET_TCLARGS);
extern int ET_COMMAND_SlowdownDisplay(ET_TCLARGS);
extern int ET_COMMAND_IndexTime(ET_TCLARGS);
extern int ET_COMMAND_LastReadTime(ET_TCLARGS);
extern int ET_COMMAND_LastFileTime(ET_TCLARGS);
extern int ET_COMMAND_IndexerInit(ET_TCLARGS);
extern int ET_COMMAND_Init(ET_TCLARGS);
static struct {
  char *zName;
  int (*xProc)(ET_TCLARGS);
} Et_CmdSet[] = {
 { "Exit", ET_COMMAND_Exit },
 { "PrintGnuplot", ET_COMMAND_PrintGnuplot },
 { "GetAnnotation", ET_COMMAND_GetAnnotation },
 { "SLSize", ET_COMMAND_SLSize },
 { "SLScanDone", ET_COMMAND_SLScanDone },
 { "SLScanNext", ET_COMMAND_SLScanNext },
 { "SLScanStart", ET_COMMAND_SLScanStart },
 { "SLHighest", ET_COMMAND_SLHighest },
 { "SkipToNextData", ET_COMMAND_SkipToNextData },
 { "ClearAllHighlights", ET_COMMAND_ClearAllHighlights },
 { "SetFilePosSymbols", ET_COMMAND_SetFilePosSymbols },
 { "Recolor", ET_COMMAND_Recolor },
 { "Decolor", ET_COMMAND_Decolor },
 { "TickScale", ET_COMMAND_TickScale },
 { "TickLabel", ET_COMMAND_TickLabel },
 { "YAxisMax", ET_COMMAND_YAxisMax },
 { "ClearCachedLines", ET_COMMAND_ClearCachedLines },
 { "SetVisibleClients", ET_COMMAND_SetVisibleClients },
 { "SetGraphSymbols", ET_COMMAND_SetGraphSymbols },
 { "WindowChanged", ET_COMMAND_WindowChanged },
 { "JumpTime", ET_COMMAND_JumpTime },
 { "GetKeys", ET_COMMAND_GetKeys },
 { "RemapKeys", ET_COMMAND_RemapKeys },
 { "PlayFile", ET_COMMAND_PlayFile },
 { "GraphToggleAutoResize", ET_COMMAND_GraphToggleAutoResize },
 { "GraphFlush", ET_COMMAND_GraphFlush },
 { "PauseFile", ET_COMMAND_PauseFile },
 { "SlowdownDisplay", ET_COMMAND_SlowdownDisplay },
 { "IndexTime", ET_COMMAND_IndexTime },
 { "LastReadTime", ET_COMMAND_LastReadTime },
 { "LastFileTime", ET_COMMAND_LastFileTime },
 { "IndexerInit", ET_COMMAND_IndexerInit },
 { "Init", ET_COMMAND_Init },
{0, 0}};
static struct {
  char *zName;
  int (*xProc)(ET_OBJARGS);
} Et_ObjSet[] = {
{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"
"$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 $fid $index nonewline\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 {$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 $f $index nonewline\n"
"close $f\n"
"cd $oldDir\n"
"} msg]\n"
"if {$error} {\n"
"set code $errorCode\n"
"set info $errorInfo\n"
"catch {close $f}\n"
"cd $oldDir\n"
"error $msg $info $code\n"
"}\n"
"}\n"
"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 {\\1\\\\$\\2} 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 {$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 {[namespace qualifiers $name] == \"\"} {\n"
"return [namespace tail $name]\n"
"} elseif {![string match ::* $name]} {\n"
"return \"::$name\"\n"
"}\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"
"\" \\[list source \\[file join \\$dir [list $scriptFile]\\]\\]\\n\"\n"
"}\n"
"auto_mkindex_parser::hook {\n"
"if {![catch {package require tbcload}]} {\n"
"if {[info commands tbcload::bcproc] == \"\"} {\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"
"\" \\[list source \\[file join \\$dir [list $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 {$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"
"nextid\0110\011\\\n"
"keep\011$keep\011\\\n"
"oldest\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"
"{$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.1\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"
"foreach __dir [list [file dirname [info nameofexecutable]] \\\n"
"[file join [file dirname [file dirname \\\n"
"[info nameofexecutable]]] lib]] {\n"
"if {[lsearch -exact $auto_path $__dir] < 0} {\n"
"lappend auto_path $__dir\n"
"}\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]) && ($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 {$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 {$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 {[info commands exec] == \"\"} {\n"
"set auto_noexec 1\n"
"}\n"
"set errorCode \"\"\n"
"set errorInfo \"\"\n"
"if {[info commands tclLog] == \"\"} {\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"
"return -code $ret -errorcode $errorCode \\\n"
"\"error while autoloading \\\"$name\\\": $msg\"\n"
"}\n"
"if {![array size unknown_pending]} {\n"
"unset unknown_pending\n"
"}\n"
"if {$msg} {\n"
"set errorCode $savedErrorCode\n"
"set errorInfo $savedErrorInfo\n"
"set code [catch {uplevel 1 $args} msg]\n"
"if {$code ==  1} {\n"
"set new [split $errorInfo \\n]\n"
"set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \\n]\n"
"return -code error -errorcode $errorCode \\\n"
"-errorinfo $new $msg\n"
"} else {\n"
"return -code $code $msg\n"
"}\n"
"}\n"
"}\n"
"if {([info level] == 1) && ([info script] == \"\") \\\n"
"&& [info exists tcl_interactive] && $tcl_interactive} {\n"
"if {![info exists auto_noexec]} {\n"
"set new [auto_execok $name]\n"
"if {$new != \"\"} {\n"
"set errorCode $savedErrorCode\n"
"set errorInfo $savedErrorInfo\n"
"set redir \"\"\n"
"if {[info commands console] == \"\"} {\n"
"set redir \">&@stdout <@stdin\"\n"
"}\n"
"return [uplevel exec $redir $new [lrange $args 1 end]]\n"
"}\n"
"}\n"
"set errorCode $savedErrorCode\n"
"set errorInfo $savedErrorInfo\n"
"if {$name == \"!!\"} {\n"
"set newcmd [history event]\n"
"} elseif {[regexp {^!(.+)$} $name dummy event]} {\n"
"set newcmd [history event $event]\n"
"} elseif {[regexp {^\\^([^^]*)\\^([^^]*)\\^?$} $name dummy old new]} {\n"
"set newcmd [history event -1]\n"
"catch {regsub -all -- $old $newcmd $new newcmd}\n"
"}\n"
"if {[info exists newcmd]} {\n"
"tclLog $newcmd\n"
"history change $newcmd 0\n"
"return [uplevel $newcmd]\n"
"}\n"
"set ret [catch {set cmds [info commands $name*]} msg]\n"
"if {[string compare $name \"::\"] == 0} {\n"
"set name \"\"\n"
"}\n"
"if {$ret != 0} {\n"
"return -code $ret -errorcode $errorCode \\\n"
"\"error in unknown while checking if \\\"$name\\\" is a unique command abbreviation: $msg\"\n"
"}\n"
"if {[llength $cmds] == 1} {\n"
"return [uplevel [lreplace $args 0 0 $cmds]]\n"
"}\n"
"if {[llength $cmds] != 0} {\n"
"if {$name == \"\"} {\n"
"return -code error \"empty command name \\\"\\\"\"\n"
"} else {\n"
"return -code error \\\n"
"\"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n"
"}\n"
"}\n"
"}\n"
"return -code error \"invalid command name \\\"$name\\\"\"\n"
"}\n"
"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 {[info commands $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"
"if {$auto_oldpath == $auto_path} {\n"
"return 0\n"
"}\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 {$id == \"# Tcl autoload index file, version 2.0\"} {\n"
"eval [read $f]\n"
"} elseif {$id == \\\n"
"\"# Tcl autoload index file: each line identifies a Tcl\"} {\n"
"while {[gets $f line] >= 0} {\n"
"if {([string index $line 0] == \"#\")\n"
"|| ([llength $line] != 2)} {\n"
"continue\n"
"}\n"
"set name [lindex $line 0]\n"
"set auto_index($name) \\\n"
"\"source [file join $dir [lindex $line 1]]\"\n"
"}\n"
"} else {\n"
"error \\\n"
"\"[file join $dir tclIndex] isn't a proper Tcl index file\"\n"
"}\n"
"} msg]\n"
"if {$f != \"\"} {\n"
"close $f\n"
"}\n"
"if {$error} {\n"
"error $msg $errorInfo $errorCode\n"
"}\n"
"}\n"
"}\n"
"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 compare $namespace ::] == 0} {\n"
"return [list $cmd]\n"
"} else {\n"
"return [list ${namespace}::$cmd $cmd]\n"
"}\n"
"} else {\n"
"if {[string compare $namespace ::] == 0} {\n"
"return [list ::$cmd]\n"
"} else {\n"
"return [list ${namespace}::$cmd ::$cmd]\n"
"}\n"
"}\n"
"}\n"
"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] && \"\" == [info commands $name]} {\n"
"uplevel #0 $auto_index($name)\n"
"}\n"
"}\n"
"}\n"
"}\n"
"if {[string compare $tcl_platform(platform) windows] == 0} {\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"
"if {[lsearch -exact {cls copy date del erase dir echo mkdir md rename \n"
"ren rmdir rd time type ver vol} $name] != -1} {\n"
"return [set auto_execs($name) [list $env(COMSPEC) /c $name]]\n"
"}\n"
"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 {$tcl_platform(os) == \"Windows NT\"} {\n"
"append path \"$windir/system32;\"\n"
"}\n"
"append path \"$windir/system;$windir;\"\n"
"}\n"
"if {[info exists env(PATH)]} {\n"
"append path $env(PATH)\n"
"}\n"
"foreach dir [split $path {;}] {\n"
"if {$dir == \"\"} {\n"
"set dir .\n"
"}\n"
"foreach ext {{} .com .exe .bat} {\n"
"set file [file join $dir ${name}${ext}]\n"
"if {[file exists $file] && ![file isdirectory $file]} {\n"
"return [set auto_execs($name) [list $file]]\n"
"}\n"
"}\n"
"}\n"
"return \"\"\n"
"}\n"
"} 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 {$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[] = 
"proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {\n"
"global env\n"
"global argv\n"
"if {$cc==\"\"} {\n"
"set cc $env(CC)\n"
"}\n"
"if {$shlib_suffix==\"\"} {\n"
"set shlib_cflags $env(SHLIB_CFLAGS)\n"
"} else {\n"
"if {$shlib_cflags==\"none\"} {\n"
"set shlib_cflags $shlib_suffix\n"
"}\n"
"}\n"
"set seenDotO 0\n"
"set minusO 0\n"
"set head {}\n"
"set tail {}\n"
"set nmCommand {|nm -g}\n"
"set entryProtos {}\n"
"set entryPoints {}\n"
"set libraries {}\n"
"set libdirs {}\n"
"foreach a $argv {\n"
"if {!$minusO && [regexp {\\.[ao]$} $a]} {\n"
"set seenDotO 1\n"
"lappend nmCommand $a\n"
"}\n"
"if {$minusO} {\n"
"set outputFile $a\n"
"set minusO 0\n"
"} elseif {![string compare $a -o]} {\n"
"set minusO 1\n"
"}\n"
"if {[regexp {^-[lL]} $a]} {\n"
"lappend libraries $a\n"
"if {[regexp {^-L} $a]} {\n"
"lappend libdirs [string range $a 2 end]\n"
"}\n"
"} elseif {$seenDotO} {\n"
"lappend tail $a\n"
"} else {\n"
"lappend head $a\n"
"}\n"
"}\n"
"lappend libdirs /lib /usr/lib\n"
"set libs {}\n"
"foreach lib $libraries {\n"
"if {[regexp {^-l} $lib]} {\n"
"set lname [string range $lib 2 end]\n"
"foreach dir $libdirs {\n"
"if {[file exists [file join $dir lib${lname}_G0.a]]} {\n"
"set lname ${lname}_G0\n"
"break\n"
"}\n"
"}\n"
"lappend libs -l$lname\n"
"} else {\n"
"lappend libs $lib\n"
"}\n"
"}\n"
"set libraries $libs\n"
"if {![info exists outputFile]} {\n"
"error \"-o option must be supplied to link a Tcl load module\"\n"
"}\n"
"set m [file tail $outputFile]\n"
"if {[regexp {\\.a$} $outputFile]} {\n"
"set shlib_suffix .a\n"
"} else {\n"
"set shlib_suffix \"\"\n"
"}\n"
"if {[regexp {\\..*$} $outputFile match]} {\n"
"set l [expr {[string length $m] - [string length $match]}]\n"
"} else {\n"
"error \"Output file does not appear to have a suffix\"\n"
"}\n"
"set modName [string tolower [string range $m 0 [expr {$l-1}]]]\n"
"if {[regexp {^lib} $modName]} {\n"
"set modName [string range $modName 3 end]\n"
"}\n"
"if {[regexp {[0-9\\.]*(_g0)?$} $modName match]} {\n"
"set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]\n"
"}\n"
"set modName \"[string toupper [string index $modName 0]][string range $modName 1 end]\"\n"
"set f [open $nmCommand r]\n"
"while {[gets $f l] >= 0} {\n"
"if {[regexp {T[ \011]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {\n"
"if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {\n"
"set s $symbol\n"
"}\n"
"append entryProtos {extern int } $symbol { (); } \\n\n"
"append entryPoints {  } \\{ { \"} $s {\", } $symbol { } \\} , \\n\n"
"}\n"
"}\n"
"close $f\n"
"if {$entryPoints==\"\"} {\n"
"error \"No entry point found in objects\"\n"
"}\n"
"set C {#include <string.h>}\n"
"append C \\n\n"
"append C {char TclLoadLibraries_} $modName { [] =} \\n\n"
"append C {  \"@LIBS: } $libraries {\";} \\n\n"
"append C $entryProtos\n"
"append C {static struct } \\{ \\n\n"
"append C {  char * name;} \\n\n"
"append C {  int (*value)();} \\n\n"
"append C \\} {dictionary [] = } \\{ \\n\n"
"append C $entryPoints\n"
"append C {  0, 0 } \\n \\} \\; \\n\n"
"append C {typedef struct Tcl_Interp Tcl_Interp;} \\n\n"
"append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \\n\n"
"append C {Tcl_PackageInitProc *} \\n\n"
"append C TclLoadDictionary_ $modName { (symbol)} \\n\n"
"append C {    char * symbol;} \\n\n"
"append C {{\n"
"int i;\n"
"for (i = 0; dictionary [i] . name != 0; ++i) {\n"
"if (!strcmp (symbol, dictionary [i] . name)) {\n"
"return dictionary [i].value;\n"
"}\n"
"}\n"
"return 0;\n"
"}} \\n\n"
"set cFile tcl$modName.c\n"
"set f [open $cFile w]\n"
"puts -nonewline $f $C\n"
"close $f\n"
"set ccCommand \"$cc -c $shlib_cflags $cFile\"\n"
"puts stderr $ccCommand\n"
"eval exec $ccCommand\n"
"if {$shlib_suffix == \".a\"} {\n"
"set ldCommand \"ar cr $outputFile\"\n"
"regsub { -o} $tail {} tail\n"
"} else {\n"
"set ldCommand ld\n"
"foreach item $head {\n"
"lappend ldCommand $item\n"
"}\n"
"}\n"
"lappend ldCommand tcl$modName.o\n"
"foreach item $tail {\n"
"lappend ldCommand $item\n"
"}\n"
"puts stderr $ldCommand\n"
"eval exec $ldCommand\n"
"if {$shlib_suffix == \".a\"} {\n"
"exec ranlib $outputFile\n"
"}\n"
"exec /bin/rm $cFile [file rootname $cFile].o\n"
"}\n"
;
static char Et_zFile4[] = 
"proc pkg_compareExtension { fileName {ext {}} } {\n"
"global tcl_platform\n"
"if {[string length $ext] == 0} {\n"
"set ext [info sharedlibextension]\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"windows\"] == 0} {\n"
"return [expr {[string compare \\\n"
"[string tolower [file extension $fileName]] \\\n"
"[string tolower $ext]] == 0}]\n"
"} else {\n"
"return [expr {[string compare [file extension $fileName] $ext] == 0}]\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 0\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"
"-direct {\n"
"set direct 1\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"
"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"
"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 compare $file \"pkgIndex.tcl\"] == 0} {\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 {[lindex $pkg 1] == \"Tk\"} {\n"
"$c eval {set argv {-geometry +0+0}}\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"
"} else {\n"
"if {$doVerbose} {\n"
"tclLog \"loaded [lindex $pkg 0] [lindex $pkg 1]\"\n"
"}\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"
"foreach ::tcl::x [::tcl::GetAllNamespaces] {\n"
"if {! [info exists ::tcl::namespaces($::tcl::x)]} {\n"
"namespace import -force ${::tcl::x}::*\n"
"}\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 [auto_qualify $::tcl::abs ::]\n"
"if {[string compare $::tcl::x $::tcl::abs] != 0} {\n"
"set ::tcl::newCmds($::tcl::abs) 1\n"
"unset ::tcl::newCmds($::tcl::x)\n"
"}\n"
"}\n"
"foreach ::tcl::x [package names] {\n"
"if {([string compare [package provide $::tcl::x] \"\"] != 0) \\\n"
"&& ![info exists ::tcl::packages($::tcl::x)]} {\n"
"lappend ::tcl::newPkgs \\\n"
"[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"
"foreach pkg [lsort [array names files]] {\n"
"append index \"\\npackage ifneeded $pkg \"\n"
"if {$direct} {\n"
"set cmdList {}\n"
"foreach elem $files($pkg) {\n"
"set file [lindex $elem 0]\n"
"set type [lindex $elem 1]\n"
"lappend cmdList \"\\[list $type \\[file join \\$dir\\\n"
"[list $file]\\]\\]\"\n"
"}\n"
"append index [join $cmdList \"\\\\n\"]\n"
"} else {\n"
"append index \"\\[list tclPkgSetup \\$dir [lrange $pkg 0 0]\\\n"
"[lrange $pkg 1 1] [list $files($pkg)]\\]\"\n"
"}\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 {$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 {$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"
"for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {\n"
"catch {\n"
"foreach file [glob -nocomplain [file join [lindex $auto_path $i] \\\n"
"* pkgIndex.tcl]] {\n"
"set dir [file dirname $file]\n"
"if {[file readable $file]} {\n"
"if {[catch {source $file} msg]} {\n"
"tclLog \"error reading package index file $file: $msg\"\n"
"}\n"
"}\n"
"}\n"
"}\n"
"set dir [lindex $auto_path $i]\n"
"set file [file join $dir pkgIndex.tcl]\n"
"if {[interp issafe] || [file readable $file]} {\n"
"if {[catch {source $file} msg] && ![interp issafe]}  {\n"
"tclLog \"error reading package index file $file: $msg\"\n"
"}\n"
"}\n"
"if {(![interp issafe]) && ($tcl_platform(platform) == \"macintosh\")} {\n"
"set dir [lindex $auto_path $i]\n"
"tclMacPkgSearch $dir\n"
"foreach x [glob -nocomplain [file join $dir *]] {\n"
"if {[file isdirectory $x]} {\n"
"set dir $x\n"
"tclMacPkgSearch $dir\n"
"}\n"
"}\n"
"}\n"
"}\n"
"}\n"
;
static char Et_zFile5[] = 
"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_zFile6[] = 
"package require opt 0.4.1;\n"
"namespace eval ::safe {\n"
"namespace export interpCreate interpInit interpConfigure interpDelete \\\n"
"interpAddToAccessPath interpFindInAccessPath \\\n"
"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"
"\"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"
"\"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"
"[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 \\\n"
"\"\\\"$slave\\\" is not an interpreter\";\n"
"}\n"
"InterpInit $slave $accessPath \\\n"
"[InterpStatics] [InterpNested] $deleteHook;\n"
"}\n"
"proc CheckInterp {slave} {\n"
"if {![IsInterp $slave]} {\n"
"return -code error \\\n"
"\"\\\"$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"
"\"ambigous query (get or set -noStatics ?)\\\n"
"use -statics instead\";\n"
"}\n"
"-nestedLoadOk {\n"
"return -code error\\\n"
"\"ambigous query (get or set -nestedLoadOk ?)\\\n"
"use -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"
"&& (![::tcl::OptProcArgGiven -noStatics]) } {\n"
"set statics    [Set [StaticsOkName $slave]]\n"
"} else {\n"
"set statics    [InterpStatics]\n"
"}\n"
"if {    ([::tcl::OptProcArgGiven -nested]) \n"
"|| ([::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 \\\n"
"$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"
"nestedok deletehook} {\n"
"if {[string match \"\" $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"
"added it to slave's access_path\" NOTICE;\n"
"} elseif {$where != 0} {\n"
"set access_path [concat [list [info library]]\\\n"
"[lreplace $access_path $where $where]];\n"
"Log $slave \"tcl_libray was not in first in auto_path,\\\n"
"moved 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"
"nestedok=$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"
"$slave\n"
"AliasSubset $slave file file dir.* join root.* ext.* tail \\\n"
"path.* split\n"
"::interp alias $slave exit {} [namespace current]::interpDelete $slave\n"
"if {[catch {::interp eval $slave\\\n"
"{source [file join $tcl_library init.tcl]}}\\\n"
"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"
"&& ([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 \\\n"
"\"auto_path in $slave has been set to $slave_auto_path\"\\\n"
"NOTICE;\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]]) \n"
"&& ([::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"
"[string compare [string tolower [file extension $ftail]]\\\n"
"\".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"
"disabled (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"
"(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"
"$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"
"[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"
"[lrange $args 1 end]]\n"
"}\n"
"if {[string match $subcommand system]} {\n"
"if {$argc == 1} {\n"
"if {[catch {::interp invokehidden \\\n"
"$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_zFile7[] = 
"# 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(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_zFile8[] = 
"if {$tcl_platform(platform) == \"windows\"} {\n"
"set tcl_wordchars \"\\[^ \\t\\n\\]\"\n"
"set tcl_nonwordchars \"\\[ \\t\\n\\]\"\n"
"} else {\n"
"set tcl_wordchars {[a-zA-Z0-9_]}\n"
"set tcl_nonwordchars {[^a-zA-Z0-9_]}\n"
"}\n"
"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 compare $start end] == 0} {\n"
"set start [string length $str]\n"
"}\n"
"if {[regexp -indices \"^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)\" [string range $str 0 $start] result]} {\n"
"return [lindex $result 1]\n"
"}\n"
"return -1\n"
"}\n"
"proc tcl_endOfWord {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[regexp -indices \"$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars\" \\\n"
"[string range $str $start end] result]} {\n"
"return [expr {[lindex $result 1] + $start}]\n"
"}\n"
"return -1\n"
"}\n"
"proc tcl_startOfNextWord {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[regexp -indices \"$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars\" \\\n"
"[string range $str $start end] result]} {\n"
"return [expr {[lindex $result 1] + $start}]\n"
"}\n"
"return -1\n"
"}\n"
"proc tcl_startOfPreviousWord {str start} {\n"
"global tcl_nonwordchars tcl_wordchars\n"
"if {[string compare $start end] == 0} {\n"
"set start [string length $str]\n"
"}\n"
"if {[regexp -indices \\\n"
"\"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\\$\" \\\n"
"[string range $str 0 [expr {$start - 1}]] result word]} {\n"
"return [lindex $word 0]\n"
"}\n"
"return -1\n"
"}\n"
;
static char Et_zFile9[] = 
"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"
"\"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"
"-yscrollcommand \"$w.scroll set\" -width 60 -height 20\n"
"} else {\n"
"text $w.text -relief sunken -bd 2 -yscrollcommand \"$w.scroll set\" \\\n"
"-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"
"- [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"- [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_zFile10[] = 
"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"
"if {![string compare $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 config -state normal\n"
"}\n"
"if {![string compare $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"
"if {![string compare $tkPriv(buttonWindow) $w]} {\n"
"$w configure -state active\n"
"}\n"
"}\n"
"set tkPriv(window) $w\n"
"}\n"
"proc tkButtonDown w {\n"
"global tkPriv\n"
"set tkPriv(relief) [lindex [$w conf -relief] 4]\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w config -relief sunken -state active\n"
"}\n"
"}\n"
"proc tkCheckRadioDown w {\n"
"global tkPriv\n"
"set tkPriv(relief) [lindex [$w conf -relief] 4]\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w config -state active\n"
"}\n"
"}\n"
"proc tkButtonUp w {\n"
"global tkPriv\n"
"if {![string compare $tkPriv(buttonWindow) $w]} {\n"
"set tkPriv(buttonWindow) \"\"\n"
"if {![string compare $tkPriv(window) $w]\n"
"&& [string compare [$w cget -state] \"disabled\"]} {\n"
"$w config -relief $tkPriv(relief) -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 config -state active\n"
"if {![string compare $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 config -state normal\n"
"}\n"
"if {![string compare $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) [lindex [$w config -relief] 4]\n"
"if {[string compare [$w cget -state] \"disabled\"]} {\n"
"set tkPriv(buttonWindow) $w\n"
"$w config -relief sunken\n"
"}\n"
"}\n"
"proc tkButtonUp w {\n"
"global tkPriv\n"
"if {![string compare $w $tkPriv(buttonWindow)]} {\n"
"set tkPriv(buttonWindow) \"\"\n"
"$w config -relief $tkPriv(relief)\n"
"if {![string compare $w $tkPriv(window)]\n"
"&& [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 compare $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 compare $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 config -state active\n"
"}\n"
"}\n"
"proc tkButtonUp w {\n"
"global tkPriv\n"
"if {![string compare $w $tkPriv(buttonWindow)]} {\n"
"$w config -state normal\n"
"set tkPriv(buttonWindow) \"\"\n"
"if {![string compare $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_zFile11[] = 
"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"
"if {![winfo exists $w]} {\n"
"toplevel $w -class tkColorDialog\n"
"tkColorDialog_BuildDialog $w\n"
"}\n"
"wm transient $w $data(-parent)\n"
"wm withdraw $w\n"
"update idletasks\n"
"set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
"- [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"- [winfo vrooty [winfo parent $w]]}]\n"
"wm geom $w +$x+$y\n"
"wm deiconify $w\n"
"wm title $w $data(-title)\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"
"focus $data(okBtn)\n"
"tkwait variable tkPriv(selectColor)\n"
"catch {focus $oldFocus}\n"
"grab release $w\n"
"destroy $w\n"
"unset data\n"
"if {[string compare $oldGrab \"\"]} {\n"
"if {![string compare $grabStatus \"global\"]} {\n"
"grab -global $oldGrab\n"
"} else {\n"
"grab $oldGrab\n"
"}\n"
"}\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"
"[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) + \\\n"
"$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"
"set specs {\n"
"{-initialcolor \"\" \"\" \"\"}\n"
"{-parent \"\" \"\" \".\"}\n"
"{-title \"\" \"\" \"Color\"}\n"
"}\n"
"tclParseConfigSpec $w $specs \"\" $argList\n"
"if {![string compare $data(-title) \"\"]} {\n"
"set data(-title) \" \"\n"
"}\n"
"if {![string compare $data(-initialcolor) \"\"]} {\n"
"if {[info exists tkPriv(selectColor)] && \\\n"
"[string compare $tkPriv(selectColor) \"\"]} {\n"
"set data(-initialcolor) $tkPriv(selectColor)\n"
"} else {\n"
"set data(-initialcolor) [. cget -background]\n"
"}\n"
"} else {\n"
"if {[catch {winfo rgb . $data(-initialcolor)} err]} {\n"
"error $err\n"
"}\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"
"-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"
"{[winfo reqheight $box.entry] - \\\n"
"2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]\n"
"canvas $f.color -height $height\\\n"
"-width $data(BARS_WIDTH) -relief sunken -bd 2\n"
"canvas $f.sel -height $data(PLGN_HEIGHT) \\\n"
"-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"
"\"tkColorDialog_DrawColorScale $w $color 1\"\n"
"bind $data($color,col) <Enter> \\\n"
"\"tkColorDialog_EnterColorBar $w $color\"\n"
"bind $data($color,col) <Leave> \\\n"
"\"tkColorDialog_LeaveColorBar $w $color\"\n"
"bind $data($color,sel) <Enter> \\\n"
"\"tkColorDialog_EnterColorBar $w $color\"\n"
"bind $data($color,sel) <Leave> \\\n"
"\"tkColorDialog_LeaveColorBar $w $color\"\n"
"bind $box.entry <Return> \"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"
"-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> \"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"
"-command \"tkColorDialog_OkCmd $w\"\n"
"button $botFrame.cancel -text Cancel        -width 8 -under 0 \\\n"
"-command \"tkColorDialog_CancelCmd $w\"\n"
"set data(okBtn)      $botFrame.ok\n"
"set data(cancelBtn)  $botFrame.cancel\n"
"pack $botFrame.ok $botFrame.cancel \\\n"
"-padx 10 -pady 10 -expand yes -side left\n"
"pack $botFrame -side bottom -fill x\n"
"bind $w <Alt-r> \"focus $data(red,entry)\"\n"
"bind $w <Alt-g> \"focus $data(green,entry)\"\n"
"bind $w <Alt-b> \"focus $data(blue,entry)\"\n"
"bind $w <Alt-s> \"focus $ent\"\n"
"bind $w <KeyPress-Escape> \"tkButtonInvoke $data(cancelBtn)\"\n"
"bind $w <Alt-c> \"tkButtonInvoke $data(cancelBtn)\"\n"
"bind $w <Alt-o> \"tkButtonInvoke $data(okBtn)\"\n"
"wm protocol $w WM_DELETE_WINDOW \"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"
"{$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"
"\"tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1\"\n"
"$sel bind $data($c,index) <B1-Motion> \\\n"
"\"tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)\"\n"
"$sel bind $data($c,index) <ButtonRelease-1> \\\n"
"\"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"
"$data(canvasWidth) $height -fill {} -outline {}]\n"
"bind $col <ButtonPress-1> \\\n"
"\"tkColorDialog_StartMove $w $sel $c %x $data(colorPad)\"\n"
"bind $col <B1-Motion> \\\n"
"\"tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)\"\n"
"bind $col <ButtonRelease-1> \\\n"
"\"tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)\"\n"
"$sel bind $data($c,clickRegion) <ButtonPress-1> \\\n"
"\"tkColorDialog_StartMove $w $sel $c %x $data(selPad)\"\n"
"$sel bind $data($c,clickRegion) <B1-Motion> \\\n"
"\"tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)\"\n"
"$sel bind $data($c,clickRegion) <ButtonRelease-1> \\\n"
"\"tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)\"\n"
"} else {\n"
"set l $data(lines,$c,start)\n"
"}\n"
"set highlightW [expr \\\n"
"{[$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 { $c == \"red\" } {\n"
"set color [format \"#%02x%02x%02x\" \\\n"
"$intensity \\\n"
"$data(green,intensity) \\\n"
"$data(blue,intensity)]\n"
"} elseif { $c == \"green\" } {\n"
"set color [format \"#%02x%02x%02x\" \\\n"
"$data(red,intensity) \\\n"
"$intensity \\\n"
"$data(blue,intensity)]\n"
"} else {\n"
"set color [format \"#%02x%02x%02x\" \\\n"
"$data(red,intensity) \\\n"
"$data(green,intensity) \\\n"
"$intensity]\n"
"}\n"
"if {$create} {\n"
"set index [$col create rect $startx $highlightW \\\n"
"[expr {$startx +$data(colorbarWidth)}] \\\n"
"[expr {[winfo height $col] + $highlightW}]\\\n"
"-fill $color -outline $color]\n"
"} else {\n"
"$col itemconf $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"
"0 $data(PLGN_HEIGHT) \\\n"
"$data(PLGN_WIDTH) $data(PLGN_HEIGHT) \\\n"
"$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"
"$data(green,intensity) $data(blue,intensity)]\n"
"$data(finalCanvas) conf -bg $color\n"
"set data(finalColor) $color\n"
"set data(selection) $color\n"
"set data(finalRGB) [list \\\n"
"$data(red,intensity) \\\n"
"$data(green,intensity) \\\n"
"$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) conf -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"
"$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_zFile12[] = 
"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 tclSortNoCase {str1 str2} {\n"
"return [string compare [string toupper $str1] [string toupper $str2]]\n"
"}\n"
"proc tclVerifyInteger {string} {\n"
"lindex {1 2 3} $string\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>  \"tkFocusGroup_In  $t %W %d\"\n"
"bind $t <FocusOut> \"tkFocusGroup_Out $t %W %d\"\n"
"bind $t <Destroy>  \"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 compare $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"
"if {![string compare $tkPriv(focus,$t) $w]} {\n"
"set tkPriv(focus,$t) \"\"\n"
"}\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 {![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 compare $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"
"[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 compare $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_zFile13[] = 
"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"
"-command tkConsoleSource\n"
".menubar.file add command -label \"Hide Console\" -underline 0 \\\n"
"-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"
"-command { event generate .console <<Cut>> } -accel \"$mod+X\"\n"
".menubar.edit add command -label \"Copy\" -underline 0 \\\n"
"-command { event generate .console <<Copy>> } -accel \"$mod+C\"\n"
".menubar.edit add command -label \"Paste\" -underline 1 \\\n"
"-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"
"-command { event generate .console <<Clear>> }\n"
"} else {\n"
".menubar.edit add command -label \"Delete\" -underline 0 \\\n"
"-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"
"-command tkConsoleAbout\n"
"}\n"
". conf -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"
"if {![string compare $tcl_platform(platform) \"macintosh\"]} {\n"
".console configure -font {Monaco 9 normal} -highlightthickness 0\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 . \"Console\"\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"
"-title \"Select a file to source\" \\\n"
"-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 compare $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 compare $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"
"} else {\n"
"if {[%W compare insert < promptEnd]} {\n"
"break\n"
"}\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"
"} else {\n"
"if {[%W compare insert <= promptEnd]} {\n"
"break\n"
"}\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 compare $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 compare $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 \"Tcl for Windows\n"
"Copyright \\251 1999 Scriptics Corporation\n"
"Tcl [info patchlevel]\n"
"Tk $tk_patchLevel\"\n"
"}\n"
"tkConsoleInit\n"
;
static char Et_zFile14[] = 
"proc tk_dialog {w title text bitmap default args} {\n"
"global tkPriv tcl_platform\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"
"wm transient $w [winfo toplevel [winfo parent $w]]\n"
"if {![string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"unsupported1 style $w dBoxProc\n"
"}\n"
"frame $w.bot\n"
"frame $w.top\n"
"if {![string compare $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 compare $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 -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 compare $tcl_platform(platform) \"macintosh\"] && ![string compare $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 \"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 compare $tcl_platform(platform) \"macintosh\"]} {\n"
"set tmp [string tolower $but]\n"
"if {![string compare $tmp \"ok\"] || ![string compare $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"
"- [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"- [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_zFile15[] = 
"bind Entry <<Cut>> {\n"
"if {![catch {set data [tkEntryGetSelection %W]}]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W $data\n"
"%W delete sel.first sel.last\n"
"}\n"
"}\n"
"bind Entry <<Copy>> {\n"
"if {![catch {set data [tkEntryGetSelection %W]}]} {\n"
"clipboard clear -displayof %W\n"
"clipboard append -displayof %W $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 compare $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 compare [$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 compare [$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 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 compare $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"
"set left [$w index @0]\n"
"if {$left > $c} {\n"
"$w xview $c\n"
"return\n"
"}\n"
"set x [winfo width $w]\n"
"while {([$w index @$x] <= $c) && ($left < $c)} {\n"
"incr left\n"
"$w xview $left\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 compare $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"
"[expr [$w index sel.last] - 1]]\n"
"if {[$w cget -show] != \"\"} {\n"
"regsub -all . $entryString [string index [$w cget -show] 0] entryString\n"
"}\n"
"return $entryString\n"
"}\n"
;
static char Et_zFile16[] = 
"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 compare [winfo toplevel $cur] $cur]} {\n"
"continue\n"
"} else {\n"
"break\n"
"}\n"
"}\n"
"set cur $parent\n"
"if {![string compare [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 compare $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 compare [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 compare [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 compare $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 $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 compare $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 compare \"%d\" \"NotifyAncestor\"]\n"
"|| ![string compare \"%d\" \"NotifyNonlinear\"]\n"
"|| ![string compare \"%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_zFile17[] = 
"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 compare [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"
"proc tkListboxBeginSelect {w el} {\n"
"global tkPriv\n"
"if {![string compare [$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 {[$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"
"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 compare [$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 compare [$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 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"
"$w activate [expr {[$w index 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 compare $mode \"extended\"]} {\n"
"$w activate $el\n"
"$w see $el\n"
"if {[$w selection includes anchor]} {\n"
"tkListboxMotion $w $el\n"
"}\n"
"} elseif {![string compare $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 {$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 compare $mode \"single\"] || ![string compare $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_zFile18[] = 
"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 compare [%W cget -type] \"tearoff\"]} {\n"
"if {[string compare \"%m\" \"NotifyUngrab\"]} {\n"
"if {![string compare $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 compare $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 compare [$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 compare [$w cget -state] \"disabled\"] ||\n"
"![string compare $w $tkPriv(postedMb)]} {\n"
"return\n"
"}\n"
"set menu [$w cget -menu]\n"
"if {![string compare $menu \"\"]} {\n"
"return\n"
"}\n"
"set tearoff [expr {![string compare $tcl_platform(platform) \"unix\"] \\\n"
"|| ![string compare [$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"
"+ [winfo reqheight $menu])/2}]\n"
"} else {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"+ [$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"
"+ [winfo reqheight $menu])/2}]\n"
"} else {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"+ [$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 compare $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"
"tkSaveGrabInfo $w\n"
"grab -global $w\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"
"&& [string compare [$menu cget -type] \"tearoff\"]} {\n"
"while 1 {\n"
"set parent [winfo parent $menu]\n"
"if {[string compare [winfo class $parent] \"Menu\"]\n"
"|| ![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 compare $type \"menubar\"] ||\n"
"![string compare $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 compare $tkPriv(inMenubutton) $w]} {\n"
"return\n"
"}\n"
"set new [winfo containing $rootx $rooty]\n"
"if {[string compare $new $tkPriv(inMenubutton)]\n"
"&& (![string compare $new \"\"]\n"
"|| ![string compare [winfo toplevel $new] [winfo toplevel $w]])} {\n"
"if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
"tkMbLeave $tkPriv(inMenubutton)\n"
"}\n"
"if {[string compare $new \"\"]\n"
"&& ![string compare [winfo class $new] \"Menubutton\"]\n"
"&& ([$new cget -indicatoron] == 0)\n"
"&& ([$w cget -indicatoron] == 0)} {\n"
"if {![string compare $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 {($tcl_platform(platform) == \"unix\") \\\n"
"|| (($menu != {}) && ([$menu cget -type] == \"tearoff\"))}]\n"
"if {($tearoff != 0) && ($tkPriv(postedMb) == $w) \n"
"&& ($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 compare $menu $tkPriv(window)]} {\n"
"if {![string compare [$menu cget -type] \"menubar\"]} {\n"
"if {[info exists tkPriv(focus)] && \\\n"
"[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"
"grab -global $tkPriv(postedMb)\n"
"} else {\n"
"while {![string compare [$menu cget -type] \"normal\"]\n"
"&& ![string compare [winfo class [winfo parent $menu]] \"Menu\"]\n"
"&& [winfo ismapped [winfo parent $menu]]} {\n"
"set menu [winfo parent $menu]\n"
"}\n"
"if {![string compare $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 compare $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 compare [$menu index active] \"none\"]} {\n"
"return\n"
"}\n"
"if {![string compare [$menu type active] \"cascade\"]\n"
"&& ![string compare [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 compare $tkPriv(window) {}]} {\n"
"$w postcascade none\n"
"$w activate none\n"
"event generate $w <<MenuSelect>>\n"
"tkMenuUnpost $w\n"
"return\n"
"}\n"
"if {![string compare [$w type active] \"cascade\"]} {\n"
"$w postcascade active\n"
"set menu [$w entrycget active -menu]\n"
"tkMenuFirstEntry $menu\n"
"} elseif {![string compare [$w type active] \"tearoff\"]} {\n"
"tkMenuUnpost $w\n"
"tkTearOffMenu $w\n"
"} elseif {![string compare [$w cget -type] \"menubar\"]} {\n"
"$w postcascade none\n"
"$w activate none\n"
"event generate $w <<MenuSelect>>\n"
"tkMenuUnpost $w\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 compare [$parent cget -type] \"menubar\"]} {\n"
"tkMenuUnpost $menu\n"
"tkRestoreOldGrab\n"
"} else {\n"
"tkMenuNextMenu $menu left\n"
"}\n"
"}\n"
"proc tkMenuUpArrow {menu} {\n"
"if {![string compare [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextMenu $menu left\n"
"} else {\n"
"tkMenuNextEntry $menu -1\n"
"}\n"
"}\n"
"proc tkMenuDownArrow {menu} {\n"
"if {![string compare [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextMenu $menu right\n"
"} else {\n"
"tkMenuNextEntry $menu 1\n"
"}\n"
"}\n"
"proc tkMenuLeftArrow {menu} {\n"
"if {![string compare [$menu cget -type] \"menubar\"]} {\n"
"tkMenuNextEntry $menu -1\n"
"} else {\n"
"tkMenuNextMenu $menu left\n"
"}\n"
"}\n"
"proc tkMenuRightArrow {menu} {\n"
"if {![string compare [$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 compare $direction \"right\"]} {\n"
"set count 1\n"
"set parent [winfo parent $menu]\n"
"set class [winfo class $parent]\n"
"if {![string compare [$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 compare [winfo class $parent] \"Menu\"]\n"
"&& ![string compare [$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 compare [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 compare [winfo class $m2] \"Menu\"]} {\n"
"if {![string compare [$m2 cget -type] \"menubar\"]} {\n"
"tk_menuSetFocus $m2\n"
"tkMenuNextEntry $m2 -1\n"
"return\n"
"}\n"
"}\n"
"set w $tkPriv(postedMb)\n"
"if {![string compare $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 compare [winfo class $mb] \"Menubutton\"]\n"
"&& [string compare [$mb cget -state] \"disabled\"]\n"
"&& [string compare [$mb cget -menu] \"\"]\n"
"&& [string compare [[$mb cget -menu] index last] \"none\"]} {\n"
"break\n"
"}\n"
"if {![string compare $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 compare [$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 compare $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 {$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 compare [$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 {[winfo toplevel [focus]] != [winfo toplevel $child] } {\n"
"continue\n"
"}\n"
"switch [winfo class $child] {\n"
"Menu {\n"
"if {![string compare [$child cget -type] \"menubar\"]} {\n"
"if {![string compare $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 compare [$child type $i] \"separator\"]} {\n"
"continue\n"
"}\n"
"set char2 [string index [$child entrycget $i -label] \\\n"
"[$child entrycget $i -underline]]\n"
"if {![string compare $char [string tolower $char2]] \\\n"
"|| ![string compare $char \"\"]} {\n"
"if {[string compare [$child entrycget $i -state] \"disabled\"]} {\n"
"return $child\n"
"}\n"
"}\n"
"}\n"
"}\n"
"}\n"
"}\n"
"}\n"
"foreach child $windowlist {\n"
"if {[winfo toplevel [focus]] != [winfo toplevel $child] } {\n"
"continue\n"
"}\n"
"switch [winfo class $child] {\n"
"Menubutton {\n"
"set char2 [string index [$child cget -text] \\\n"
"[$child cget -underline]]\n"
"if {![string compare $char [string tolower $char2]]\n"
"|| ![string compare $char \"\"]} {\n"
"if {[string compare [$child cget $i -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 compare $char \"\"]} {\n"
"return\n"
"}\n"
"while {![string compare [winfo class $w] \"Menu\"]} {\n"
"if {[string compare [$w cget -type] \"menubar\"]\n"
"&& ![string compare $tkPriv(postedMb) \"\"]} {\n"
"return\n"
"}\n"
"if {![string compare [$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 compare [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 compare [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 compare $char \"\"]} {\n"
"return\n"
"}\n"
"set char [string tolower $char]\n"
"set last [$w index last]\n"
"if {![string compare $last \"none\"]} {\n"
"return\n"
"}\n"
"for {set i 0} {$i <= $last} {incr i} {\n"
"if {[catch {set char2 [string index \\\n"
"[$w entrycget $i -label] \\\n"
"[$w entrycget $i -underline]]}]} {\n"
"continue\n"
"}\n"
"if {![string compare $char [string tolower $char2]]} {\n"
"if {![string compare [$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 compare $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 compare $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"
"&& [string compare $state \"disabled\"]\n"
"&& [string compare [$menu type $i] \"tearoff\"]} {\n"
"$menu activate $i\n"
"tkGenerateMenuSelect $menu\n"
"if {![string compare [$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"
"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 compare $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 compare $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"
"+ [winfo reqheight $menu])/2}]\n"
"} else {\n"
"incr y [expr {-([$menu yposition $entry] \\\n"
"+ [$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"
"&& [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 compare $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 compare $tkPriv(focus) {}]} {\n"
"set tkPriv(focus) [focus]\n"
"}\n"
"focus $menu\n"
"}\n"
"proc tkGenerateMenuSelect {menu} {\n"
"global tkPriv\n"
"if {![string compare $tkPriv(activeMenu) $menu] \\\n"
"&& ![string compare $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"
"|| [string compare $tkPriv(postedMb) \"\"]} {\n"
"tkMenuUnpost {}\n"
"}\n"
"tkPostOverPoint $menu $x $y $entry\n"
"if {![string compare $tcl_platform(platform) \"unix\"] \\\n"
"&& [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_zFile19[] = 
"proc tkMessageBox {args} {\n"
"global tkPriv tcl_platform\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 {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 compare $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 compare $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 compare [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"
"wm transient $w $data(-parent)\n"
"if {![string compare $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 compare $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 -justify left -text $data(-message)\n"
"pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m\n"
"if {[string compare $data(-icon) \"\"]} {\n"
"label $w.bitmap -bitmap $data(-icon)\n"
"pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m\n"
"}\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 \\\n"
"[string index $name 0]][string range $name 1 end]\n"
"set opts [list -text $capName]\n"
"}\n"
"eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]\n"
"if {![string compare $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 <Return> [list tkButtonInvoke $w.$data(-default)]\n"
"}\n"
"wm withdraw $w\n"
"update idletasks\n"
"set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
"- [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"- [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 {[string compare $data(-default) \"\"]} {\n"
"focus $w.$data(-default)\n"
"} else {\n"
"focus $w\n"
"}\n"
"tkwait variable tkPriv(button)\n"
"catch {focus $oldFocus}\n"
"destroy $w\n"
"if {[string compare $oldGrab \"\"]} {\n"
"if {![string compare $grabStatus \"global\"]} {\n"
"grab -global $oldGrab\n"
"} else {\n"
"grab $oldGrab\n"
"}\n"
"}\n"
"return $tkPriv(button)\n"
"}\n"
;
static char Et_zFile20[] = 
"proc tk_menuBar args {}\n"
"proc tk_bindForTraversal args {}\n"
;
static char Et_zFile21[] = 
"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"
"-relief raised -bd 2 -highlightthickness 2 -anchor c \\\n"
"-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_zFile22[] = 
"proc tk_setPalette {args} {\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"
"[expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]]\n"
"foreach i {activeForeground insertBackground selectForeground \\\n"
"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"
"[expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \\\n"
"[expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \\\n"
"[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"
"$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 menubutton menu message \\\n"
"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"
"*[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"
"background #ffe4c4 disabledForeground #b0b0b0 foreground black \\\n"
"highlightBackground #ffe4c4 highlightColor black \\\n"
"insertBackground black selectColor #b03060 \\\n"
"selectBackground #e6ceb1 selectForeground black \\\n"
"troughColor #cdb79e\n"
"}\n"
;
static char Et_zFile23[] = 
"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"
"$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"
"preventing 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"
"unset tkInit($interpPath)\n"
"none\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"
"safe 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 \\\n"
"-padx 2 -pady 0 -anchor w;\n"
"frame  $wc.fb -bd 0 ;\n"
"button $wc.fb.b -text \"Delete\" \\\n"
"-bd 1  -padx 2 -pady 0 -highlightthickness 0 \\\n"
"-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_zFile24[] = 
"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 compare [%W cget -state] \"active\"]} {\n"
"%W configure -state normal\n"
"}\n"
"}\n"
"bind Scale <1> {\n"
"tkScaleButtonDown %W %x %y\n"
"}\n"
"bind Scale <B1-Motion> {\n"
"tkScaleDrag %W %x %y\n"
"}\n"
"bind Scale <B1-Leave> { }\n"
"bind Scale <B1-Enter> { }\n"
"bind Scale <ButtonRelease-1> {\n"
"tkCancelRepeat\n"
"tkScaleEndDrag %W\n"
"tkScaleActivate %W %x %y\n"
"}\n"
"bind Scale <2> {\n"
"tkScaleButton2Down %W %x %y\n"
"}\n"
"bind Scale <B2-Motion> {\n"
"tkScaleDrag %W %x %y\n"
"}\n"
"bind Scale <B2-Leave> { }\n"
"bind Scale <B2-Enter> { }\n"
"bind Scale <ButtonRelease-2> {\n"
"tkCancelRepeat\n"
"tkScaleEndDrag %W\n"
"tkScaleActivate %W %x %y\n"
"}\n"
"bind Scale <Control-1> {\n"
"tkScaleControlPress %W %x %y\n"
"}\n"
"bind Scale <Up> {\n"
"tkScaleIncrement %W up little noRepeat\n"
"}\n"
"bind Scale <Down> {\n"
"tkScaleIncrement %W down little noRepeat\n"
"}\n"
"bind Scale <Left> {\n"
"tkScaleIncrement %W up little noRepeat\n"
"}\n"
"bind Scale <Right> {\n"
"tkScaleIncrement %W down little noRepeat\n"
"}\n"
"bind Scale <Control-Up> {\n"
"tkScaleIncrement %W up big noRepeat\n"
"}\n"
"bind Scale <Control-Down> {\n"
"tkScaleIncrement %W down big noRepeat\n"
"}\n"
"bind Scale <Control-Left> {\n"
"tkScaleIncrement %W up big noRepeat\n"
"}\n"
"bind Scale <Control-Right> {\n"
"tkScaleIncrement %W down big noRepeat\n"
"}\n"
"bind Scale <Home> {\n"
"%W set [%W cget -from]\n"
"}\n"
"bind Scale <End> {\n"
"%W set [%W cget -to]\n"
"}\n"
"proc tkScaleActivate {w x y} {\n"
"global tkPriv\n"
"if {![string compare [$w cget -state] \"disabled\"]} {\n"
"return\n"
"}\n"
"if {![string compare [$w identify $x $y] \"slider\"]} {\n"
"$w configure -state active\n"
"} else {\n"
"$w configure -state normal\n"
"}\n"
"}\n"
"proc tkScaleButtonDown {w x y} {\n"
"global tkPriv\n"
"set tkPriv(dragging) 0\n"
"set el [$w identify $x $y]\n"
"if {![string compare $el \"trough1\"]} {\n"
"tkScaleIncrement $w up little initial\n"
"} elseif {![string compare $el \"trough2\"]} {\n"
"tkScaleIncrement $w down little initial\n"
"} elseif {![string compare $el \"slider\"]} {\n"
"set tkPriv(dragging) 1\n"
"set tkPriv(initValue) [$w get]\n"
"set coords [$w coords]\n"
"set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]\n"
"set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]\n"
"$w configure -sliderrelief sunken\n"
"}\n"
"}\n"
"proc tkScaleDrag {w x y} {\n"
"global tkPriv\n"
"if {!$tkPriv(dragging)} {\n"
"return\n"
"}\n"
"$w set [$w get [expr {$x - $tkPriv(deltaX)}] \\\n"
"[expr {$y - $tkPriv(deltaY)}]]\n"
"}\n"
"proc tkScaleEndDrag {w} {\n"
"global tkPriv\n"
"set tkPriv(dragging) 0\n"
"$w configure -sliderrelief raised\n"
"}\n"
"proc tkScaleIncrement {w dir big repeat} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"if {![string compare $big \"big\"]} {\n"
"set inc [$w cget -bigincrement]\n"
"if {$inc == 0} {\n"
"set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]\n"
"}\n"
"if {$inc < [$w cget -resolution]} {\n"
"set inc [$w cget -resolution]\n"
"}\n"
"} else {\n"
"set inc [$w cget -resolution]\n"
"}\n"
"if {([$w cget -from] > [$w cget -to]) ^ ![string compare $dir \"up\"]} {\n"
"set inc [expr {-$inc}]\n"
"}\n"
"$w set [expr {[$w get] + $inc}]\n"
"if {![string compare $repeat \"again\"]} {\n"
"set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n"
"tkScaleIncrement $w $dir $big again]\n"
"} elseif {![string compare $repeat \"initial\"]} {\n"
"set delay [$w cget -repeatdelay]\n"
"if {$delay > 0} {\n"
"set tkPriv(afterId) [after $delay \\\n"
"tkScaleIncrement $w $dir $big again]\n"
"}\n"
"}\n"
"}\n"
"proc tkScaleControlPress {w x y} {\n"
"set el [$w identify $x $y]\n"
"if {![string compare $el \"trough1\"]} {\n"
"$w set [$w cget -from]\n"
"} elseif {![string compare $el \"trough2\"]} {\n"
"$w set [$w cget -to]\n"
"}\n"
"}\n"
"proc tkScaleButton2Down {w x y} {\n"
"global tkPriv\n"
"if {![string compare [$w cget -state] \"disabled\"]} {\n"
"return\n"
"}\n"
"$w configure -state active\n"
"$w set [$w get $x $y]\n"
"set tkPriv(dragging) 1\n"
"set tkPriv(initValue) [$w get]\n"
"set coords \"$x $y\"\n"
"set tkPriv(deltaX) 0\n"
"set tkPriv(deltaY) 0\n"
"}\n"
;
static char Et_zFile25[] = 
"if {[string compare $tcl_platform(platform) \"windows\"] &&\n"
"[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Scrollbar <Enter> {\n"
"if {$tk_strictMotif} {\n"
"set tkPriv(activeBg) [%W cget -activebackground]\n"
"%W config -activebackground [%W cget -background]\n"
"}\n"
"%W activate [%W identify %x %y]\n"
"}\n"
"bind Scrollbar <Motion> {\n"
"%W activate [%W identify %x %y]\n"
"}\n"
"bind Scrollbar <Leave> {\n"
"if {$tk_strictMotif && [info exists tkPriv(activeBg)]} {\n"
"%W config -activebackground $tkPriv(activeBg)\n"
"}\n"
"%W activate {}\n"
"}\n"
"bind Scrollbar <1> {\n"
"tkScrollButtonDown %W %x %y\n"
"}\n"
"bind Scrollbar <B1-Motion> {\n"
"tkScrollDrag %W %x %y\n"
"}\n"
"bind Scrollbar <B1-B2-Motion> {\n"
"tkScrollDrag %W %x %y\n"
"}\n"
"bind Scrollbar <ButtonRelease-1> {\n"
"tkScrollButtonUp %W %x %y\n"
"}\n"
"bind Scrollbar <B1-Leave> {\n"
"}\n"
"bind Scrollbar <B1-Enter> {\n"
"}\n"
"bind Scrollbar <2> {\n"
"tkScrollButton2Down %W %x %y\n"
"}\n"
"bind Scrollbar <B1-2> {\n"
"}\n"
"bind Scrollbar <B2-1> {\n"
"}\n"
"bind Scrollbar <B2-Motion> {\n"
"tkScrollDrag %W %x %y\n"
"}\n"
"bind Scrollbar <ButtonRelease-2> {\n"
"tkScrollButtonUp %W %x %y\n"
"}\n"
"bind Scrollbar <B1-ButtonRelease-2> {\n"
"}\n"
"bind Scrollbar <B2-ButtonRelease-1> {\n"
"}\n"
"bind Scrollbar <B2-Leave> {\n"
"}\n"
"bind Scrollbar <B2-Enter> {\n"
"}\n"
"bind Scrollbar <Control-1> {\n"
"tkScrollTopBottom %W %x %y\n"
"}\n"
"bind Scrollbar <Control-2> {\n"
"tkScrollTopBottom %W %x %y\n"
"}\n"
"bind Scrollbar <Up> {\n"
"tkScrollByUnits %W v -1\n"
"}\n"
"bind Scrollbar <Down> {\n"
"tkScrollByUnits %W v 1\n"
"}\n"
"bind Scrollbar <Control-Up> {\n"
"tkScrollByPages %W v -1\n"
"}\n"
"bind Scrollbar <Control-Down> {\n"
"tkScrollByPages %W v 1\n"
"}\n"
"bind Scrollbar <Left> {\n"
"tkScrollByUnits %W h -1\n"
"}\n"
"bind Scrollbar <Right> {\n"
"tkScrollByUnits %W h 1\n"
"}\n"
"bind Scrollbar <Control-Left> {\n"
"tkScrollByPages %W h -1\n"
"}\n"
"bind Scrollbar <Control-Right> {\n"
"tkScrollByPages %W h 1\n"
"}\n"
"bind Scrollbar <Prior> {\n"
"tkScrollByPages %W hv -1\n"
"}\n"
"bind Scrollbar <Next> {\n"
"tkScrollByPages %W hv 1\n"
"}\n"
"bind Scrollbar <Home> {\n"
"tkScrollToPos %W 0\n"
"}\n"
"bind Scrollbar <End> {\n"
"tkScrollToPos %W 1\n"
"}\n"
"}\n"
"proc tkScrollButtonDown {w x y} {\n"
"global tkPriv\n"
"set tkPriv(relief) [$w cget -activerelief]\n"
"$w configure -activerelief sunken\n"
"set element [$w identify $x $y]\n"
"if {![string compare $element \"slider\"]} {\n"
"tkScrollStartDrag $w $x $y\n"
"} else {\n"
"tkScrollSelect $w $element initial\n"
"}\n"
"}\n"
"proc tkScrollButtonUp {w x y} {\n"
"global tkPriv\n"
"tkCancelRepeat\n"
"$w configure -activerelief $tkPriv(relief)\n"
"tkScrollEndDrag $w $x $y\n"
"$w activate [$w identify $x $y]\n"
"}\n"
"proc tkScrollSelect {w element repeat} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"switch -- $element {\n"
"\"arrow1\"        {tkScrollByUnits $w hv -1}\n"
"\"trough1\"       {tkScrollByPages $w hv -1}\n"
"\"trough2\"       {tkScrollByPages $w hv 1}\n"
"\"arrow2\"        {tkScrollByUnits $w hv 1}\n"
"default         {return}\n"
"}\n"
"if {![string compare $repeat \"again\"]} {\n"
"set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n"
"tkScrollSelect $w $element again]\n"
"} elseif {![string compare $repeat \"initial\"]} {\n"
"set delay [$w cget -repeatdelay]\n"
"if {$delay > 0} {\n"
"set tkPriv(afterId) [after $delay tkScrollSelect $w $element again]\n"
"}\n"
"}\n"
"}\n"
"proc tkScrollStartDrag {w x y} {\n"
"global tkPriv\n"
"if {![string compare [$w cget -command] \"\"]} {\n"
"return\n"
"}\n"
"set tkPriv(pressX) $x\n"
"set tkPriv(pressY) $y\n"
"set tkPriv(initValues) [$w get]\n"
"set iv0 [lindex $tkPriv(initValues) 0]\n"
"if {[llength $tkPriv(initValues)] == 2} {\n"
"set tkPriv(initPos) $iv0\n"
"} else {\n"
"if {$iv0 == 0} {\n"
"set tkPriv(initPos) 0.0\n"
"} else {\n"
"set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \\\n"
"/ [lindex $tkPriv(initValues) 0]}]\n"
"}\n"
"}\n"
"}\n"
"proc tkScrollDrag {w x y} {\n"
"global tkPriv\n"
"if {![string compare $tkPriv(initPos) \"\"]} {\n"
"return\n"
"}\n"
"set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]\n"
"if {[$w cget -jump]} {\n"
"if {[llength $tkPriv(initValues)] == 2} {\n"
"$w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \\\n"
"[expr {[lindex $tkPriv(initValues) 1] + $delta}]\n"
"} else {\n"
"set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]\n"
"eval $w set [lreplace $tkPriv(initValues) 2 3 \\\n"
"[expr {[lindex $tkPriv(initValues) 2] + $delta}] \\\n"
"[expr {[lindex $tkPriv(initValues) 3] + $delta}]]\n"
"}\n"
"} else {\n"
"tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]\n"
"}\n"
"}\n"
"proc tkScrollEndDrag {w x y} {\n"
"global tkPriv\n"
"if {![string compare $tkPriv(initPos) \"\"]} {\n"
"return\n"
"}\n"
"if {[$w cget -jump]} {\n"
"set delta [$w delta [expr {$x - $tkPriv(pressX)}] \\\n"
"[expr {$y - $tkPriv(pressY)}]]\n"
"tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]\n"
"}\n"
"set tkPriv(initPos) \"\"\n"
"}\n"
"proc tkScrollByUnits {w orient amount} {\n"
"set cmd [$w cget -command]\n"
"if {![string compare $cmd \"\"] || ([string first \\\n"
"[string index [$w cget -orient] 0] $orient] < 0)} {\n"
"return\n"
"}\n"
"set info [$w get]\n"
"if {[llength $info] == 2} {\n"
"uplevel #0 $cmd scroll $amount units\n"
"} else {\n"
"uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]\n"
"}\n"
"}\n"
"proc tkScrollByPages {w orient amount} {\n"
"set cmd [$w cget -command]\n"
"if {![string compare $cmd \"\"] || ([string first \\\n"
"[string index [$w cget -orient] 0] $orient] < 0)} {\n"
"return\n"
"}\n"
"set info [$w get]\n"
"if {[llength $info] == 2} {\n"
"uplevel #0 $cmd scroll $amount pages\n"
"} else {\n"
"uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]\n"
"}\n"
"}\n"
"proc tkScrollToPos {w pos} {\n"
"set cmd [$w cget -command]\n"
"if {![string compare $cmd \"\"]} {\n"
"return\n"
"}\n"
"set info [$w get]\n"
"if {[llength $info] == 2} {\n"
"uplevel #0 $cmd moveto $pos\n"
"} else {\n"
"uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]\n"
"}\n"
"}\n"
"proc tkScrollTopBottom {w x y} {\n"
"global tkPriv\n"
"set element [$w identify $x $y]\n"
"if {[string match *1 $element]} {\n"
"tkScrollToPos $w 0\n"
"} elseif {[string match *2 $element]} {\n"
"tkScrollToPos $w 1\n"
"}\n"
"set tkPriv(relief) [$w cget -activerelief]\n"
"}\n"
"proc tkScrollButton2Down {w x y} {\n"
"global tkPriv\n"
"set element [$w identify $x $y]\n"
"if {![string compare $element \"arrow1\"]\n"
"|| ![string compare $element \"arrow2\"]} {\n"
"tkScrollButtonDown $w $x $y\n"
"return\n"
"}\n"
"tkScrollToPos $w [$w fraction $x $y]\n"
"set tkPriv(relief) [$w cget -activerelief]\n"
"update idletasks\n"
"$w configure -activerelief sunken\n"
"$w activate slider\n"
"tkScrollStartDrag $w $x $y\n"
"}\n"
;
static char Et_zFile26[] = 
"# Tcl autoload index file, version 2.0\n"
"# This file is generated by the \"auto_mkindex\" command\n"
"# and sourced to set up indexing information for one or\n"
"# more commands.  Typically each line is a command that\n"
"# sets an element in the auto_index array, where the\n"
"# element name is the name of a command and the value is\n"
"# a script that loads the command.\n"
"\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]\n"
"set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]\n"
"set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]\n"
"set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]\n"
"set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]\n"
"set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tk_popup) [list source [file join $dir menu.tcl]]\n"
"set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]\n"
"set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textCut) [list source [file join $dir text.tcl]]\n"
"set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]\n"
"set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]\n"
"set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]\n"
"set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]\n"
"set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]\n"
"set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]\n"
"set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]\n"
"set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]\n"
"set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]\n"
"set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]\n"
"set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]\n"
"set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]\n"
"set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]\n"
"set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkDarken) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]\n"
"set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]\n"
"set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]\n"
"set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]\n"
"set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]\n"
"set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]\n"
"set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]\n"
"set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]\n"
;
static char Et_zFile27[] = 
"proc tkTearOffMenu {w {x 0} {y 0}} {\n"
"if {$x == 0} {\n"
"set x [winfo rootx $w]\n"
"}\n"
"if {$y == 0} {\n"
"set y [winfo rooty $w]\n"
"}\n"
"set parent [winfo parent $w]\n"
"while {[string compare [winfo toplevel $parent] $parent]\n"
"|| ![string compare [winfo class $parent] \"Menu\"]} {\n"
"set parent [winfo parent $parent]\n"
"}\n"
"if {![string compare $parent \".\"]} {\n"
"set parent \"\"\n"
"}\n"
"for {set i 1} 1 {incr i} {\n"
"set menu $parent.tearoff$i\n"
"if {![winfo exists $menu]} {\n"
"break\n"
"}\n"
"}\n"
"$w clone $menu tearoff\n"
"set parent [winfo parent $w]\n"
"if {[string compare [$menu cget -title] \"\"]} {\n"
"wm title $menu [$menu cget -title]\n"
"} else {\n"
"switch [winfo class $parent] {\n"
"Menubutton {\n"
"wm title $menu [$parent cget -text]\n"
"}\n"
"Menu {\n"
"wm title $menu [$parent entrycget active -label]\n"
"}\n"
"}\n"
"}\n"
"$menu post $x $y\n"
"if {[winfo exists $menu] == 0} {\n"
"return \"\"\n"
"}\n"
"bind $menu <Enter> {\n"
"set tkPriv(focus) %W\n"
"}\n"
"set cmd [$w cget -tearoffcommand]\n"
"if {[string compare $cmd \"\"]} {\n"
"uplevel #0 $cmd $w $menu\n"
"}\n"
"return $menu\n"
"}\n"
"proc tkMenuDup {src dst type} {\n"
"set cmd [list menu $dst -type $type]\n"
"foreach option [$src configure] {\n"
"if {[llength $option] == 2} {\n"
"continue\n"
"}\n"
"if {[string compare [lindex $option 0] \"-type\"] == 0} {\n"
"continue\n"
"}\n"
"lappend cmd [lindex $option 0] [lindex $option 4]\n"
"}\n"
"eval $cmd\n"
"set last [$src index last]\n"
"if {![string compare $last \"none\"]} {\n"
"return\n"
"}\n"
"for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {\n"
"set cmd [list $dst add [$src type $i]]\n"
"foreach option [$src entryconfigure $i]  {\n"
"lappend cmd [lindex $option 0] [lindex $option 4]\n"
"}\n"
"eval $cmd\n"
"}\n"
"set tags [bindtags $src]\n"
"set srcLen [string length $src]\n"
"while {[set index [string first $src $tags]] != -1} {\n"
"append x [string range $tags 0 [expr {$index - 1}]]$dst\n"
"set tags [string range $tags [expr {$index + $srcLen}] end]\n"
"}\n"
"append x $tags\n"
"bindtags $dst $x\n"
"foreach event [bind $src] {\n"
"unset x\n"
"set script [bind $src $event]\n"
"set eventLen [string length $event]\n"
"while {[set index [string first $event $script]] != -1} {\n"
"append x [string range $script 0 [expr {$index - 1}]]\n"
"append x $dst\n"
"set script [string range $script [expr {$index + $eventLen}] end]\n"
"}\n"
"append x $script\n"
"bind $dst $event $x\n"
"}\n"
"}\n"
;
static char Et_zFile28[] = 
"bind Text <1> {\n"
"tkTextButton1 %W %x %y\n"
"%W tag remove sel 0.0 end\n"
"}\n"
"bind Text <B1-Motion> {\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <Double-1> {\n"
"set tkPriv(selectMode) word\n"
"tkTextSelectTo %W %x %y\n"
"catch {%W mark set insert sel.first}\n"
"}\n"
"bind Text <Triple-1> {\n"
"set tkPriv(selectMode) line\n"
"tkTextSelectTo %W %x %y\n"
"catch {%W mark set insert sel.first}\n"
"}\n"
"bind Text <Shift-1> {\n"
"tkTextResetAnchor %W @%x,%y\n"
"set tkPriv(selectMode) char\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <Double-Shift-1>\011{\n"
"set tkPriv(selectMode) word\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <Triple-Shift-1>\011{\n"
"set tkPriv(selectMode) line\n"
"tkTextSelectTo %W %x %y\n"
"}\n"
"bind Text <B1-Leave> {\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"tkTextAutoScan %W\n"
"}\n"
"bind Text <B1-Enter> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Text <ButtonRelease-1> {\n"
"tkCancelRepeat\n"
"}\n"
"bind Text <Control-1> {\n"
"%W mark set insert @%x,%y\n"
"}\n"
"bind Text <Left> {\n"
"tkTextSetCursor %W insert-1c\n"
"}\n"
"bind Text <Right> {\n"
"tkTextSetCursor %W insert+1c\n"
"}\n"
"bind Text <Up> {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W -1]\n"
"}\n"
"bind Text <Down> {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W 1]\n"
"}\n"
"bind Text <Shift-Left> {\n"
"tkTextKeySelect %W [%W index {insert - 1c}]\n"
"}\n"
"bind Text <Shift-Right> {\n"
"tkTextKeySelect %W [%W index {insert + 1c}]\n"
"}\n"
"bind Text <Shift-Up> {\n"
"tkTextKeySelect %W [tkTextUpDownLine %W -1]\n"
"}\n"
"bind Text <Shift-Down> {\n"
"tkTextKeySelect %W [tkTextUpDownLine %W 1]\n"
"}\n"
"bind Text <Control-Left> {\n"
"tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Control-Right> {\n"
"tkTextSetCursor %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Control-Up> {\n"
"tkTextSetCursor %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Control-Down> {\n"
"tkTextSetCursor %W [tkTextNextPara %W insert]\n"
"}\n"
"bind Text <Shift-Control-Left> {\n"
"tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Shift-Control-Right> {\n"
"tkTextKeySelect %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Shift-Control-Up> {\n"
"tkTextKeySelect %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Shift-Control-Down> {\n"
"tkTextKeySelect %W [tkTextNextPara %W insert]\n"
"}\n"
"bind Text <Prior> {\n"
"tkTextSetCursor %W [tkTextScrollPages %W -1]\n"
"}\n"
"bind Text <Shift-Prior> {\n"
"tkTextKeySelect %W [tkTextScrollPages %W -1]\n"
"}\n"
"bind Text <Next> {\n"
"tkTextSetCursor %W [tkTextScrollPages %W 1]\n"
"}\n"
"bind Text <Shift-Next> {\n"
"tkTextKeySelect %W [tkTextScrollPages %W 1]\n"
"}\n"
"bind Text <Control-Prior> {\n"
"%W xview scroll -1 page\n"
"}\n"
"bind Text <Control-Next> {\n"
"%W xview scroll 1 page\n"
"}\n"
"bind Text <Home> {\n"
"tkTextSetCursor %W {insert linestart}\n"
"}\n"
"bind Text <Shift-Home> {\n"
"tkTextKeySelect %W {insert linestart}\n"
"}\n"
"bind Text <End> {\n"
"tkTextSetCursor %W {insert lineend}\n"
"}\n"
"bind Text <Shift-End> {\n"
"tkTextKeySelect %W {insert lineend}\n"
"}\n"
"bind Text <Control-Home> {\n"
"tkTextSetCursor %W 1.0\n"
"}\n"
"bind Text <Control-Shift-Home> {\n"
"tkTextKeySelect %W 1.0\n"
"}\n"
"bind Text <Control-End> {\n"
"tkTextSetCursor %W {end - 1 char}\n"
"}\n"
"bind Text <Control-Shift-End> {\n"
"tkTextKeySelect %W {end - 1 char}\n"
"}\n"
"bind Text <Tab> {\n"
"tkTextInsert %W \\t\n"
"focus %W\n"
"break\n"
"}\n"
"bind Text <Shift-Tab> {\n"
"break\n"
"}\n"
"bind Text <Control-Tab> {\n"
"focus [tk_focusNext %W]\n"
"}\n"
"bind Text <Control-Shift-Tab> {\n"
"focus [tk_focusPrev %W]\n"
"}\n"
"bind Text <Control-i> {\n"
"tkTextInsert %W \\t\n"
"}\n"
"bind Text <Return> {\n"
"tkTextInsert %W \\n\n"
"}\n"
"bind Text <Delete> {\n"
"if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
"%W delete sel.first sel.last\n"
"} else {\n"
"%W delete insert\n"
"%W see insert\n"
"}\n"
"}\n"
"bind Text <BackSpace> {\n"
"if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
"%W delete sel.first sel.last\n"
"} elseif {[%W compare insert != 1.0]} {\n"
"%W delete insert-1c\n"
"%W see insert\n"
"}\n"
"}\n"
"bind Text <Control-space> {\n"
"%W mark set anchor insert\n"
"}\n"
"bind Text <Select> {\n"
"%W mark set anchor insert\n"
"}\n"
"bind Text <Control-Shift-space> {\n"
"set tkPriv(selectMode) char\n"
"tkTextKeyExtend %W insert\n"
"}\n"
"bind Text <Shift-Select> {\n"
"set tkPriv(selectMode) char\n"
"tkTextKeyExtend %W insert\n"
"}\n"
"bind Text <Control-slash> {\n"
"%W tag add sel 1.0 end\n"
"}\n"
"bind Text <Control-backslash> {\n"
"%W tag remove sel 1.0 end\n"
"}\n"
"bind Text <<Cut>> {\n"
"tk_textCut %W\n"
"}\n"
"bind Text <<Copy>> {\n"
"tk_textCopy %W\n"
"}\n"
"bind Text <<Paste>> {\n"
"tk_textPaste %W\n"
"}\n"
"bind Text <<Clear>> {\n"
"catch {%W delete sel.first sel.last}\n"
"}\n"
"bind Text <<PasteSelection>> {\n"
"if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n"
"tkTextPaste %W %x %y\n"
"}\n"
"}\n"
"bind Text <Insert> {\n"
"catch {tkTextInsert %W [selection get -displayof %W]}\n"
"}\n"
"bind Text <KeyPress> {\n"
"tkTextInsert %W %A\n"
"}\n"
"bind Text <Alt-KeyPress> {# nothing }\n"
"bind Text <Meta-KeyPress> {# nothing}\n"
"bind Text <Control-KeyPress> {# nothing}\n"
"bind Text <Escape> {# nothing}\n"
"bind Text <KP_Enter> {# nothing}\n"
"if {![string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Text <Command-KeyPress> {# nothing}\n"
"}\n"
"bind Text <Control-a> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W {insert linestart}\n"
"}\n"
"}\n"
"bind Text <Control-b> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W insert-1c\n"
"}\n"
"}\n"
"bind Text <Control-d> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert\n"
"}\n"
"}\n"
"bind Text <Control-e> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W {insert lineend}\n"
"}\n"
"}\n"
"bind Text <Control-f> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W insert+1c\n"
"}\n"
"}\n"
"bind Text <Control-k> {\n"
"if {!$tk_strictMotif} {\n"
"if {[%W compare insert == {insert lineend}]} {\n"
"%W delete insert\n"
"} else {\n"
"%W delete insert {insert lineend}\n"
"}\n"
"}\n"
"}\n"
"bind Text <Control-n> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W 1]\n"
"}\n"
"}\n"
"bind Text <Control-o> {\n"
"if {!$tk_strictMotif} {\n"
"%W insert insert \\n\n"
"%W mark set insert insert-1c\n"
"}\n"
"}\n"
"bind Text <Control-p> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextUpDownLine %W -1]\n"
"}\n"
"}\n"
"bind Text <Control-t> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextTranspose %W\n"
"}\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
"bind Text <Control-v> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextScrollPages %W 1\n"
"}\n"
"}\n"
"}\n"
"bind Text <Meta-b> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"}\n"
"bind Text <Meta-d> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete insert [tkTextNextWord %W insert]\n"
"}\n"
"}\n"
"bind Text <Meta-f> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W [tkTextNextWord %W insert]\n"
"}\n"
"}\n"
"bind Text <Meta-less> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W 1.0\n"
"}\n"
"}\n"
"bind Text <Meta-greater> {\n"
"if {!$tk_strictMotif} {\n"
"tkTextSetCursor %W end-1c\n"
"}\n"
"}\n"
"bind Text <Meta-BackSpace> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert\n"
"}\n"
"}\n"
"bind Text <Meta-Delete> {\n"
"if {!$tk_strictMotif} {\n"
"%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert\n"
"}\n"
"}\n"
"if {![string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"bind Text <FocusIn> {\n"
"%W tag configure sel -borderwidth 0\n"
"%W configure -selectbackground systemHighlight -selectforeground systemHighlightText\n"
"}\n"
"bind Text <FocusOut> {\n"
"%W tag configure sel -borderwidth 1\n"
"%W configure -selectbackground white -selectforeground black\n"
"}\n"
"bind Text <Option-Left> {\n"
"tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Option-Right> {\n"
"tkTextSetCursor %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Option-Up> {\n"
"tkTextSetCursor %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Option-Down> {\n"
"tkTextSetCursor %W [tkTextNextPara %W insert]\n"
"}\n"
"bind Text <Shift-Option-Left> {\n"
"tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
"}\n"
"bind Text <Shift-Option-Right> {\n"
"tkTextKeySelect %W [tkTextNextWord %W insert]\n"
"}\n"
"bind Text <Shift-Option-Up> {\n"
"tkTextKeySelect %W [tkTextPrevPara %W insert]\n"
"}\n"
"bind Text <Shift-Option-Down> {\n"
"tkTextKeySelect %W [tkTextNextPara %W insert]\n"
"}\n"
"}\n"
"bind Text <Control-h> {\n"
"if {!$tk_strictMotif} {\n"
"if {[%W compare insert != 1.0]} {\n"
"%W delete insert-1c\n"
"%W see insert\n"
"}\n"
"}\n"
"}\n"
"bind Text <2> {\n"
"if {!$tk_strictMotif} {\n"
"%W scan mark %x %y\n"
"set tkPriv(x) %x\n"
"set tkPriv(y) %y\n"
"set tkPriv(mouseMoved) 0\n"
"}\n"
"}\n"
"bind Text <B2-Motion> {\n"
"if {!$tk_strictMotif} {\n"
"if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {\n"
"set tkPriv(mouseMoved) 1\n"
"}\n"
"if {$tkPriv(mouseMoved)} {\n"
"%W scan dragto %x %y\n"
"}\n"
"}\n"
"}\n"
"set tkPriv(prevPos) {}\n"
"bind Text <MouseWheel> {\n"
"%W yview scroll [expr {- (%D / 120) * 4}] units\n"
"}\n"
"proc tkTextClosestGap {w x y} {\n"
"set pos [$w index @$x,$y]\n"
"set bbox [$w bbox $pos]\n"
"if {![string compare $bbox \"\"]} {\n"
"return $pos\n"
"}\n"
"if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {\n"
"return $pos\n"
"}\n"
"$w index \"$pos + 1 char\"\n"
"}\n"
"proc tkTextButton1 {w x y} {\n"
"global tkPriv\n"
"set tkPriv(selectMode) char\n"
"set tkPriv(mouseMoved) 0\n"
"set tkPriv(pressX) $x\n"
"$w mark set insert [tkTextClosestGap $w $x $y]\n"
"$w mark set anchor insert\n"
"if {![string compare [$w cget -state] \"normal\"]} {focus $w}\n"
"}\n"
"proc tkTextSelectTo {w x y} {\n"
"global tkPriv tcl_platform\n"
"set cur [tkTextClosestGap $w $x $y]\n"
"if {[catch {$w index anchor}]} {\n"
"$w mark set anchor $cur\n"
"}\n"
"set anchor [$w index anchor]\n"
"if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {\n"
"set tkPriv(mouseMoved) 1\n"
"}\n"
"switch $tkPriv(selectMode) {\n"
"char {\n"
"if {[$w compare $cur < anchor]} {\n"
"set first $cur\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $cur\n"
"}\n"
"}\n"
"word {\n"
"if {[$w compare $cur < anchor]} {\n"
"set first [tkTextPrevPos $w \"$cur + 1c\" tcl_wordBreakBefore]\n"
"set last [tkTextNextPos $w \"anchor\" tcl_wordBreakAfter]\n"
"} else {\n"
"set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]\n"
"set last [tkTextNextPos $w \"$cur - 1c\" tcl_wordBreakAfter]\n"
"}\n"
"}\n"
"line {\n"
"if {[$w compare $cur < anchor]} {\n"
"set first [$w index \"$cur linestart\"]\n"
"set last [$w index \"anchor - 1c lineend + 1c\"]\n"
"} else {\n"
"set first [$w index \"anchor linestart\"]\n"
"set last [$w index \"$cur lineend + 1c\"]\n"
"}\n"
"}\n"
"}\n"
"if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) \"char\"]} {\n"
"if {[string compare $tcl_platform(platform) \"unix\"]\n"
"&& [$w compare $cur < anchor]} {\n"
"$w mark set insert $first\n"
"} else {\n"
"$w mark set insert $last\n"
"}\n"
"$w tag remove sel 0.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"update idletasks\n"
"}\n"
"}\n"
"proc tkTextKeyExtend {w index} {\n"
"global tkPriv\n"
"set cur [$w index $index]\n"
"if {[catch {$w index anchor}]} {\n"
"$w mark set anchor $cur\n"
"}\n"
"set anchor [$w index anchor]\n"
"if {[$w compare $cur < anchor]} {\n"
"set first $cur\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $cur\n"
"}\n"
"$w tag remove sel 0.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"}\n"
"proc tkTextPaste {w x y} {\n"
"$w mark set insert [tkTextClosestGap $w $x $y]\n"
"catch {$w insert insert [selection get -displayof $w]}\n"
"if {![string compare [$w cget -state] \"normal\"]} {focus $w}\n"
"}\n"
"proc tkTextAutoScan {w} {\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"if {$tkPriv(y) >= [winfo height $w]} {\n"
"$w yview scroll 2 units\n"
"} elseif {$tkPriv(y) < 0} {\n"
"$w yview scroll -2 units\n"
"} elseif {$tkPriv(x) >= [winfo width $w]} {\n"
"$w xview scroll 2 units\n"
"} elseif {$tkPriv(x) < 0} {\n"
"$w xview scroll -2 units\n"
"} else {\n"
"return\n"
"}\n"
"tkTextSelectTo $w $tkPriv(x) $tkPriv(y)\n"
"set tkPriv(afterId) [after 50 tkTextAutoScan $w]\n"
"}\n"
"proc tkTextSetCursor {w pos} {\n"
"global tkPriv\n"
"if {[$w compare $pos == end]} {\n"
"set pos {end - 1 chars}\n"
"}\n"
"$w mark set insert $pos\n"
"$w tag remove sel 1.0 end\n"
"$w see insert\n"
"}\n"
"proc tkTextKeySelect {w new} {\n"
"global tkPriv\n"
"if {![string compare [$w tag nextrange sel 1.0 end] \"\"]} {\n"
"if {[$w compare $new < insert]} {\n"
"$w tag add sel $new insert\n"
"} else {\n"
"$w tag add sel insert $new\n"
"}\n"
"$w mark set anchor insert\n"
"} else {\n"
"if {[$w compare $new < anchor]} {\n"
"set first $new\n"
"set last anchor\n"
"} else {\n"
"set first anchor\n"
"set last $new\n"
"}\n"
"$w tag remove sel 1.0 $first\n"
"$w tag add sel $first $last\n"
"$w tag remove sel $last end\n"
"}\n"
"$w mark set insert $new\n"
"$w see insert\n"
"update idletasks\n"
"}\n"
"proc tkTextResetAnchor {w index} {\n"
"global tkPriv\n"
"if {![string compare [$w tag ranges sel] \"\"]} {\n"
"$w mark set anchor $index\n"
"return\n"
"}\n"
"set a [$w index $index]\n"
"set b [$w index sel.first]\n"
"set c [$w index sel.last]\n"
"if {[$w compare $a < $b]} {\n"
"$w mark set anchor sel.last\n"
"return\n"
"}\n"
"if {[$w compare $a > $c]} {\n"
"$w mark set anchor sel.first\n"
"return\n"
"}\n"
"scan $a \"%d.%d\" lineA chA\n"
"scan $b \"%d.%d\" lineB chB\n"
"scan $c \"%d.%d\" lineC chC\n"
"if {$lineB < $lineC+2} {\n"
"set total [string length [$w get $b $c]]\n"
"if {$total <= 2} {\n"
"return\n"
"}\n"
"if {[string length [$w get $b $a]] < ($total/2)} {\n"
"$w mark set anchor sel.last\n"
"} else {\n"
"$w mark set anchor sel.first\n"
"}\n"
"return\n"
"}\n"
"if {($lineA-$lineB) < ($lineC-$lineA)} {\n"
"$w mark set anchor sel.last\n"
"} else {\n"
"$w mark set anchor sel.first\n"
"}\n"
"}\n"
"proc tkTextInsert {w s} {\n"
"if {![string compare $s \"\"] ||\n"
"![string compare [$w cget -state] \"disabled\"]} {\n"
"return\n"
"}\n"
"catch {\n"
"if {[$w compare sel.first <= insert]\n"
"&& [$w compare sel.last >= insert]} {\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"$w insert insert $s\n"
"$w see insert\n"
"}\n"
"proc tkTextUpDownLine {w n} {\n"
"global tkPriv\n"
"set i [$w index insert]\n"
"scan $i \"%d.%d\" line char\n"
"if {[string compare $tkPriv(prevPos) $i] != 0} {\n"
"set tkPriv(char) $char\n"
"}\n"
"set new [$w index [expr {$line + $n}].$tkPriv(char)]\n"
"if {[$w compare $new == end] || [$w compare $new == \"insert linestart\"]} {\n"
"set new $i\n"
"}\n"
"set tkPriv(prevPos) $new\n"
"return $new\n"
"}\n"
"proc tkTextPrevPara {w pos} {\n"
"set pos [$w index \"$pos linestart\"]\n"
"while 1 {\n"
"if {(![string compare [$w get \"$pos - 1 line\"] \"\\n\"]\n"
"&& [string compare [$w get $pos] \"\\n\"])\n"
"|| ![string compare $pos \"1.0\"]} {\n"
"if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n"
"dummy index]} {\n"
"set pos [$w index \"$pos + [lindex $index 0] chars\"]\n"
"}\n"
"if {[$w compare $pos != insert] || ![string compare $pos 1.0]} {\n"
"return $pos\n"
"}\n"
"}\n"
"set pos [$w index \"$pos - 1 line\"]\n"
"}\n"
"}\n"
"proc tkTextNextPara {w start} {\n"
"set pos [$w index \"$start linestart + 1 line\"]\n"
"while {[string compare [$w get $pos] \"\\n\"]} {\n"
"if {[$w compare $pos == end]} {\n"
"return [$w index \"end - 1c\"]\n"
"}\n"
"set pos [$w index \"$pos + 1 line\"]\n"
"}\n"
"while {![string compare [$w get $pos] \"\\n\"]} {\n"
"set pos [$w index \"$pos + 1 line\"]\n"
"if {[$w compare $pos == end]} {\n"
"return [$w index \"end - 1c\"]\n"
"}\n"
"}\n"
"if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n"
"dummy index]} {\n"
"return [$w index \"$pos + [lindex $index 0] chars\"]\n"
"}\n"
"return $pos\n"
"}\n"
"proc tkTextScrollPages {w count} {\n"
"set bbox [$w bbox insert]\n"
"$w yview scroll $count pages\n"
"if {![string compare $bbox \"\"]} {\n"
"return [$w index @[expr {[winfo height $w]/2}],0]\n"
"}\n"
"return [$w index @[lindex $bbox 0],[lindex $bbox 1]]\n"
"}\n"
"proc tkTextTranspose w {\n"
"set pos insert\n"
"if {[$w compare $pos != \"$pos lineend\"]} {\n"
"set pos [$w index \"$pos + 1 char\"]\n"
"}\n"
"set new [$w get \"$pos - 1 char\"][$w get  \"$pos - 2 char\"]\n"
"if {[$w compare \"$pos - 1 char\" == 1.0]} {\n"
"return\n"
"}\n"
"$w delete \"$pos - 2 char\" $pos\n"
"$w insert insert $new\n"
"$w see insert\n"
"}\n"
"proc tk_textCopy w {\n"
"if {![catch {set data [$w get sel.first sel.last]}]} {\n"
"clipboard clear -displayof $w\n"
"clipboard append -displayof $w $data\n"
"}\n"
"}\n"
"proc tk_textCut w {\n"
"if {![catch {set data [$w get sel.first sel.last]}]} {\n"
"clipboard clear -displayof $w\n"
"clipboard append -displayof $w $data\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"proc tk_textPaste w {\n"
"global tcl_platform\n"
"catch {\n"
"if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
"catch {\n"
"$w delete sel.first sel.last\n"
"}\n"
"}\n"
"$w insert insert [selection get -displayof $w -selection CLIPBOARD]\n"
"}\n"
"}\n"
"if {![string compare $tcl_platform(platform) \"windows\"]}  {\n"
"proc tkTextNextWord {w start} {\n"
"tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \\\n"
"tcl_startOfNextWord\n"
"}\n"
"} else {\n"
"proc tkTextNextWord {w start} {\n"
"tkTextNextPos $w $start tcl_endOfWord\n"
"}\n"
"}\n"
"proc tkTextNextPos {w start op} {\n"
"set text \"\"\n"
"set cur $start\n"
"while {[$w compare $cur < end]} {\n"
"set text \"$text[$w get $cur \"$cur lineend + 1c\"]\"\n"
"set pos [$op $text 0]\n"
"if {$pos >= 0} {\n"
"return [$w index \"$start + $pos c\"]\n"
"}\n"
"set cur [$w index \"$cur lineend +1c\"]\n"
"}\n"
"return end\n"
"}\n"
"proc tkTextPrevPos {w start op} {\n"
"set text \"\"\n"
"set cur $start\n"
"while {[$w compare $cur > 0.0]} {\n"
"set text \"[$w get \"$cur linestart - 1c\" $cur]$text\"\n"
"set pos [$op $text end]\n"
"if {$pos >= 0} {\n"
"return [$w index \"$cur linestart - 1c + $pos c\"]\n"
"}\n"
"set cur [$w index \"$cur linestart - 1c\"]\n"
"}\n"
"return 0.0\n"
"}\n"
;
static char Et_zFile29[] = 
"package require -exact Tk 8.1\n"
"package require -exact Tcl 8.1\n"
"if {[info exists auto_path]} {\n"
"if {[lsearch -exact $auto_path $tk_library] < 0} {\n"
"lappend auto_path $tk_library\n"
"}\n"
"}\n"
"set tk_strictMotif 0\n"
"proc tkScreenChanged screen {\n"
"set x [string last . $screen]\n"
"if {$x > 0} {\n"
"set disp [string range $screen 0 [expr {$x - 1}]]\n"
"} else {\n"
"set disp $screen\n"
"}\n"
"uplevel #0 upvar #0 tkPriv.$disp tkPriv\n"
"global tkPriv\n"
"global tcl_platform\n"
"if {[info exists tkPriv]} {\n"
"set tkPriv(screen) $screen\n"
"return\n"
"}\n"
"array set tkPriv {\n"
"activeMenu      {}\n"
"activeItem      {}\n"
"afterId         {}\n"
"buttons         0\n"
"buttonWindow    {}\n"
"dragging        0\n"
"focus           {}\n"
"grab            {}\n"
"initPos         {}\n"
"inMenubutton    {}\n"
"listboxPrev     {}\n"
"menuBar         {}\n"
"mouseMoved      0\n"
"oldGrab         {}\n"
"popup           {}\n"
"postedMb        {}\n"
"pressX          0\n"
"pressY          0\n"
"prevPos         0\n"
"selectMode      char\n"
"}\n"
"set tkPriv(screen) $screen\n"
"if {[string compare $tcl_platform(platform) \"unix\"] == 0} {\n"
"set tkPriv(tearoff) 1\n"
"} else {\n"
"set tkPriv(tearoff) 0\n"
"}\n"
"set tkPriv(window) {}\n"
"}\n"
"tkScreenChanged [winfo screen .]\n"
"proc tkEventMotifBindings {n1 dummy dummy} {\n"
"upvar $n1 name\n"
"if {$name} {\n"
"set op delete\n"
"} else {\n"
"set op add\n"
"}\n"
"event $op <<Cut>> <Control-Key-w>\n"
"event $op <<Copy>> <Meta-Key-w> \n"
"event $op <<Paste>> <Control-Key-y>\n"
"}\n"
"if {![string compare [info commands tk_chooseColor] \"\"]} {\n"
"proc tk_chooseColor {args} {\n"
"return [eval tkColorDialog $args]\n"
"}\n"
"}\n"
"if {![string compare [info commands tk_getOpenFile] \"\"]} {\n"
"proc tk_getOpenFile {args} {\n"
"if {$::tk_strictMotif} {\n"
"return [eval tkMotifFDialog open $args]\n"
"} else {\n"
"return [eval tkFDialog open $args]\n"
"}\n"
"}\n"
"}\n"
"if {![string compare [info commands tk_getSaveFile] \"\"]} {\n"
"proc tk_getSaveFile {args} {\n"
"if {$::tk_strictMotif} {\n"
"return [eval tkMotifFDialog save $args]\n"
"} else {\n"
"return [eval tkFDialog save $args]\n"
"}\n"
"}\n"
"}\n"
"if {![string compare [info commands tk_messageBox] \"\"]} {\n"
"proc tk_messageBox {args} {\n"
"return [eval tkMessageBox $args]\n"
"}\n"
"}\n"
"switch $tcl_platform(platform) {\n"
"\"unix\" {\n"
"event add <<Cut>> <Control-Key-x> <Key-F20> \n"
"event add <<Copy>> <Control-Key-c> <Key-F16>\n"
"event add <<Paste>> <Control-Key-v> <Key-F18>\n"
"event add <<PasteSelection>> <ButtonRelease-2>\n"
"trace variable tk_strictMotif w tkEventMotifBindings\n"
"set tk_strictMotif $tk_strictMotif\n"
"}\n"
"\"windows\" {\n"
"event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>\n"
"event add <<Copy>> <Control-Key-c> <Control-Key-Insert>\n"
"event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>\n"
"event add <<PasteSelection>> <ButtonRelease-2>\n"
"}\n"
"\"macintosh\" {\n"
"event add <<Cut>> <Control-Key-x> <Key-F2> \n"
"event add <<Copy>> <Control-Key-c> <Key-F3>\n"
"event add <<Paste>> <Control-Key-v> <Key-F4>\n"
"event add <<PasteSelection>> <ButtonRelease-2>\n"
"event add <<Clear>> <Clear>\n"
"}\n"
"}\n"
"if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
"source [file join $tk_library button.tcl]\n"
"source [file join $tk_library entry.tcl]\n"
"source [file join $tk_library listbox.tcl]\n"
"source [file join $tk_library menu.tcl]\n"
"source [file join $tk_library scale.tcl]\n"
"source [file join $tk_library scrlbar.tcl]\n"
"source [file join $tk_library text.tcl]\n"
"}\n"
"bind all <Tab> {tkTabToWindow [tk_focusNext %W]}\n"
"bind all <Shift-Tab> {tkTabToWindow [tk_focusPrev %W]}\n"
"proc tkCancelRepeat {} {\n"
"global tkPriv\n"
"after cancel $tkPriv(afterId)\n"
"set tkPriv(afterId) {}\n"
"}\n"
"proc tkTabToWindow {w} {\n"
"if {![string compare [winfo class $w] Entry]} {\n"
"$w select range 0 end\n"
"$w icur end\n"
"}\n"
"focus $w\n"
"}\n"
;
static char Et_zFile30[] = 
"proc tkIconList {w args} {\n"
"upvar #0 $w data\n"
"tkIconList_Config $w $args\n"
"tkIconList_Create $w\n"
"}\n"
"proc tkIconList_Config {w argList} {\n"
"upvar #0 $w data\n"
"set specs {\n"
"{-browsecmd \"\" \"\" \"\"}\n"
"{-command \"\" \"\" \"\"}\n"
"}\n"
"tclParseConfigSpec $w $specs \"\" $argList\n"
"}\n"
"proc tkIconList_Create {w} {\n"
"upvar #0 $w data\n"
"frame $w\n"
"set data(sbar)   [scrollbar $w.sbar -orient horizontal \\\n"
"-highlightthickness 0 -takefocus 0]\n"
"set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \\\n"
"-width 400 -height 120 -takefocus 1]\n"
"pack $data(sbar) -side bottom -fill x -padx 2\n"
"pack $data(canvas) -expand yes -fill both\n"
"$data(sbar) config -command \"$data(canvas) xview\"\n"
"$data(canvas) config -xscrollcommand \"$data(sbar) set\"\n"
"set data(maxIW) 1\n"
"set data(maxIH) 1\n"
"set data(maxTW) 1\n"
"set data(maxTH) 1\n"
"set data(numItems) 0\n"
"set data(curItem)  {}\n"
"set data(noScroll) 1\n"
"bind $data(canvas) <Configure> \"tkIconList_Arrange $w\"\n"
"bind $data(canvas) <1>         \"tkIconList_Btn1 $w %x %y\"\n"
"bind $data(canvas) <B1-Motion> \"tkIconList_Motion1 $w %x %y\"\n"
"bind $data(canvas) <B1-Leave>  \"tkIconList_Leave1 $w %x %y\"\n"
"bind $data(canvas) <B1-Enter>  \"tkCancelRepeat\"\n"
"bind $data(canvas) <ButtonRelease-1> \"tkCancelRepeat\"\n"
"bind $data(canvas) <Double-ButtonRelease-1> \"tkIconList_Double1 $w %x %y\"\n"
"bind $data(canvas) <Up>        \"tkIconList_UpDown $w -1\"\n"
"bind $data(canvas) <Down>      \"tkIconList_UpDown $w  1\"\n"
"bind $data(canvas) <Left>      \"tkIconList_LeftRight $w -1\"\n"
"bind $data(canvas) <Right>     \"tkIconList_LeftRight $w  1\"\n"
"bind $data(canvas) <Return>    \"tkIconList_ReturnKey $w\"\n"
"bind $data(canvas) <KeyPress>  \"tkIconList_KeyPress $w %A\"\n"
"bind $data(canvas) <Control-KeyPress> \";\"\n"
"bind $data(canvas) <Alt-KeyPress>  \";\"\n"
"bind $data(canvas) <FocusIn>   \"tkIconList_FocusIn $w\"\n"
"return $w\n"
"}\n"
"proc tkIconList_AutoScan {w} {\n"
"upvar #0 $w data\n"
"global tkPriv\n"
"if {![winfo exists $w]} return\n"
"set x $tkPriv(x)\n"
"set y $tkPriv(y)\n"
"if {$data(noScroll)} {\n"
"return\n"
"}\n"
"if {$x >= [winfo width $data(canvas)]} {\n"
"$data(canvas) xview scroll 1 units\n"
"} elseif {$x < 0} {\n"
"$data(canvas) xview scroll -1 units\n"
"} elseif {$y >= [winfo height $data(canvas)]} {\n"
"} elseif {$y < 0} {\n"
"} else {\n"
"return\n"
"}\n"
"tkIconList_Motion1 $w $x $y\n"
"set tkPriv(afterId) [after 50 tkIconList_AutoScan $w]\n"
"}\n"
"proc tkIconList_DeleteAll {w} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"$data(canvas) delete all\n"
"catch {unset data(selected)}\n"
"catch {unset data(rect)}\n"
"catch {unset data(list)}\n"
"catch {unset itemList}\n"
"set data(maxIW) 1\n"
"set data(maxIH) 1\n"
"set data(maxTW) 1\n"
"set data(maxTH) 1\n"
"set data(numItems) 0\n"
"set data(curItem)  {}\n"
"set data(noScroll) 1\n"
"$data(sbar) set 0.0 1.0\n"
"$data(canvas) xview moveto 0\n"
"}\n"
"proc tkIconList_Add {w image text} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"upvar #0 $w:textList textList\n"
"set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]\n"
"set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \\\n"
"-font $data(font)]\n"
"set rTag [$data(canvas) create rect  0 0 0 0 -fill \"\" -outline \"\"]\n"
"set b [$data(canvas) bbox $iTag]\n"
"set iW [expr {[lindex $b 2]-[lindex $b 0]}]\n"
"set iH [expr {[lindex $b 3]-[lindex $b 1]}]\n"
"if {$data(maxIW) < $iW} {\n"
"set data(maxIW) $iW\n"
"}\n"
"if {$data(maxIH) < $iH} {\n"
"set data(maxIH) $iH\n"
"}\n"
"set b [$data(canvas) bbox $tTag]\n"
"set tW [expr {[lindex $b 2]-[lindex $b 0]}]\n"
"set tH [expr {[lindex $b 3]-[lindex $b 1]}]\n"
"if {$data(maxTW) < $tW} {\n"
"set data(maxTW) $tW\n"
"}\n"
"if {$data(maxTH) < $tH} {\n"
"set data(maxTH) $tH\n"
"}\n"
"lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]\n"
"set itemList($rTag) [list $iTag $tTag $text $data(numItems)]\n"
"set textList($data(numItems)) [string tolower $text]\n"
"incr data(numItems)\n"
"}\n"
"proc tkIconList_Arrange {w} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {\n"
"set data(noScroll) 1\n"
"$data(sbar) config -command \"\"\n"
"}\n"
"return\n"
"}\n"
"set W [winfo width  $data(canvas)]\n"
"set H [winfo height $data(canvas)]\n"
"set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n"
"[$data(canvas) cget -bd]}]\n"
"if {$pad < 2} {\n"
"set pad 2\n"
"}\n"
"incr W -[expr {$pad*2}]\n"
"incr H -[expr {$pad*2}]\n"
"set dx [expr {$data(maxIW) + $data(maxTW) + 8}]\n"
"if {$data(maxTH) > $data(maxIH)} {\n"
"set dy $data(maxTH)\n"
"} else {\n"
"set dy $data(maxIH)\n"
"}\n"
"incr dy 2\n"
"set shift [expr {$data(maxIW) + 4}]\n"
"set x [expr {$pad * 2}]\n"
"set y [expr {$pad * 1}] ; # Why * 1 ?\n"
"set usedColumn 0\n"
"foreach sublist $data(list) {\n"
"set usedColumn 1\n"
"set iTag [lindex $sublist 0]\n"
"set tTag [lindex $sublist 1]\n"
"set rTag [lindex $sublist 2]\n"
"set iW   [lindex $sublist 3]\n"
"set iH   [lindex $sublist 4]\n"
"set tW   [lindex $sublist 5]\n"
"set tH   [lindex $sublist 6]\n"
"set i_dy [expr {($dy - $iH)/2}]\n"
"set t_dy [expr {($dy - $tH)/2}]\n"
"$data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]\n"
"$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]\n"
"$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]\n"
"$data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]\n"
"incr y $dy\n"
"if {($y + $dy) > $H} {\n"
"set y [expr {$pad * 1}] ; # *1 ?\n"
"incr x $dx\n"
"set usedColumn 0\n"
"}\n"
"}\n"
"if {$usedColumn} {\n"
"set sW [expr {$x + $dx}]\n"
"} else {\n"
"set sW $x\n"
"}\n"
"if {$sW < $W} {\n"
"$data(canvas) config -scrollregion \"$pad $pad $sW $H\"\n"
"$data(sbar) config -command \"\"\n"
"$data(canvas) xview moveto 0\n"
"set data(noScroll) 1\n"
"} else {\n"
"$data(canvas) config -scrollregion \"$pad $pad $sW $H\"\n"
"$data(sbar) config -command \"$data(canvas) xview\"\n"
"set data(noScroll) 0\n"
"}\n"
"set data(itemsPerColumn) [expr {($H-$pad)/$dy}]\n"
"if {$data(itemsPerColumn) < 1} {\n"
"set data(itemsPerColumn) 1\n"
"}\n"
"if {$data(curItem) != {}} {\n"
"tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0\n"
"}\n"
"}\n"
"proc tkIconList_Invoke {w} {\n"
"upvar #0 $w data\n"
"if {[string compare $data(-command) \"\"] && [info exists data(selected)]} {\n"
"eval $data(-command)\n"
"}\n"
"}\n"
"proc tkIconList_See {w rTag} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"if {$data(noScroll)} {\n"
"return\n"
"}\n"
"set sRegion [$data(canvas) cget -scrollregion]\n"
"if {![string compare $sRegion {}]} {\n"
"return\n"
"}\n"
"if {![info exists itemList($rTag)]} {\n"
"return\n"
"}\n"
"set bbox [$data(canvas) bbox $rTag]\n"
"set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n"
"[$data(canvas) cget -bd]}]\n"
"set x1 [lindex $bbox 0]\n"
"set x2 [lindex $bbox 2]\n"
"incr x1 -[expr {$pad * 2}]\n"
"incr x2 -[expr {$pad * 1}] ; # *1 ?\n"
"set cW [expr {[winfo width $data(canvas)] - $pad*2}]\n"
"set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]\n"
"set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]\n"
"set oldDispX $dispX\n"
"if {($x2 - $dispX) >= $cW} {\n"
"set dispX [expr {$x2 - $cW}]\n"
"}\n"
"if {($x1 - $dispX) < 0} {\n"
"set dispX $x1\n"
"}\n"
"if {$oldDispX != $dispX} {\n"
"set fraction [expr {double($dispX)/double($scrollW)}]\n"
"$data(canvas) xview moveto $fraction\n"
"}\n"
"}\n"
"proc tkIconList_SelectAtXY {w x y} {\n"
"upvar #0 $w data\n"
"tkIconList_Select $w [$data(canvas) find closest \\\n"
"[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]\n"
"}\n"
"proc tkIconList_Select {w rTag {callBrowse 1}} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:itemList itemList\n"
"if {![info exists itemList($rTag)]} {\n"
"return\n"
"}\n"
"set iTag   [lindex $itemList($rTag) 0]\n"
"set tTag   [lindex $itemList($rTag) 1]\n"
"set text   [lindex $itemList($rTag) 2]\n"
"set serial [lindex $itemList($rTag) 3]\n"
"if {![info exists data(rect)]} {\n"
"set data(rect) [$data(canvas) create rect 0 0 0 0 \\\n"
"-fill #a0a0ff -outline #a0a0ff]\n"
"}\n"
"$data(canvas) lower $data(rect)\n"
"set bbox [$data(canvas) bbox $tTag]\n"
"eval $data(canvas) coords $data(rect) $bbox\n"
"set data(curItem) $serial\n"
"set data(selected) $text\n"
"if {$callBrowse} {\n"
"if {[string compare $data(-browsecmd) \"\"]} {\n"
"eval $data(-browsecmd) [list $text]\n"
"}\n"
"}\n"
"}\n"
"proc tkIconList_Unselect {w} {\n"
"upvar #0 $w data\n"
"if {[info exists data(rect)]} {\n"
"$data(canvas) delete $data(rect)\n"
"unset data(rect)\n"
"}\n"
"if {[info exists data(selected)]} {\n"
"unset data(selected)\n"
"}\n"
"set data(curItem)  {}\n"
"}\n"
"proc tkIconList_Get {w} {\n"
"upvar #0 $w data\n"
"if {[info exists data(selected)]} {\n"
"return $data(selected)\n"
"} else {\n"
"return \"\"\n"
"}\n"
"}\n"
"proc tkIconList_Btn1 {w x y} {\n"
"upvar #0 $w data\n"
"focus $data(canvas)\n"
"tkIconList_SelectAtXY $w $x $y\n"
"}\n"
"proc tkIconList_Motion1 {w x y} {\n"
"global tkPriv\n"
"set tkPriv(x) $x\n"
"set tkPriv(y) $y\n"
"tkIconList_SelectAtXY $w $x $y\n"
"}\n"
"proc tkIconList_Double1 {w x y} {\n"
"upvar #0 $w data\n"
"if {$data(curItem) != {}} {\n"
"tkIconList_Invoke $w\n"
"}\n"
"}\n"
"proc tkIconList_ReturnKey {w} {\n"
"tkIconList_Invoke $w\n"
"}\n"
"proc tkIconList_Leave1 {w x y} {\n"
"global tkPriv\n"
"set tkPriv(x) $x\n"
"set tkPriv(y) $y\n"
"tkIconList_AutoScan $w\n"
"}\n"
"proc tkIconList_FocusIn {w} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {$data(curItem) == {}} {\n"
"set rTag [lindex [lindex $data(list) 0] 2]\n"
"tkIconList_Select $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_UpDown {w amount} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {$data(curItem) == {}} {\n"
"set rTag [lindex [lindex $data(list) 0] 2]\n"
"} else {\n"
"set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]\n"
"set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]\n"
"if {![string compare $rTag \"\"]} {\n"
"set rTag $oldRTag\n"
"}\n"
"}\n"
"if {[string compare $rTag \"\"]} {\n"
"tkIconList_Select $w $rTag\n"
"tkIconList_See $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_LeftRight {w amount} {\n"
"upvar #0 $w data\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {$data(curItem) == {}} {\n"
"set rTag [lindex [lindex $data(list) 0] 2]\n"
"} else {\n"
"set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]\n"
"set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]\n"
"set rTag [lindex [lindex $data(list) $newItem] 2]\n"
"if {![string compare $rTag \"\"]} {\n"
"set rTag $oldRTag\n"
"}\n"
"}\n"
"if {[string compare $rTag \"\"]} {\n"
"tkIconList_Select $w $rTag\n"
"tkIconList_See $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_KeyPress {w key} {\n"
"global tkPriv\n"
"append tkPriv(ILAccel,$w) $key\n"
"tkIconList_Goto $w $tkPriv(ILAccel,$w)\n"
"catch {\n"
"after cancel $tkPriv(ILAccel,$w,afterId)\n"
"}\n"
"set tkPriv(ILAccel,$w,afterId) [after 500 tkIconList_Reset $w]\n"
"}\n"
"proc tkIconList_Goto {w text} {\n"
"upvar #0 $w data\n"
"upvar #0 $w:textList textList\n"
"global tkPriv\n"
"if {![info exists data(list)]} {\n"
"return\n"
"}\n"
"if {[string length $text] == 0} {\n"
"return\n"
"}\n"
"if {$data(curItem) == {} || $data(curItem) == 0} {\n"
"set start  0\n"
"} else {\n"
"set start  $data(curItem)\n"
"}\n"
"set text [string tolower $text]\n"
"set theIndex -1\n"
"set less 0\n"
"set len [string length $text]\n"
"set len0 [expr {$len-1}]\n"
"set i $start\n"
"while 1 {\n"
"set sub [string range $textList($i) 0 $len0]\n"
"if {[string compare $text $sub] == 0} {\n"
"set theIndex $i\n"
"break\n"
"}\n"
"incr i\n"
"if {$i == $data(numItems)} {\n"
"set i 0\n"
"}\n"
"if {$i == $start} {\n"
"break\n"
"}\n"
"}\n"
"if {$theIndex > -1} {\n"
"set rTag [lindex [lindex $data(list) $theIndex] 2]\n"
"tkIconList_Select $w $rTag 0\n"
"tkIconList_See $w $rTag\n"
"}\n"
"}\n"
"proc tkIconList_Reset {w} {\n"
"global tkPriv\n"
"catch {unset tkPriv(ILAccel,$w)}\n"
"}\n"
"proc tkFDialog {type args} {\n"
"global tkPriv\n"
"set dataName __tk_filedialog\n"
"upvar #0 $dataName data\n"
"tkFDialog_Config $dataName $type $args\n"
"if {![string compare $data(-parent) .]} {\n"
"set w .$dataName\n"
"} else {\n"
"set w $data(-parent).$dataName\n"
"}\n"
"if {![winfo exists $w]} {\n"
"tkFDialog_Create $w\n"
"} elseif {[string compare [winfo class $w] TkFDialog]} {\n"
"destroy $w\n"
"tkFDialog_Create $w\n"
"} else {\n"
"set data(dirMenuBtn) $w.f1.menu\n"
"set data(dirMenu) $w.f1.menu.menu\n"
"set data(upBtn) $w.f1.up\n"
"set data(icons) $w.icons\n"
"set data(ent) $w.f2.ent\n"
"set data(typeMenuLab) $w.f3.lab\n"
"set data(typeMenuBtn) $w.f3.menu\n"
"set data(typeMenu) $data(typeMenuBtn).m\n"
"set data(okBtn) $w.f2.ok\n"
"set data(cancelBtn) $w.f3.cancel\n"
"}\n"
"wm transient $w $data(-parent)\n"
"trace variable data(selectPath) w \"tkFDialog_SetPath $w\"\n"
"if {$data(-filetypes) != {}} {\n"
"$data(typeMenu) delete 0 end\n"
"foreach type $data(-filetypes) {\n"
"set title  [lindex $type 0]\n"
"set filter [lindex $type 1]\n"
"$data(typeMenu) add command -label $title \\\n"
"-command [list tkFDialog_SetFilter $w $type]\n"
"}\n"
"tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]\n"
"$data(typeMenuBtn) config -state normal\n"
"$data(typeMenuLab) config -state normal\n"
"} else {\n"
"set data(filter) \"*\"\n"
"$data(typeMenuBtn) config -state disabled -takefocus 0\n"
"$data(typeMenuLab) config -state disabled\n"
"}\n"
"tkFDialog_UpdateWhenIdle $w\n"
"wm withdraw $w\n"
"update idletasks\n"
"set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
"- [winfo vrootx [winfo parent $w]]}]\n"
"set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"- [winfo vrooty [winfo parent $w]]}]\n"
"wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y\n"
"wm deiconify $w\n"
"wm title $w $data(-title)\n"
"set oldFocus [focus]\n"
"set oldGrab [grab current $w]\n"
"if {$oldGrab != \"\"} {\n"
"set grabStatus [grab status $oldGrab]\n"
"}\n"
"grab $w\n"
"focus $data(ent)\n"
"$data(ent) delete 0 end\n"
"$data(ent) insert 0 $data(selectFile)\n"
"$data(ent) select from 0\n"
"$data(ent) select to   end\n"
"$data(ent) icursor end\n"
"tkwait variable tkPriv(selectFilePath)\n"
"catch {focus $oldFocus}\n"
"grab release $w\n"
"wm withdraw $w\n"
"if {$oldGrab != \"\"} {\n"
"if {$grabStatus == \"global\"} {\n"
"grab -global $oldGrab\n"
"} else {\n"
"grab $oldGrab\n"
"}\n"
"}\n"
"return $tkPriv(selectFilePath)\n"
"}\n"
"proc tkFDialog_Config {dataName type argList} {\n"
"upvar #0 $dataName data\n"
"set data(type) $type\n"
"foreach trace [trace vinfo data(selectPath)] {\n"
"trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]\n"
"}\n"
"set specs {\n"
"{-defaultextension \"\" \"\" \"\"}\n"
"{-filetypes \"\" \"\" \"\"}\n"
"{-initialdir \"\" \"\" \"\"}\n"
"{-initialfile \"\" \"\" \"\"}\n"
"{-parent \"\" \"\" \".\"}\n"
"{-title \"\" \"\" \"\"}\n"
"}\n"
"if {![info exists data(selectPath)]} {\n"
"set data(selectPath) [pwd]\n"
"set data(selectFile) \"\"\n"
"}\n"
"tclParseConfigSpec $dataName $specs \"\" $argList\n"
"if {![string compare $data(-title) \"\"]} {\n"
"if {![string compare $type \"open\"]} {\n"
"set data(-title) \"Open\"\n"
"} else {\n"
"set data(-title) \"Save As\"\n"
"}\n"
"}\n"
"if {[string compare $data(-initialdir) \"\"]} {\n"
"if {[file isdirectory $data(-initialdir)]} {\n"
"set data(selectPath) [lindex [glob $data(-initialdir)] 0]\n"
"} else {\n"
"set data(selectPath) [pwd]\n"
"}\n"
"set old [pwd]\n"
"cd $data(selectPath)\n"
"set data(selectPath) [pwd]\n"
"cd $old\n"
"}\n"
"set data(selectFile) $data(-initialfile)\n"
"set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]\n"
"if {![winfo exists $data(-parent)]} {\n"
"error \"bad window path name \\\"$data(-parent)\\\"\"\n"
"}\n"
"}\n"
"proc tkFDialog_Create {w} {\n"
"set dataName [lindex [split $w .] end]\n"
"upvar #0 $dataName data\n"
"global tk_library\n"
"toplevel $w -class TkFDialog\n"
"set f1 [frame $w.f1]\n"
"label $f1.lab -text \"Directory:\" -under 0\n"
"set data(dirMenuBtn) $f1.menu\n"
"set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] \"\"]\n"
"set data(upBtn) [button $f1.up]\n"
"if {![info exists tkPriv(updirImage)]} {\n"
"set tkPriv(updirImage) [image create bitmap -data {\n"
"#define updir_width 28\n"
"#define updir_height 16\n"
"static char updir_bits[] = {\n"
"0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,\n"
"0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,\n"
"0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,\n"
"0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,\n"
"0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,\n"
"0xf0, 0xff, 0xff, 0x01};}]\n"
"}\n"
"$data(upBtn) config -image $tkPriv(updirImage)\n"
"$f1.menu config -takefocus 1 -highlightthickness 2\n"
"pack $data(upBtn) -side right -padx 4 -fill both\n"
"pack $f1.lab -side left -padx 4 -fill both\n"
"pack $f1.menu -expand yes -fill both -padx 4\n"
"set data(icons) [tkIconList $w.icons \\\n"
"-browsecmd \"tkFDialog_ListBrowse $w\" \\\n"
"-command   \"tkFDialog_OkCmd $w\"]\n"
"set f2 [frame $w.f2 -bd 0]\n"
"label $f2.lab -text \"File name:\" -anchor e -width 14 -under 5 -pady 0\n"
"set data(ent) [entry $f2.ent]\n"
"global $w.icons\n"
"set $w.icons(font) [$data(ent) cget -font]\n"
"set f3 [frame $w.f3 -bd 0]\n"
"set data(typeMenuLab) [button $f3.lab -text \"Files of type:\" \\\n"
"-anchor e -width 14 -under 9 \\\n"
"-bd [$f2.lab cget -bd] \\\n"
"-highlightthickness [$f2.lab cget -highlightthickness] \\\n"
"-relief [$f2.lab cget -relief] \\\n"
"-padx [$f2.lab cget -padx] \\\n"
"-pady [$f2.lab cget -pady]]\n"
"bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \\\n"
"[winfo toplevel $data(typeMenuLab)] all]\n"
"set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 -menu $f3.menu.m]\n"
"set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]\n"
"$data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \\\n"
"-relief raised -bd 2 -anchor w\n"
"set data(okBtn)     [button $f2.ok     -text OK     -under 0 -width 6 \\\n"
"-default active -pady 3]\n"
"set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\\\n"
"-default normal -pady 3]\n"
"pack $data(okBtn) -side right -padx 4 -anchor e\n"
"pack $f2.lab -side left -padx 4\n"
"pack $f2.ent -expand yes -fill x -padx 2 -pady 0\n"
"pack $data(cancelBtn) -side right -padx 4 -anchor w\n"
"pack $data(typeMenuLab) -side left -padx 4\n"
"pack $data(typeMenuBtn) -expand yes -fill x -side right\n"
"pack $f1 -side top -fill x -pady 4\n"
"pack $f3 -side bottom -fill x\n"
"pack $f2 -side bottom -fill x\n"
"pack $data(icons) -expand yes -fill both -padx 4 -pady 1\n"
"bind $data(ent) <Return>  \"tkFDialog_ActivateEnt $w\"\n"
"$data(upBtn)     config -command \"tkFDialog_UpDirCmd $w\"\n"
"$data(okBtn)     config -command \"tkFDialog_OkCmd $w\"\n"
"$data(cancelBtn) config -command \"tkFDialog_CancelCmd $w\"\n"
"bind $w <Alt-d> \"focus $data(dirMenuBtn)\"\n"
"bind $w <Alt-t> [format {\n"
"if {\"[%s cget -state]\" == \"normal\"} {\n"
"focus %s\n"
"}\n"
"} $data(typeMenuBtn) $data(typeMenuBtn)]\n"
"bind $w <Alt-n> \"focus $data(ent)\"\n"
"bind $w <KeyPress-Escape> \"tkButtonInvoke $data(cancelBtn)\"\n"
"bind $w <Alt-c> \"tkButtonInvoke $data(cancelBtn)\"\n"
"bind $w <Alt-o> \"tkFDialog_InvokeBtn $w Open\"\n"
"bind $w <Alt-s> \"tkFDialog_InvokeBtn $w Save\"\n"
"wm protocol $w WM_DELETE_WINDOW \"tkFDialog_CancelCmd $w\"\n"
"tkFocusGroup_Create $w\n"
"tkFocusGroup_BindIn $w  $data(ent) \"tkFDialog_EntFocusIn $w\"\n"
"tkFocusGroup_BindOut $w $data(ent) \"tkFDialog_EntFocusOut $w\"\n"
"}\n"
"proc tkFDialog_UpdateWhenIdle {w} {\n"
"upvar #0 [winfo name $w] data\n"
"if {[info exists data(updateId)]} {\n"
"return\n"
"} else {\n"
"set data(updateId) [after idle tkFDialog_Update $w]\n"
"}\n"
"}\n"
"proc tkFDialog_Update {w} {\n"
"if {![winfo exists $w] || [string compare [winfo class $w] TkFDialog]} {\n"
"return\n"
"}\n"
"set dataName [winfo name $w]\n"
"upvar #0 $dataName data\n"
"global tk_library tkPriv\n"
"catch {unset data(updateId)}\n"
"if {![info exists tkPriv(folderImage)]} {\n"
"set tkPriv(folderImage) [image create photo -data {\n"
"R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB\n"
"QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]\n"
"set tkPriv(fileImage)   [image create photo -data {\n"
"R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO\n"
"rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]\n"
"}\n"
"set folder $tkPriv(folderImage)\n"
"set file   $tkPriv(fileImage)\n"
"set appPWD [pwd]\n"
"if {[catch {\n"
"cd $data(selectPath)\n"
"}]} {\n"
"tk_messageBox -type ok -parent $data(-parent) -message \\\n"
"\"Cannot change to the directory \\\"$data(selectPath)\\\".\\nPermission denied.\"\\\n"
"-icon warning\n"
"cd $appPWD\n"
"return\n"
"}\n"
"set entCursor [$data(ent) cget -cursor]\n"
"set dlgCursor [$w         cget -cursor]\n"
"$data(ent) config -cursor watch\n"
"$w         config -cursor watch\n"
"update idletasks\n"
"tkIconList_DeleteAll $data(icons)\n"
"foreach f [lsort -dictionary [glob -nocomplain .* *]] {\n"
"if {![string compare $f .]} {\n"
"continue\n"
"}\n"
"if {![string compare $f ..]} {\n"
"continue\n"
"}\n"
"if {[file isdir ./$f]} {\n"
"if {![info exists hasDoneDir($f)]} {\n"
"tkIconList_Add $data(icons) $folder $f\n"
"set hasDoneDir($f) 1\n"
"}\n"
"}\n"
"}\n"
"if {![string compare $data(filter) *]} {\n"
"set files [lsort -dictionary \\\n"
"[glob -nocomplain .* *]]\n"
"} else {\n"
"set files [lsort -dictionary \\\n"
"[eval glob -nocomplain $data(filter)]]\n"
"}\n"
"set top 0\n"
"foreach f $files {\n"
"if {![file isdir ./$f]} {\n"
"if {![info exists hasDoneFile($f)]} {\n"
"tkIconList_Add $data(icons) $file $f\n"
"set hasDoneFile($f) 1\n"
"}\n"
"}\n"
"}\n"
"tkIconList_Arrange $data(icons)\n"
"set list \"\"\n"
"set dir \"\"\n"
"foreach subdir [file split $data(selectPath)] {\n"
"set dir [file join $dir $subdir]\n"
"lappend list $dir\n"
"}\n"
"$data(dirMenu) delete 0 end\n"
"set var [format %s(selectPath) $dataName]\n"
"foreach path $list {\n"
"$data(dirMenu) add command -label $path -command [list set $var $path]\n"
"}\n"
"cd $appPWD\n"
"if {![string compare $data(type) open]} {\n"
"$data(okBtn) config -text \"Open\"\n"
"} else {\n"
"$data(okBtn) config -text \"Save\"\n"
"}\n"
"$data(ent) config -cursor $entCursor\n"
"$w         config -cursor $dlgCursor\n"
"}\n"
"proc tkFDialog_SetPathSilently {w path} {\n"
"upvar #0 [winfo name $w] data\n"
"trace vdelete  data(selectPath) w \"tkFDialog_SetPath $w\"\n"
"set data(selectPath) $path\n"
"trace variable data(selectPath) w \"tkFDialog_SetPath $w\"\n"
"}\n"
"proc tkFDialog_SetPath {w name1 name2 op} {\n"
"if {[winfo exists $w]} {\n"
"upvar #0 [winfo name $w] data\n"
"tkFDialog_UpdateWhenIdle $w\n"
"}\n"
"}\n"
"proc tkFDialog_SetFilter {w type} {\n"
"upvar #0 [winfo name $w] data\n"
"upvar \\#0 $data(icons) icons\n"
"set data(filter) [lindex $type 1]\n"
"$data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1\n"
"$icons(sbar) set 0.0 0.0\n"
"tkFDialog_UpdateWhenIdle $w\n"
"}\n"
"proc tkFDialogResolveFile {context text defaultext} {\n"
"set appPWD [pwd]\n"
"set path [tkFDialog_JoinFile $context $text]\n"
"if {[file ext $path] == \"\"} {\n"
"set path \"$path$defaultext\"\n"
"}\n"
"if {[catch {file exists $path}]} {\n"
"return [list ERROR $path \"\"]\n"
"}\n"
"if {[file exists $path]} {\n"
"if {[file isdirectory $path]} {\n"
"if {[catch {\n"
"cd $path\n"
"}]} {\n"
"return [list CHDIR $path \"\"]\n"
"}\n"
"set directory [pwd]\n"
"set file \"\"\n"
"set flag OK\n"
"cd $appPWD\n"
"} else {\n"
"if {[catch {\n"
"cd [file dirname $path]\n"
"}]} {\n"
"return [list CHDIR [file dirname $path] \"\"]\n"
"}\n"
"set directory [pwd]\n"
"set file [file tail $path]\n"
"set flag OK\n"
"cd $appPWD\n"
"}\n"
"} else {\n"
"set dirname [file dirname $path]\n"
"if {[file exists $dirname]} {\n"
"if {[catch {\n"
"cd $dirname\n"
"}]} {\n"
"return [list CHDIR $dirname \"\"]\n"
"}\n"
"set directory [pwd]\n"
"set file [file tail $path]\n"
"if {[regexp {[*]|[?]} $file]} {\n"
"set flag PATTERN\n"
"} else {\n"
"set flag FILE\n"
"}\n"
"cd $appPWD\n"
"} else {\n"
"set directory $dirname\n"
"set file [file tail $path]\n"
"set flag PATH\n"
"}\n"
"}\n"
"return [list $flag $directory $file]\n"
"}\n"
"proc tkFDialog_EntFocusIn {w} {\n"
"upvar #0 [winfo name $w] data\n"
"if {[string compare [$data(ent) get] \"\"]} {\n"
"$data(ent) selection from 0\n"
"$data(ent) selection to   end\n"
"$data(ent) icursor end\n"
"} else {\n"
"$data(ent) selection clear\n"
"}\n"
"tkIconList_Unselect $data(icons)\n"
"if {![string compare $data(type) open]} {\n"
"$data(okBtn) config -text \"Open\"\n"
"} else {\n"
"$data(okBtn) config -text \"Save\"\n"
"}\n"
"}\n"
"proc tkFDialog_EntFocusOut {w} {\n"
"upvar #0 [winfo name $w] data\n"
"$data(ent) selection clear\n"
"}\n"
"proc tkFDialog_ActivateEnt {w} {\n"
"upvar #0 [winfo name $w] data\n"
"set text [string trim [$data(ent) get]]\n"
"set list [tkFDialogResolveFile $data(selectPath) $text \\\n"
"$data(-defaultextension)]\n"
"set flag [lindex $list 0]\n"
"set path [lindex $list 1]\n"
"set file [lindex $list 2]\n"
"switch -- $flag {\n"
"OK {\n"
"if {![string compare $file \"\"]} {\n"
"set data(selectPath) $path\n"
"$data(ent) delete 0 end\n"
"} else {\n"
"tkFDialog_SetPathSilently $w $path\n"
"set data(selectFile) $file\n"
"tkFDialog_Done $w\n"
"}\n"
"}\n"
"PATTERN {\n"
"set data(selectPath) $path\n"
"set data(filter) $file\n"
"}\n"
"FILE {\n"
"if {![string compare $data(type) open]} {\n"
"tk_messageBox -icon warning -type ok -parent $data(-parent) \\\n"
"-message \"File \\\"[file join $path $file]\\\" does not exist.\"\n"
"$data(ent) select from 0\n"
"$data(ent) select to   end\n"
"$data(ent) icursor end\n"
"} else {\n"
"tkFDialog_SetPathSilently $w $path\n"
"set data(selectFile) $file\n"
"tkFDialog_Done $w\n"
"}\n"
"}\n"
"PATH {\n"
"tk_messageBox -icon warning -type ok -parent $data(-parent) \\\n"
"-message \"Directory \\\"$path\\\" does not exist.\"\n"
"$data(ent) select from 0\n"
"$data(ent) select to   end\n"
"$data(ent) icursor end\n"
"}\n"
"CHDIR {\n"
"tk_messageBox -type ok -parent $data(-parent) -message \\\n"
"\"Cannot change to the directory \\\"$path\\\".\\nPermission denied.\"\\\n"
"-icon warning\n"
"$data(ent) select from 0\n"
"$data(ent) select to   end\n"
"$data(ent) icursor end\n"
"}\n"
"ERROR {\n"
"tk_messageBox -type ok -parent $data(-parent) -message \\\n"
"\"Invalid file name \\\"$path\\\".\"\\\n"
"-icon warning\n"
"$data(ent) select from 0\n"
"$data(ent) select to   end\n"
"$data(ent) icursor end\n"
"}\n"
"}\n"
"}\n"
"proc tkFDialog_InvokeBtn {w key} {\n"
"upvar #0 [winfo name $w] data\n"
"if {![string compare [$data(okBtn) cget -text] $key]} {\n"
"tkButtonInvoke $data(okBtn)\n"
"}\n"
"}\n"
"proc tkFDialog_UpDirCmd {w} {\n"
"upvar #0 [winfo name $w] data\n"
"if {[string compare $data(selectPath) \"/\"]} {\n"
"set data(selectPath) [file dirname $data(selectPath)]\n"
"}\n"
"}\n"
"proc tkFDialog_JoinFile {path file} {\n"
"if {[string match {~*} $file] && [file exists $path/$file]} {\n"
"return [file join $path ./$file]\n"
"} else {\n"
"return [file join $path $file]\n"
"}\n"
"}\n"
"proc tkFDialog_OkCmd {w} {\n"
"upvar #0 [winfo name $w] data\n"
"set text [tkIconList_Get $data(icons)]\n"
"if {[string compare $text \"\"]} {\n"
"set file [tkFDialog_JoinFile $data(selectPath) $text]\n"
"if {[file isdirectory $file]} {\n"
"tkFDialog_ListInvoke $w $text\n"
"return\n"
"}\n"
"}\n"
"tkFDialog_ActivateEnt $w\n"
"}\n"
"proc tkFDialog_CancelCmd {w} {\n"
"upvar #0 [winfo name $w] data\n"
"global tkPriv\n"
"set tkPriv(selectFilePath) \"\"\n"
"}\n"
"proc tkFDialog_ListBrowse {w text} {\n"
"upvar #0 [winfo name $w] data\n"
"if {$text == \"\"} {\n"
"return\n"
"}\n"
"set file [tkFDialog_JoinFile $data(selectPath) $text]\n"
"if {![file isdirectory $file]} {\n"
"$data(ent) delete 0 end\n"
"$data(ent) insert 0 $text\n"
"if {![string compare $data(type) open]} {\n"
"$data(okBtn) config -text \"Open\"\n"
"} else {\n"
"$data(okBtn) config -text \"Save\"\n"
"}\n"
"} else {\n"
"$data(okBtn) config -text \"Open\"\n"
"}\n"
"}\n"
"proc tkFDialog_ListInvoke {w text} {\n"
"upvar #0 [winfo name $w] data\n"
"if {$text == \"\"} {\n"
"return\n"
"}\n"
"set file [tkFDialog_JoinFile $data(selectPath) $text]\n"
"if {[file isdirectory $file]} {\n"
"set appPWD [pwd]\n"
"if {[catch {cd $file}]} {\n"
"tk_messageBox -type ok -parent $data(-parent) -message \\\n"
"\"Cannot change to the directory \\\"$file\\\".\\nPermission denied.\"\\\n"
"-icon warning\n"
"} else {\n"
"cd $appPWD\n"
"set data(selectPath) $file\n"
"}\n"
"} else {\n"
"set data(selectFile) $file\n"
"tkFDialog_Done $w\n"
"}\n"
"}\n"
"proc tkFDialog_Done {w {selectFilePath \"\"}} {\n"
"upvar #0 [winfo name $w] data\n"
"global tkPriv\n"
"if {![string compare $selectFilePath \"\"]} {\n"
"set selectFilePath [tkFDialog_JoinFile $data(selectPath) \\\n"
"$data(selectFile)]\n"
"set tkPriv(selectFile)     $data(selectFile)\n"
"set tkPriv(selectPath)     $data(selectPath)\n"
"if {[file exists $selectFilePath] && \n"
"![string compare $data(type) save]} {\n"
"set reply [tk_messageBox -icon warning -type yesno\\\n"
"-parent $data(-parent) -message \"File\\\n"
"\\\"$selectFilePath\\\" already exists.\\nDo\\\n"
"you want to overwrite it?\"]\n"
"if {![string compare $reply \"no\"]} {\n"
"return\n"
"}\n"
"}\n"
"}\n"
"set tkPriv(selectFilePath) $selectFilePath\n"
"}\n"
;
static char Et_zFile31[] = 
"proc tkMotifFDialog {type args} {\n"
"global tkPriv\n"
"set dataName __tk_filedialog\n"
"upvar #0 $dataName data\n"
"set w [tkMotifFDialog_Create $dataName $type $args]\n"
"set oldFocus [focus]\n"
"set oldGrab [grab current $w]\n"
"if {$oldGrab != \"\"} {\n"
"set grabStatus [grab status $oldGrab]\n"
"}\n"
"grab $w\n"
"focus $data(sEnt)\n"
"$data(sEnt) select from 0\n"
"$data(sEnt) select to   end\n"
"tkwait variable tkPriv(selectFilePath)\n"
"catch {focus $oldFocus}\n"
"grab release $w\n"
"wm withdraw $w\n"
"if {$oldGrab != \"\"} {\n"
"if {$grabStatus == \"global\"} {\n"
"grab -global $oldGrab\n"
"} else {\n"
"grab $oldGrab\n"
"}\n"
"}\n"
"return $tkPriv(selectFilePath)\n"
"}\n"
"proc tkMotifFDialog_Create {dataName type argList} {\n"
"global tkPriv\n"
"upvar #0 $dataName data\n"
"tkMotifFDialog_Config $dataName $type $argList\n"
"if {![string compare $data(-parent) .]} {\n"
"set w .$dataName\n"
"} else {\n"
"set w $data(-parent).$dataName\n"
"}\n"
"if {![winfo exists $w]} {\n"
"tkMotifFDialog_BuildUI $w\n"
"} elseif {[string compare [winfo class $w] TkMotifFDialog]} {\n"
"destroy $w\n"
"tkMotifFDialog_BuildUI $w\n"
"} else {\n"
"set data(fEnt) $w.top.f1.ent\n"
"set data(dList) $w.top.f2.a.l\n"
"set data(fList) $w.top.f2.b.l\n"
"set data(sEnt) $w.top.f3.ent\n"
"set data(okBtn) $w.bot.ok\n"
"set data(filterBtn) $w.bot.filter\n"
"set data(cancelBtn) $w.bot.cancel\n"
"}\n"
"wm transient $w $data(-parent)\n"
"tkMotifFDialog_Update $w\n"
"wm withdraw $w\n"
"update idletasks\n"
"set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
"- [winfo vrootx [winfo parent $w]]]\n"
"set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
"- [winfo vrooty [winfo parent $w]]]\n"
"wm geom $w +$x+$y\n"
"wm deiconify $w\n"
"wm title $w $data(-title)\n"
"return $w\n"
"}\n"
"proc tkMotifFDialog_Config {dataName type argList} {\n"
"upvar #0 $dataName data\n"
"set data(type) $type\n"
"set specs {\n"
"{-defaultextension \"\" \"\" \"\"}\n"
"{-filetypes \"\" \"\" \"\"}\n"
"{-initialdir \"\" \"\" \"\"}\n"
"{-initialfile \"\" \"\" \"\"}\n"
"{-parent \"\" \"\" \".\"}\n"
"{-title \"\" \"\" \"\"}\n"
"}\n"
"if {![info exists data(selectPath)]} {\n"
"set data(selectPath) [pwd]\n"
"set data(selectFile) \"\"\n"
"}\n"
"tclParseConfigSpec $dataName $specs \"\" $argList\n"
"if {![string compare $data(-title) \"\"]} {\n"
"if {![string compare $type \"open\"]} {\n"
"set data(-title) \"Open\"\n"
"} else {\n"
"set data(-title) \"Save As\"\n"
"}\n"
"}\n"
"if {[string compare $data(-initialdir) \"\"]} {\n"
"if {[file isdirectory $data(-initialdir)]} {\n"
"set data(selectPath) [glob $data(-initialdir)]\n"
"} else {\n"
"set data(selectPath) [pwd]\n"
"}\n"
"set old [pwd]\n"
"cd $data(selectPath)\n"
"set data(selectPath) [pwd]\n"
"cd $old\n"
"}\n"
"set data(selectFile) $data(-initialfile)\n"
"set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]\n"
"if {![info exists data(filter)]} {\n"
"set data(filter) *\n"
"}\n"
"if {![winfo exists $data(-parent)]} {\n"
"error \"bad window path name \\\"$data(-parent)\\\"\"\n"
"}\n"
"}\n"
"proc tkMotifFDialog_BuildUI {w} {\n"
"set dataName [lindex [split $w .] end]\n"
"upvar #0 $dataName data\n"
"toplevel $w -class TkMotifFDialog\n"
"set top [frame $w.top -relief raised -bd 1]\n"
"set bot [frame $w.bot -relief raised -bd 1]\n"
"pack $w.bot -side bottom -fill x\n"
"pack $w.top -side top -expand yes -fill both\n"
"set f1 [frame $top.f1]\n"
"set f2 [frame $top.f2]\n"
"set f3 [frame $top.f3]\n"
"pack $f1 -side top    -fill x\n"
"pack $f3 -side bottom -fill x\n"
"pack $f2 -expand yes -fill both\n"
"set f2a [frame $f2.a]\n"
"set f2b [frame $f2.b]\n"
"grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n"
"-sticky news\n"
"grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n"
"-sticky news\n"
"grid rowconfig $f2 0    -minsize 0   -weight 1\n"
"grid columnconfig $f2 0 -minsize 0   -weight 1\n"
"grid columnconfig $f2 1 -minsize 150 -weight 2\n"
"label $f1.lab -text \"Filter:\" -under 3 -anchor w\n"
"entry $f1.ent\n"
"pack $f1.lab -side top -fill x -padx 6 -pady 4\n"
"pack $f1.ent -side top -fill x -padx 4 -pady 0\n"
"set data(fEnt) $f1.ent\n"
"set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]\n"
"set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files:     2 FList]\n"
"label $f3.lab -text \"Selection:\" -under 0 -anchor w\n"
"entry $f3.ent\n"
"pack $f3.lab -side top -fill x -padx 6 -pady 0\n"
"pack $f3.ent -side top -fill x -padx 4 -pady 4\n"
"set data(sEnt) $f3.ent\n"
"set data(okBtn) [button $bot.ok     -text OK     -width 6 -under 0 \\\n"
"-command \"tkMotifFDialog_OkCmd $w\"]\n"
"set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \\\n"
"-command \"tkMotifFDialog_FilterCmd $w\"]\n"
"set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \\\n"
"-command \"tkMotifFDialog_CancelCmd $w\"]\n"
"pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \\\n"
"-side left\n"
"bind $w <Alt-t> \"focus $data(fEnt)\"\n"
"bind $w <Alt-d> \"focus $data(dList)\"\n"
"bind $w <Alt-l> \"focus $data(fList)\"\n"
"bind $w <Alt-s> \"focus $data(sEnt)\"\n"
"bind $w <Alt-o> \"tkButtonInvoke $bot.ok    \"\n"
"bind $w <Alt-f> \"tkButtonInvoke $bot.filter\"\n"
"bind $w <Alt-c> \"tkButtonInvoke $bot.cancel\"\n"
"bind $data(fEnt) <Return> \"tkMotifFDialog_ActivateFEnt $w\"\n"
"bind $data(sEnt) <Return> \"tkMotifFDialog_ActivateSEnt $w\"\n"
"wm protocol $w WM_DELETE_WINDOW \"tkMotifFDialog_CancelCmd $w\"\n"
"}\n"
"proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {\n"
"label $f.lab -text $label -under $under -anchor w\n"
"listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\\\n"
"-xscrollcommand \"$f.h set\" \\\n"
"-yscrollcommand \"$f.v set\" \n"
"scrollbar $f.v -orient vertical   -takefocus 0 \\\n"
"-command \"$f.l yview\"\n"
"scrollbar $f.h -orient horizontal -takefocus 0 \\\n"
"-command \"$f.l xview\"\n"
"grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \\\n"
"-padx 2 -pady 2\n"
"grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news\n"
"grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news\n"
"grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news\n"
"grid rowconfig    $f 0 -weight 0 -minsize 0\n"
"grid rowconfig    $f 1 -weight 1 -minsize 0\n"
"grid columnconfig $f 0 -weight 1 -minsize 0\n"
"set list $f.l\n"
"bind $list <Up>        \"tkMotifFDialog_Browse$cmdPrefix $w\"\n"
"bind $list <Down>      \"tkMotifFDialog_Browse$cmdPrefix $w\"\n"
"bind $list <space>     \"tkMotifFDialog_Browse$cmdPrefix $w\"\n"
"bind $list <1>         \"tkMotifFDialog_Browse$cmdPrefix $w\"\n"
"bind $list <B1-Motion> \"tkMotifFDialog_Browse$cmdPrefix $w\"\n"
"bind $list <Double-ButtonRelease-1> \"tkMotifFDialog_Activate$cmdPrefix $w\"\n"
"bind $list <Return>    \"tkMotifFDialog_Browse$cmdPrefix $w; \\\n"
"tkMotifFDialog_Activate$cmdPrefix $w\"\n"
"bindtags $list \"Listbox $list [winfo toplevel $list] all\"\n"
"tkListBoxKeyAccel_Set $list\n"
"return $f.l\n"
"}\n"
"proc tkMotifFDialog_InterpFilter {w} {\n"
"upvar #0 [winfo name $w] data\n"
"set text [string trim [$data(fEnt) get]]\n"
"set badTilde 0\n"
"if {[string compare [string index $text 0] ~] == 0} {\n"
"set list [file split $text]\n"
"set tilde [lindex $list 0]\n"
"if [catch {set tilde [glob $tilde]}] {\n"
"set badTilde 1\n"
"} else {\n"
"set text [eval file join [concat $tilde [lrange $list 1 end]]]\n"
"}\n"
"}\n"
"set relative 0\n"
"if {[file pathtype $text] == \"relative\"} {\n"
"set relative 1\n"
"} elseif {$badTilde} {\n"
"set relative 1\011\n"
"}\n"
"if {$relative} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"-message \"\\\"$text\\\" must be an absolute pathname\"\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \\\n"
"$data(filter)]\n"
"return [list $data(selectPath) $data(filter)]\n"
"}\n"
"set resolved [tkFDialog_JoinFile [file dirname $text] [file tail $text]]\n"
"if [file isdirectory $resolved] {\n"
"set dir $resolved\n"
"set fil $data(filter)\n"
"} else {\n"
"set dir [file dirname $resolved]\n"
"set fil [file tail    $resolved]\n"
"}\n"
"return [list $dir $fil]\n"
"}\n"
"proc tkMotifFDialog_Update {w} {\n"
"upvar #0 [winfo name $w] data\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]\n"
"$data(sEnt) delete 0 end\n"
"$data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \\\n"
"$data(selectFile)]\n"
"tkMotifFDialog_LoadFiles $w\n"
"}\n"
"proc tkMotifFDialog_LoadFiles {w} {\n"
"upvar #0 [winfo name $w] data\n"
"$data(dList) delete 0 end\n"
"$data(fList) delete 0 end\n"
"set appPWD [pwd]\n"
"if [catch {\n"
"cd $data(selectPath)\n"
"}] {\n"
"cd $appPWD\n"
"$data(dList) insert end \"..\"\n"
"return\n"
"}\n"
"foreach f [lsort -dictionary [glob -nocomplain .* *]] {\n"
"if [file isdir ./$f] {\n"
"$data(dList) insert end $f\n"
"}\n"
"}\n"
"if ![string compare $data(filter) *] {\n"
"set files [lsort -dictionary [glob -nocomplain .* *]]\n"
"} else {\n"
"set files [lsort -dictionary \\\n"
"[glob -nocomplain $data(filter)]]\n"
"}\n"
"set top 0\n"
"foreach f $files {\n"
"if ![file isdir ./$f] {\n"
"regsub {^[.]/} $f \"\" f\n"
"$data(fList) insert end $f\n"
"if [string match .* $f] {\n"
"incr top\n"
"}\n"
"}\n"
"}\n"
"$data(fList) yview $top\n"
"cd $appPWD\n"
"}\n"
"proc tkMotifFDialog_BrowseDList {w} {\n"
"upvar #0 [winfo name $w] data\n"
"focus $data(dList)\n"
"if {![string compare [$data(dList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set subdir [$data(dList) get [$data(dList) curselection]]\n"
"if {![string compare $subdir \"\"]} {\n"
"return\n"
"}\n"
"$data(fList) selection clear 0 end\n"
"set list [tkMotifFDialog_InterpFilter $w]\n"
"set data(filter) [lindex $list 1]\n"
"switch -- $subdir {\n"
". {\n"
"set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)]\n"
"}\n"
".. {\n"
"set newSpec [tkFDialog_JoinFile [file dirname $data(selectPath)] \\\n"
"$data(filter)]\n"
"}\n"
"default {\n"
"set newSpec [tkFDialog_JoinFile [tkFDialog_JoinFile \\\n"
"$data(selectPath) $subdir] $data(filter)]\n"
"}\n"
"}\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 $newSpec\n"
"}\n"
"proc tkMotifFDialog_ActivateDList {w} {\n"
"upvar #0 [winfo name $w] data\n"
"if {![string compare [$data(dList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set subdir [$data(dList) get [$data(dList) curselection]]\n"
"if {![string compare $subdir \"\"]} {\n"
"return\n"
"}\n"
"$data(fList) selection clear 0 end\n"
"switch -- $subdir {\n"
". {\n"
"set newDir $data(selectPath)\n"
"}\n"
".. {\n"
"set newDir [file dirname $data(selectPath)]\n"
"}\n"
"default {\n"
"set newDir [tkFDialog_JoinFile $data(selectPath) $subdir]\n"
"}\n"
"}\n"
"set data(selectPath) $newDir\n"
"tkMotifFDialog_Update $w\n"
"if {[string compare $subdir ..]} {\n"
"$data(dList) selection set 0\n"
"$data(dList) activate 0\n"
"} else {\n"
"$data(dList) selection set 1\n"
"$data(dList) activate 1\n"
"}\n"
"}\n"
"proc tkMotifFDialog_BrowseFList {w} {\n"
"upvar #0 [winfo name $w] data\n"
"focus $data(fList)\n"
"if {![string compare [$data(fList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n"
"if {![string compare $data(selectFile) \"\"]} {\n"
"return\n"
"}\n"
"$data(dList) selection clear 0 end\n"
"$data(fEnt) delete 0 end\n"
"$data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]\n"
"$data(fEnt) xview end\n"
"$data(sEnt) delete 0 end\n"
"$data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \\\n"
"$data(selectFile)]\n"
"$data(sEnt) xview end\n"
"}\n"
"proc tkMotifFDialog_ActivateFList {w} {\n"
"upvar #0 [winfo name $w] data\n"
"if {![string compare [$data(fList) curselection] \"\"]} {\n"
"return\n"
"}\n"
"set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n"
"if {![string compare $data(selectFile) \"\"]} {\n"
"return\n"
"} else {\n"
"tkMotifFDialog_ActivateSEnt $w\n"
"}\n"
"}\n"
"proc tkMotifFDialog_ActivateFEnt {w} {\n"
"upvar #0 [winfo name $w] data\n"
"set list [tkMotifFDialog_InterpFilter $w]\n"
"set data(selectPath) [lindex $list 0]\n"
"set data(filter)    [lindex $list 1]\n"
"tkMotifFDialog_Update $w\n"
"}\n"
"proc tkMotifFDialog_ActivateSEnt {w} {\n"
"global tkPriv\n"
"upvar #0 [winfo name $w] data\n"
"set selectFilePath [string trim [$data(sEnt) get]]\n"
"set selectFile     [file tail    $selectFilePath]\n"
"set selectPath     [file dirname $selectFilePath]\n"
"if {![string compare $selectFilePath \"\"]} {\n"
"tkMotifFDialog_FilterCmd $w\n"
"return\n"
"}\n"
"if {[file isdirectory $selectFilePath]} {\n"
"set data(selectPath) [glob $selectFilePath]\n"
"set data(selectFile) \"\"\n"
"tkMotifFDialog_Update $w\n"
"return\n"
"}\n"
"if {[string compare [file pathtype $selectFilePath] \"absolute\"]} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"-message \"\\\"$selectFilePath\\\" must be an absolute pathname\"\n"
"return\n"
"}\n"
"if {![file exists $selectPath]} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"-message \"Directory \\\"$selectPath\\\" does not exist.\"\n"
"return\n"
"}\n"
"if {![file exists $selectFilePath]} {\n"
"if {![string compare $data(type) open]} {\n"
"tk_messageBox -icon warning -type ok \\\n"
"-message \"File \\\"$selectFilePath\\\" does not exist.\"\n"
"return\n"
"}\n"
"} else {\n"
"if {![string compare $data(type) save]} {\n"
"set message [format %s%s \\\n"
"\"File \\\"$selectFilePath\\\" already exists.\\n\\n\" \\\n"
"\"Replace existing file?\"]\n"
"set answer [tk_messageBox -icon warning -type yesno \\\n"
"-message $message]\n"
"if {![string compare $answer \"no\"]} {\n"
"return\n"
"}\n"
"}\n"
"}\n"
"set tkPriv(selectFilePath) $selectFilePath\n"
"set tkPriv(selectFile)     $selectFile\n"
"set tkPriv(selectPath)     $selectPath\n"
"}\n"
"proc tkMotifFDialog_OkCmd {w} {\n"
"upvar #0 [winfo name $w] data\n"
"tkMotifFDialog_ActivateSEnt $w\n"
"}\n"
"proc tkMotifFDialog_FilterCmd {w} {\n"
"upvar #0 [winfo name $w] data\n"
"tkMotifFDialog_ActivateFEnt $w\n"
"}\n"
"proc tkMotifFDialog_CancelCmd {w} {\n"
"global tkPriv\n"
"set tkPriv(selectFilePath) \"\"\n"
"set tkPriv(selectFile)     \"\"\n"
"set tkPriv(selectPath)     \"\"\n"
"}\n"
"proc tkListBoxKeyAccel_Set {w} {\n"
"bind Listbox <Any-KeyPress> \"\"\n"
"bind $w <Destroy> \"tkListBoxKeyAccel_Unset $w\"\n"
"bind $w <Any-KeyPress> \"tkListBoxKeyAccel_Key $w %A\"\n"
"}\n"
"proc tkListBoxKeyAccel_Unset {w} {\n"
"global tkPriv\n"
"catch {after cancel $tkPriv(lbAccel,$w,afterId)}\n"
"catch {unset tkPriv(lbAccel,$w)}\n"
"catch {unset tkPriv(lbAccel,$w,afterId)}\n"
"}\n"
"proc tkListBoxKeyAccel_Key {w key} {\n"
"global tkPriv\n"
"append tkPriv(lbAccel,$w) $key\n"
"tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)\n"
"catch {\n"
"after cancel $tkPriv(lbAccel,$w,afterId)\n"
"}\n"
"set tkPriv(lbAccel,$w,afterId) [after 500 tkListBoxKeyAccel_Reset $w]\n"
"}\n"
"proc tkListBoxKeyAccel_Goto {w string} {\n"
"global tkPriv\n"
"set string [string tolower $string]\n"
"set end [$w index end]\n"
"set theIndex -1\n"
"for {set i 0} {$i < $end} {incr i} {\n"
"set item [string tolower [$w get $i]]\n"
"if {[string compare $string $item] >= 0} {\n"
"set theIndex $i\n"
"}\n"
"if {[string compare $string $item] <= 0} {\n"
"set theIndex $i\n"
"break\n"
"}\n"
"}\n"
"if {$theIndex >= 0} {\n"
"$w selection clear 0 end\n"
"$w selection set $theIndex $theIndex\n"
"$w activate $theIndex\n"
"$w see $theIndex\n"
"}\n"
"}\n"
"proc tkListBoxKeyAccel_Reset {w} {\n"
"global tkPriv\n"
"catch {unset tkPriv(lbAccel,$w)}\n"
"}\n"
;
static char Et_zFile32[] = 
"proc blt::DndInit { widget button cmd } {\n"
"set tagName \"bltDnd$button\"\n"
"bind $tagName <ButtonPress-$button> [list $cmd drag %W %X %Y]\n"
"bind $tagName <B$button-Motion> [list $cmd drag %W %X %Y]\n"
"bind $tagName <ButtonRelease-$button> [list $cmd drop %W %X %Y]\n"
"set tags [bindtags $widget]\n"
"if { [lsearch $tags $tagName] < 0 } {\n"
"bindtags $widget [linsert $tags 0 $tagName]\n"
"}\011\n"
"}\n"
;
static char Et_zFile33[] = 
"proc Blt_ActiveLegend { graph } {\n"
"$graph legend bind all <Enter> [list blt::ActivateLegend $graph ]\n"
"$graph legend bind all <Leave> [list blt::DeactivateLegend $graph]\n"
"$graph legend bind all <ButtonPress-1> [list blt::HighlightLegend $graph]\n"
"}\n"
"proc Blt_Crosshairs { graph } {\n"
"blt::Crosshairs $graph \n"
"}\n"
"proc Blt_ZoomStack { graph } {\n"
"blt::ZoomStack $graph\n"
"}\n"
"proc Blt_PrintKey { graph } {\n"
"blt::PrintKey $graph\n"
"}\n"
"proc Blt_ClosestPoint { graph } {\n"
"blt::ClosestPoint $graph\n"
"}\n"
"proc blt::ActivateLegend { graph } {\n"
"set elem [$graph legend get current]\n"
"$graph legend activate $elem\n"
"}\n"
"proc blt::DeactivateLegend { graph } {\n"
"set elem [$graph legend get current]\n"
"$graph legend deactivate $elem\n"
"}\n"
"proc blt::HighlightLegend { graph } {\n"
"set elem [$graph legend get current]\n"
"set relief [$graph element cget $elem -labelrelief]\n"
"if { $relief == \"flat\" } {\n"
"$graph element configure $elem -labelrelief raised\n"
"$graph element activate $elem\n"
"} else {\n"
"$graph element configure $elem -labelrelief flat\n"
"$graph element deactivate $elem\n"
"}\n"
"}\n"
"proc blt::Crosshairs { graph } {\n"
"$graph crosshairs on\n"
"bind bltCrosshairs <Any-Motion>   {\n"
"%W crosshairs configure -position @%x,%y \n"
"}\n"
"$graph crosshairs configure -color red\n"
"blt::AddBindTag $graph bltCrosshairs  \n"
"}\n"
"proc blt::ZoomStack { graph } {\n"
"global zoomInfo\n"
"set zoomInfo($graph,interval) 100\n"
"set zoomInfo($graph,afterId) 0\n"
"set zoomInfo($graph,A,x) {}\n"
"set zoomInfo($graph,A,y) {}\n"
"set zoomInfo($graph,B,x) {}\n"
"set zoomInfo($graph,B,y) {}\n"
"set zoomInfo($graph,stack) {}\n"
"set zoomInfo($graph,corner) A\n"
"bind $graph <1> { \n"
"blt::SetZoomPoint %W %x %y \n"
"}\n"
"bind $graph <ButtonPress-3> {\n"
"if { [%W inside %x %y] } {\n"
"blt::ResetZoom %W \n"
"}\n"
"}\n"
"}\n"
"proc blt::PrintKey { graph } {\n"
"bind bltPrintGraph <Shift-ButtonRelease-3>  { Blt_PostScriptDialog %W }\n"
"blt::AddBindTag $graph bltPrintGraph \n"
"}\n"
"proc blt::ClosestPoint { graph } {\n"
"bind bltClosestPoint <Control-ButtonPress-1>  {\n"
"blt::FindElement %W %x %y\n"
"break\n"
"}\n"
"blt::AddBindTag $graph bltClosestPoint \n"
"}\n"
"proc blt::AddBindTag { graph name } {\n"
"set oldtags [bindtags $graph]\n"
"if { [lsearch $oldtags $name] < 0 } {\n"
"bindtags $graph [concat $name $oldtags]\n"
"}\n"
"}\n"
"proc blt::FindElement { graph x y } {\n"
"if ![$graph element closest $x $y info -interpolate yes] {\n"
"beep\n"
"return\n"
"}\n"
"foreach i [array names info] {\n"
"puts stderr \"info($i) = $info($i)\"\n"
"}\n"
"set markerName \"bltClosest_$info(name)\"\n"
"catch { $graph marker delete $markerName }\n"
"$graph marker create text -coords { $info(x) $info(y) } \\\n"
"-name $markerName \\\n"
"-text \"$info(name): $info(dist)\\nindex $info(index)\" \\\n"
"-font *lucida*-r-*-10-* \\\n"
"-anchor center -justify left \\\n"
"-yoffset 0 -bg {} \n"
"set coords [$graph invtransform $x $y]\n"
"set nx [lindex $coords 0]\n"
"set ny [lindex $coords 1]\n"
"$graph marker create line -coords \"$nx $ny $info(x) $info(y)\" \\\n"
"-name line.$markerName \n"
"blt::FlashPoint $graph $info(name) $info(index) 10\n"
"blt::FlashPoint $graph $info(name) [expr $info(index) + 1] 10\n"
"}\n"
"proc blt::FlashPoint { graph name index count } {\n"
"if { $count & 1 } {\n"
"$graph element deactivate $name \n"
"} else {\n"
"$graph element activate $name $index\n"
"}\n"
"incr count -1\n"
"if { $count > 0 } {\n"
"after 200 blt::FlashPoint $graph $name $index $count\n"
"update\n"
"} else {\n"
"eval $graph marker delete [$graph marker names \"bltClosest_*\"]\n"
"}\n"
"}\n"
"proc blt::GetCoords { graph x y index } {\n"
"#puts stderr \"$x,$y ==>\" nonewline\n"
"set coords [$graph invtransform $x $y]\n"
"set nx [lindex $coords 0]\n"
"set ny [lindex $coords 1]\n"
"set x $nx\n"
"set y $ny\n"
"scan [$graph xaxis limits] \"%s %s\" xmin xmax\n"
"scan [$graph yaxis limits] \"%s %s\" ymin ymax\n"
"set padx [expr ($xmax - $xmin) * 0.00]\n"
"set pady [expr ($ymax - $ymin) * 0.00]\n"
"if { $x > $xmax } { \n"
"set x [expr $xmax + $padx]\n"
"} elseif { $x < $xmin } { \n"
"set x [expr $xmin - $padx]\n"
"}\n"
"if { $y > $ymax } { \n"
"set y [expr $ymax + $pady]\n"
"} elseif { $y < $ymin } { \n"
"set y [expr $ymin - $pady]\n"
"}\n"
"global zoomInfo\n"
"set zoomInfo($graph,$index,x) $x\n"
"set zoomInfo($graph,$index,y) $y\n"
"}\n"
"proc blt::MarkPoint { graph index } {\n"
"global zoomInfo\n"
"set x $zoomInfo($graph,$index,x)\n"
"set y $zoomInfo($graph,$index,y)\n"
"set marker \"zoomText_$index\"\n"
"set text [format \"x=%.4g\\ny=%.4g\" $x $y] \n"
"if [$graph marker exists $marker] {\n"
"$graph marker configure $marker -coords { $x $y } -text $text \n"
"} else {\n"
"$graph marker create text -coords { $x $y } -name $marker \\\n"
"-font *lucida*-r-*-10-* \\\n"
"-text $text -anchor center -bg {} -justify left\n"
"}\n"
"}\n"
"proc blt::DestroyZoomTitle { graph } {\n"
"global zoomInfo\n"
"if { $zoomInfo($graph,corner) == \"A\" } {\n"
"catch { $graph marker delete \"zoomTitle\" }\n"
"}\n"
"}\n"
"proc blt::PopZoom { graph } {\n"
"global zoomInfo\n"
"set zoomStack $zoomInfo($graph,stack)\n"
"if { [llength $zoomStack] > 0 } {\n"
"set cmd [lindex $zoomStack 0]\n"
"set zoomInfo($graph,stack) [lrange $zoomStack 1 end]\n"
"eval $cmd\n"
"blt::ZoomTitleLast $graph\n"
"busy hold $graph\n"
"update\n"
"after 2000 \"blt::DestroyZoomTitle $graph\"\n"
"busy release $graph\n"
"} else {\n"
"catch { $graph marker delete \"zoomTitle\" }\n"
"}\n"
"}\n"
"proc blt::PushZoom { graph } {\n"
"global zoomInfo\n"
"eval $graph marker delete [$graph marker names \"zoom*\"]\n"
"if { [info exists zoomInfo($graph,afterId)] } {\n"
"after cancel $zoomInfo($graph,afterId)\n"
"}\n"
"set x1 $zoomInfo($graph,A,x)\n"
"set y1 $zoomInfo($graph,A,y)\n"
"set x2 $zoomInfo($graph,B,x)\n"
"set y2 $zoomInfo($graph,B,y)\n"
"if { ($x1 == $x2) && ($y1 == $y2) } { \n"
"return\n"
"}\n"
"set cmd [format {\n"
"%s xaxis configure -min \"%s\" -max \"%s\"\n"
"%s yaxis configure -min \"%s\" -max \"%s\"\n"
"} $graph [$graph xaxis cget -min] [$graph xaxis cget -max] \\\n"
"$graph [$graph yaxis cget -min] [$graph yaxis cget -max] ]\n"
"set zoomInfo($graph,stack) [linsert $zoomInfo($graph,stack) 0 $cmd]\n"
"busy hold $graph \n"
"update\n"
"if { $x1 > $x2 } { \n"
"$graph xaxis configure -min $x2 -max $x1 \n"
"} elseif { $x1 < $x2 } {\n"
"$graph xaxis configure -min $x1 -max $x2\n"
"} \n"
"if { $y1 > $y2 } { \n"
"$graph yaxis configure -min $y2 -max $y1\n"
"} elseif { $y1 < $y2 } {\n"
"$graph yaxis configure -min $y1 -max $y2\n"
"} \n"
"update\n"
"busy release $graph\n"
"}\n"
"proc blt::ResetZoom { graph } {\n"
"global zoomInfo\n"
"eval $graph marker delete [$graph marker names \"zoom*\"]\n"
"if { $zoomInfo($graph,corner) == \"A\" } {\n"
"blt::PopZoom $graph\n"
"} else {\n"
"set zoomInfo($graph,corner) A\n"
"bind $graph <Motion> { }\n"
"}\n"
"}\n"
"option add *zoomTitle.font\011  -*-helvetica-medium-R-*-*-18-*-*-*-*-*-*-* \n"
"option add *zoomTitle.shadow\011  yellow4\n"
"option add *zoomTitle.foreground  yellow1\n"
"option add *zoomTitle.coords\011  \"-Inf Inf\"\n"
"proc blt::ZoomTitleNext { graph } {\n"
"global zoomInfo\n"
"set level [expr [llength $zoomInfo($graph,stack)] + 1]\n"
"if { [$graph cget -invertxy] } {\n"
"set coords \"-Inf -Inf\"\n"
"} else {\n"
"set coords \"-Inf Inf\"\n"
"}\n"
"$graph marker create text -name \"zoomTitle\" -text \"Zoom #$level\" \\\n"
"-coords $coords -bindtags \"\" -anchor nw\n"
"}\n"
"proc blt::ZoomTitleLast { graph } {\n"
"global zoomInfo\n"
"set level [llength $zoomInfo($graph,stack)]\n"
"if { $level > 0 } {\n"
"$graph marker create text -name \"zoomTitle\" -text \"Zoom #$level\" -anchor nw\n"
"}\n"
"}\n"
"proc blt::SetZoomPoint { graph x y } {\n"
"global zoomInfo\n"
"blt::GetCoords $graph $x $y $zoomInfo($graph,corner)\n"
"if { $zoomInfo($graph,corner) == \"A\" } {\n"
"if { ![$graph inside $x $y] } {\n"
"return\n"
"}\n"
"#blt::MarkPoint $graph A\n"
"blt::ZoomTitleNext $graph \n"
"bind $graph <Any-Motion> { \n"
"blt::GetCoords %W %x %y B\n"
"#blt::MarkPoint $graph B\n"
"blt::Box %W\n"
"}\n"
"set zoomInfo($graph,corner) B\n"
"} else {\n"
"bind $graph <Any-Motion> { }\n"
"blt::PushZoom $graph \n"
"set zoomInfo($graph,corner) A\n"
"}\n"
"}\n"
"option add *zoomOutline.dashes\011\0114\011\n"
"option add *zoomTitle.anchor\011\011nw\n"
"option add *zoomOutline.lineWidth\0112\n"
"option add *zoomOutline.xor\011\011yes\n"
"proc blt::ChangeDashes { graph offset } {\n"
"global zoomInfo\n"
"incr offset\n"
"if { [$graph marker exists zoomOutline] } {\n"
"$graph marker configure zoomOutline -dashoffset $offset \n"
"set zoomInfo($graph,afterId) \\\n"
"[after $zoomInfo($graph,interval) \"blt::ChangeDashes $graph $offset\"]\n"
"}\n"
"}\n"
"proc blt::Box { graph } {\n"
"global zoomInfo\n"
"if { $zoomInfo($graph,A,x) > $zoomInfo($graph,B,x) } { \n"
"set x1 $zoomInfo($graph,B,x)\n"
"set x2 $zoomInfo($graph,A,x)\n"
"set y1 $zoomInfo($graph,B,y)\n"
"set y2 $zoomInfo($graph,A,y)\n"
"} else {\n"
"set x1 $zoomInfo($graph,A,x)\n"
"set x2 $zoomInfo($graph,B,x)\n"
"set y1 $zoomInfo($graph,A,y)\n"
"set y2 $zoomInfo($graph,B,y)\n"
"}\n"
"set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }\n"
"if { [$graph marker exists \"zoomOutline\"] } {\n"
"$graph marker configure \"zoomOutline\" -coords $coords \n"
"} else {\n"
"$graph marker create line -coords $coords -name \"zoomOutline\" \\\n"
"-mapx [$graph xaxis use] -mapy [$graph yaxis use] \n"
"set zoomInfo($graph,afterId) \\\n"
"[after $zoomInfo($graph,interval) \"blt::ChangeDashes $graph 0\"]\n"
"}\n"
"}\n"
"proc Blt_PostScriptDialog { graph } {\n"
"set top $graph.top\n"
"toplevel $top\n"
"foreach var { center landscape maxpect preview decorations padx \n"
"pady paperwidth paperheight width height colormode } {\n"
"global $graph.$var\n"
"set $graph.$var [$graph postscript cget -$var]\n"
"}\n"
"set row 1\n"
"set col 0\n"
"label $top.title -text \"PostScript Options\"\n"
"table $top $top.title -cspan 7\n"
"foreach bool { center landscape maxpect preview decorations } {\n"
"set w $top.$bool-label\n"
"label $w -text \"-$bool\" -font *courier*-r-*12* \n"
"table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }\n"
"set w $top.$bool-yes\n"
"global $graph.$bool\n"
"radiobutton $w -text \"yes\" -variable $graph.$bool -value 1\n"
"table $top $row,$col+1 $w -anchor w\n"
"set w $top.$bool-no\n"
"radiobutton $w -text \"no\" -variable $graph.$bool -value 0\n"
"table $top $row,$col+2 $w -anchor w\n"
"incr row\n"
"}\n"
"label $top.modes -text \"-colormode\" -font *courier*-r-*12* \n"
"table $top $row,0 $top.modes -anchor e  -pady { 2 0 } -padx { 0 4 }\n"
"set col 1\n"
"foreach m { color greyscale } {\n"
"set w $top.$m\n"
"radiobutton $w -text $m -variable $graph.colormode -value $m\n"
"table $top $row,$col $w -anchor w\n"
"incr col\n"
"}\n"
"set row 1\n"
"frame $top.sep -width 2 -bd 1 -relief sunken\n"
"table $top $row,3 $top.sep -fill y -rspan 6\n"
"set col 4\n"
"foreach value { padx pady paperwidth paperheight width height } {\n"
"set w $top.$value-label\n"
"label $w -text \"-$value\" -font *courier*-r-*12* \n"
"table $top $row,$col $w -anchor e  -pady { 2 0 } -padx { 0 4 }\n"
"set w $top.$value-entry\n"
"global $graph.$value\n"
"entry $w -textvariable $graph.$value -width 8\n"
"table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8\n"
"incr row\n"
"}\n"
"table configure $top c3 -width .125i\n"
"button $top.cancel -text \"Cancel\" -command \"destroy $top\"\n"
"table $top $row,0 $top.cancel  -width 1i -pady 2 -cspan 3\n"
"button $top.reset -text \"Reset\" -command \"destroy $top\"\n"
"#table $top $row,1 $top.reset  -width 1i\n"
"button $top.print -text \"Print\" -command \"blt::ResetPostScript $graph\"\n"
"table $top $row,4 $top.print  -width 1i -pady 2 -cspan 2\n"
"}\n"
"proc blt::ResetPostScript { graph } {\n"
"foreach var { center landscape maxpect preview decorations padx \n"
"pady paperwidth paperheight width height colormode } {\n"
"global $graph.$var\n"
"set old [$graph postscript cget -$var]\n"
"if { [catch {$graph postscript configure -$var [set $graph.$var]}] != 0 } {\n"
"$graph postscript configure -$var $old\n"
"set $graph.$var $old\n"
"}\n"
"}\n"
"$graph postscript output \"out.ps\"\n"
"puts stdout \"wrote file \\\"out.ps\\\".\"\n"
"flush stdout\n"
"}\n"
;
static char Et_zFile34[] = 
"array set bltHierbox {\n"
"afterId \"\"\n"
"space   off\n"
"action  \"\"\n"
"x       0\n"
"y       0\n"
"toggle  yes\n"
"select  off\n"
"}\n"
"bind Hierbox <ButtonPress-2> {\n"
"set bltHierbox(cursor) [%W cget -cursor]\n"
"%W configure -cursor hand1\n"
"%W scan mark %x %y\n"
"}\n"
"bind Hierbox <B2-Motion> {\n"
"%W scan dragto %x %y\n"
"}\n"
"bind Hierbox <ButtonRelease-2> {\n"
"%W configure -cursor $bltHierbox(cursor)\n"
"}\n"
"bind Hierbox <B1-Leave> {\n"
"blt::HierboxAutoScan %W \n"
"}\n"
"bind Hierbox <B1-Enter> {\n"
"after cancel $bltHierbox(afterId)\n"
"}\n"
"bind Hierbox <KeyPress-Up> {\n"
"blt::HierboxTraverse %W up\n"
"if { $bltHierbox(space) } {\n"
"%W selection toggle focus\n"
"}\n"
"}\n"
"bind Hierbox <KeyPress-Down> {\n"
"blt::HierboxTraverse %W down\n"
"if { $bltHierbox(space) } {\n"
"%W selection toggle focus\n"
"}\n"
"}\n"
"bind Hierbox <Shift-KeyPress-Up> {\n"
"blt::HierboxTraverse %W prevsibling\n"
"}\n"
"bind Hierbox <Shift-KeyPress-Down> {\n"
"blt::HierboxTraverse %W nextsibling\n"
"}\n"
"bind Hierbox <KeyPress-Prior> {\n"
"blt::HierboxPage %W top\n"
"}\n"
"bind Hierbox <KeyPress-Next> {\n"
"blt::HierboxPage %W bottom\n"
"}\n"
"bind Hierbox <KeyPress-Left> {\n"
"%W close focus\n"
"}\n"
"bind Hierbox <KeyPress-Right> {\n"
"%W open focus\n"
"}\n"
"bind Hierbox <KeyPress-space> {\n"
"blt::HierboxToggle %W focus\n"
"set bltHierbox(space) on\n"
"}\n"
"bind Hierbox <KeyRelease-space> { \n"
"set bltHierbox(space) off\n"
"}\n"
"bind Hierbox <KeyPress-Return> {\n"
"blt::HierboxToggle %W focus\n"
"set bltHierbox(space) on\n"
"}\n"
"bind Hierbox <KeyRelease-Return> { \n"
"set bltHierbox(space) off\n"
"}\n"
"bind Hierbox <KeyPress> {\n"
"blt::HierboxSearch %W %A\n"
"}\n"
"bind Hierbox <KeyPress-Home> {\n"
"blt::HierboxTraverse %W root\n"
"}\n"
"bind Hierbox <KeyPress-End> {\n"
"blt::HierboxTraverse %W end\n"
"}\n"
"bind Hierbox <KeyPress-F1> {\n"
"%W open -r root\n"
"}\n"
"bind Hierbox <KeyPress-F2> {\n"
"eval %W close -r [%W entry children root 0 end] \n"
"}\n"
"proc blt::HierboxInit { widget } {\n"
"$widget bind all <Enter> { \n"
"%W entry activate current \n"
"}\n"
"$widget bind all <Leave> { \n"
"%W entry activate \"\" \n"
"}\n"
"$widget bind all <ButtonPress-1> { \011\n"
"blt::HierboxSelect %W \n"
"}\n"
"$widget bind all <Double-ButtonPress-1> {\n"
"%W toggle current\n"
"}\n"
"$widget bind all <Shift-ButtonPress-1> { \n"
"blt::HierboxStartSelect %W \"set\"\n"
"}\n"
"$widget bind all <Control-ButtonPress-1> { \n"
"blt::HierboxStartSelect %W \"toggle\"\n"
"}\n"
"$widget bind all <B1-Motion> { \n"
"if { $bltHierbox(action) != \"\" } {\n"
"set bltHierbox(select) on\n"
"}\n"
"set bltHierbox(x) %x\n"
"set bltHierbox(y) %y\n"
"blt::HierboxMotion %W %x %y\n"
"}\n"
"$widget bind all <ButtonRelease-1> { \n"
"if { $bltHierbox(action) != \"\" } {\n"
"blt::HierboxEndSelect %W %x %y\n"
"}\n"
"after cancel $bltHierbox(afterId)\n"
"}\n"
"$widget button bind all <ButtonRelease-1> {\n"
"%W toggle current\n"
"}\n"
"$widget button bind all <Enter> {\n"
"%W button activate current\n"
"}\n"
"$widget button bind all <Leave> {\n"
"%W button activate \"\"\n"
"}\n"
"}\n"
"proc blt::HierboxAutoScan { widget } {\n"
"global bltHierbox\n"
"if { ![winfo exists $widget] } {\n"
"return\n"
"}\n"
"set x $bltHierbox(x)\n"
"set y $bltHierbox(y)\n"
"if { $y >= [winfo height $widget] } {\n"
"$widget yview scroll 1 units\n"
"} elseif { $y < 0 } {\n"
"$widget yview scroll -1 units\n"
"} \n"
"blt::HierboxMotion $widget $x $y\n"
"set bltHierbox(afterId) [after 10 blt::HierboxAutoScan $widget]\n"
"}\n"
"proc blt::HierboxSelect { widget } {\n"
"global bltHierbox\n"
"set bltHierbox(action) \"\"\n"
"$widget selection clear 0 end\n"
"$widget selection set current\n"
"$widget selection anchor current\n"
"$widget see current\n"
"$widget focus current\n"
"}\n"
"proc blt::HierboxStartSelect { widget action } {\n"
"global bltHierbox\n"
"set bltHierbox(action) $action\n"
"switch -- [$widget cget -selectmode] {\n"
"single - active {\n"
"blt::HierboxSelect $widget\n"
"}\n"
"multiple {\n"
"$widget selection anchor current\n"
"}\n"
"}\n"
"}\n"
"proc blt::HierboxMotion { widget x y } {\n"
"global bltHierbox\n"
"if { $bltHierbox(action) == \"\" } {\n"
"return\n"
"}\n"
"if {[$widget cget -selectmode] == \"multiple\" } {\n"
"set node [$widget nearest $x $y]\n"
"$widget selection dragto $node $bltHierbox(action)\n"
"}\n"
"}\n"
"proc blt::HierboxEndSelect { widget x y } {\n"
"global bltHierbox\n"
"if { $bltHierbox(action) != \"\" } {\n"
"after cancel $bltHierbox(afterId)\n"
"}\n"
"if {[$widget cget -selectmode] == \"multiple\" } {\n"
"set node [$widget nearest $x $y]\n"
"$widget selection $bltHierbox(action) anchor $node\n"
"$widget selection anchor $node\n"
"}\n"
"set bltHierbox(select) \"off\"\n"
"}\n"
"proc blt::HierboxToggle { widget index } {\n"
"switch -- [$widget cget -selectmode] {\n"
"single - active {\n"
"set i [$widget index $index]\n"
"if {[lsearch [$widget curselection] $i] < 0} {\n"
"$widget selection clear 0 end\n"
"}\n"
"$widget selection toggle $index\n"
"}\n"
"multiple {\n"
"$widget selection toggle $index\n"
"}\n"
"}\n"
"}\n"
"proc blt::HierboxTraverse { widget where } {\n"
"catch {$widget focus $where}\n"
"if {[$widget cget -selectmode] == \"active\"} {\n"
"$widget selection clear 0 end\n"
"$widget selection set focus\n"
"}\n"
"$widget see focus\n"
"}\n"
"proc blt::HierboxPage { widget where } {\n"
"if { [$widget index focus] == [$widget index view.$where] } {\n"
"if {$where == \"top\"} {\n"
"$widget yview scroll -1 pages\n"
"$widget yview scroll 1 units\n"
"} else {\n"
"$widget yview scroll 1 pages\n"
"$widget yview scroll -1 units\n"
"}\n"
"}\n"
"update\n"
"$widget activate view.$where\n"
"if {[$widget cget -selectmode] == \"active\"} {\n"
"$widget selection clear 0 end\n"
"$widget selection set focus\n"
"}\n"
"}\n"
"proc blt::HierboxSearch { widget key } {\n"
"if {[string match {[ -~]} $key]} {\n"
"set last [$widget index focus]\n"
"set next [$widget index next]\n"
"while { $next != $last } {\n"
"set label [$widget entry cget $next -label]\n"
"if { [string index $label 0] == $key } {\n"
"break\n"
"}\n"
"set next [$widget index -at $next next]\n"
"}\n"
"$widget focus $next\n"
"if {[$widget cget -selectmode] == \"active\"} {\n"
"$widget selection clear 0 end\n"
"$widget selection set focus\n"
"}\n"
"$widget see focus\n"
"}\n"
"}\n"
;
static char Et_zFile35[] = 
"set bltTabset(activate) yes\n"
"bind Tabset <B2-Motion> {\n"
"%W scan dragto %x %y\n"
"}\n"
"bind Tabset <ButtonPress-2> {\n"
"set bltTabset(cursor) [%W cget -cursor]\n"
"set bltTabset(activate) no\n"
"%W configure -cursor hand1\n"
"%W scan mark %x %y\n"
"}\n"
"bind Tabset <ButtonRelease-2> {\n"
"%W configure -cursor $bltTabset(cursor)\n"
"set bltTabset(activate) yes\n"
"%W activate @%x,%y\n"
"}\n"
"bind Tabset <KeyPress-Up> {\n"
"%W see tabUp\n"
"%W focus tabUp\n"
"}\n"
"bind Tabset <KeyPress-Down> { \n"
"%W see tabDown\n"
"%W focus tabDown\n"
"}\n"
"bind Tabset <KeyPress-Right> {\n"
"%W see tabRight\n"
"%W focus tabRight\n"
"}\n"
"bind Tabset <KeyPress-Left> {\n"
"%W see tabLeft\n"
"%W focus tabLeft\n"
"}\n"
"bind Tabset <KeyPress-space> {\n"
"%W invoke tabFocus\n"
"}\n"
"bind Tabset <KeyPress-Return> {\n"
"%W invoke tabFocus\n"
"}\n"
"bind Tabset <KeyPress> {\n"
"if { [string match {[A-Za-z0-9]*} \"%A\"] } {\n"
"blt::FindMatchingTab %W %A\n"
"}\n"
"}\n"
"proc blt::FindMatchingTab { widget key } {\n"
"set key [string tolower $key]\n"
"set index [$widget index tabFocus]\n"
"set numTabs [$widget size]\n"
"for { set i 0 } { $i < $numTabs } { incr i } {\n"
"if { [incr index] >= $numTabs } {\n"
"set index 0\n"
"}\n"
"set label [string tolower [$widget tab cget $index -text]]\n"
"if { [string index $label 0] == $key } {\n"
"break\n"
"}\n"
"}\n"
"$widget focus $index\n"
"$widget see tabFocus\n"
"}\n"
"proc blt::SelectTab { widget x y } {\n"
"$widget see tabSelect\n"
"set w [$widget tab tearoff tabSelect]\n"
"if { ($w != \"\") && ($w != \"$widget\") } {\n"
"raise [winfo toplevel $w]\n"
"}\n"
"$widget invoke tabSelect\n"
"}\n"
"proc blt::DestroyTearoff { widget tabName } {\n"
"set top \"$widget.toplevel-$tabName\"\n"
"if { [winfo exists $top] } {\n"
"wm withdraw $top\n"
"update\n"
"$widget tab tearoff $tabName $widget\n"
"destroy $top\n"
"}\n"
"}\n"
"proc blt::CreateTearoff { widget tabName rootX rootY } {\n"
"set focus [focus]\n"
"set window [$widget tab cget $tabName -window]\n"
"if { ($focus == $window) || ([string match  $window.* $focus]) } {\n"
"focus -force $widget\n"
"}\n"
"set top \"$widget.toplevel-$tabName\"\n"
"toplevel $top\n"
"$widget tab tearoff $tabName $top.container\n"
"table $top $top.container -fill both\n"
"incr rootX 10 ; incr rootY 10\n"
"wm geometry $top +$rootX+$rootY\n"
"wm title $top \"[wm title .]: [$widget tab cget $tabName -text]\"\n"
"wm transient $top .\n"
"wm protocol $top WM_DELETE_WINDOW [list blt::DestroyTearoff $widget $tabName]\n"
"bind $top.container <Destroy> [list destroy $top]\n"
"}\n"
"proc blt::Tearoff { widget x y  } {\n"
"set tabName [$widget get tabActive]\n"
"if { $tabName == \"\" } {\n"
"return\n"
"}\n"
"set container [$widget tab tearoff $tabName]\n"
"if { $container == \"$widget\" } {\n"
"blt::CreateTearoff $widget $tabName $x $y\n"
"} else {\n"
"blt::DestroyTearoff $widget $tabName\n"
"}\n"
"}\n"
"proc blt::TabsetInit { widget } {\n"
"$widget bind all <Enter> { \n"
"if { $bltTabset(activate) } {\n"
"%W activate tabSelect \n"
"}\n"
"}\n"
"$widget bind all <Leave> { \n"
"%W activate \"\" \n"
"}\n"
"$widget bind all <ButtonPress-1> { \n"
"blt::SelectTab %W %x %y \n"
"}\n"
"$widget bind all <ButtonPress-3> { \n"
"blt::Tearoff %W %X %Y \n"
"}\n"
"$widget bind all <Control-ButtonPress-1> { \n"
"blt::Tearoff %W %X %Y \n"
"}\n"
"}\n"
;
static char Et_zFile36[] = 
"# 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(Blt_ActiveLegend) [list source $dir/bltGraph.tcl]\n"
"set auto_index(Blt_Crosshairs) [list source $dir/bltGraph.tcl]\n"
"set auto_index(Blt_ZoomStack) [list source $dir/bltGraph.tcl]\n"
"set auto_index(Blt_PrintKey) [list source $dir/bltGraph.tcl]\n"
"set auto_index(Blt_ClosestPoint) [list source $dir/bltGraph.tcl]\n"
;
static char Et_zFile37[] = 
"proc AddAnnotation { alist color } {\n"
"global widget param\n"
"if { $param(ShowAnnotation) == 0 } {\n"
"ToggleAnnWindow\n"
"}\n"
"set txt $widget(anntxt)\n"
"set alen [llength $alist]\n"
"set n $param(_numann)\n"
"set newtag \"\"\n"
"if { $n == $param(maxannotations) } {\n"
"set newtag [$txt tag names $n.0]\n"
"$txt tag delete $newtag\n"
"$txt delete $n.0 end\n"
"incr n -1\n"
"}\n"
"set str \"\"\n"
"set fpos {}\n"
"for {set i 0} {$i < $alen} {incr i 2} {\n"
"set fld [lindex $alist $i]\n"
"set val [lindex $alist [expr $i + 1]]\n"
"lappend fpos [string length $str]\n"
"set str \"$str $fld: $val,\"\n"
"}\n"
"set old1tag [$txt tag names 1.0]\n"
"$txt tag configure $old1tag -underline 0\n"
"set str [string range $str 0 [expr [string length $str]-2]]\n"
"$txt insert 1.0 \"$str\\n\"\n"
"incr n\n"
"if { $newtag == \"\" } {\n"
"set newtag $n\n"
"}\n"
"$txt tag add $newtag 1.0 {1.0 lineend}\n"
"$txt tag configure $newtag -foreground $color -underline 1 \n"
"set param(_numann) $n\n"
"}\n"
"#proc ShowAnnotation { x y h } {\n"
"proc ShowAnnotation { x y h } {\n"
"puts \"ShowAnnotation\"\n"
"return\n"
"}\n"
"proc HideAnnotation { } {\n"
"global widget\n"
"wm iconify $widget(annwin)\n"
"}\n"
;
static char Et_zFile38[] = 
"global Bkmk()\n"
"set Bkmk(Num) 0\n"
"set Bkmk(Lold) 0\n"
"set Bkmk(color) \\#c88332\n"
"set Bkmk(hcolor) \\#ff0000\n"
"set Bkmk(record) {time type severity loc comment eset}\n"
"set Bkmk(fd) \"\"\n"
"set Bkmk(auto) 1\n"
"set Bkmk(lock) 0\n"
"set Bkmk(dir) \"!NEW!\"\n"
"set Bkmk(fname) \"!NEW!\"\n"
"set Bkmk(file) \"\"\n"
"proc BkmkRefresh { } {\n"
"ClearAllHighlights \n"
"bkListShow no\n"
"}\n"
"proc BkmkDlgSetup { {view 0} } {\n"
"global Bkmk param\n"
"if { $view && [info exists Bkmk(View)]} {\n"
"return 1\n"
"}\n"
"set Bkmk(eopts) [list -bg white\\\n"
"-relief sunken \\\n"
"-borderwidth 2\\\n"
"-highlightthickness 0]\n"
"set Bkmk(lopts) [list -bg $param(color-ctlbg)\\\n"
"-relief flat \\\n"
"-borderwidth 0\\\n"
"-highlightthickness 0]\n"
"set Bkmk(bopts) [list -bg $param(color-buttonbg) \\\n"
"-fg $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-highlightbackground $param(color-ctlbg)\\\n"
"-font $param(bigfont) ]\n"
"return 0\n"
"}\n"
"proc BkmkAdd { } {\n"
"global param widget Bkmk\n"
"if { ![bkGetLock] } { return }\n"
"$widget(SL) config -cursor {sb_up_arrow}\n"
"set Bkmk(set_time) 0\n"
"set eopts $Bkmk(eopts)\n"
"set lopts $Bkmk(lopts)\n"
"set bopts $Bkmk(bopts)\n"
"set dlg .bkdlg\n"
"toplevel $dlg\n"
"wm title $dlg \"Add Bookmark\"\n"
"wm minsize $dlg 200 150\n"
"set maxwid 0\n"
"foreach field $Bkmk(record) { \n"
"if { $field != \"comment\" } {\n"
"set maxwid [max [string length $field] $maxwid]\n"
"}\n"
"}\n"
"set ctr 0\n"
"set Bkmk(set_time)     [format \"%.2f\" [expr [SLGetTime $widget(SL) $widget(SL,urhere)] / 1000.0 + $param(TimeWindow) / 2]]\n"
"set Bkmk(set_type)     \"U\"\n"
"set Bkmk(set_priority) 1\n"
"set Bkmk(set_comment)  \"\"\n"
"foreach field $Bkmk(record) {\n"
"set Field [string toupper [string range $field 0 0]][string range $field 1 end]\n"
"if { $Field == \"Time\" } { set Field \"Time (s)\" }\n"
"set f [frame $dlg.f$ctr -bg $param(color-ctlbg)]\n"
"if { $field != \"comment\" } {\n"
"eval {label $f.nm$field -text \"$Field\" -width $maxwid -anchor w} $lopts\n"
"eval {entry $f.v$field -width 20 -textvariable Bkmk(set_$field)} $eopts\n"
"pack $f.nm$field $f.v$field -side left -anchor w -fill x\n"
"} else {\n"
"eval {label $f.nm$field -text \"Comment:\" -width $maxwid -anchor w} $lopts\n"
"set f2 [frame $f.txt]\n"
"text $f2.comment -height 6 -width 40 -wrap word \\\n"
"-yscrollcommand \"$f2.sy set\" -bg white\n"
"scrollbar $f2.sy -orient vert -command \"$f2.v$field yview\"\n"
"pack $f2.sy -side right -fill y\n"
"pack $f2.comment -side left -fill both -expand 1\n"
"pack $f.nm$field $f2 -side top -anchor w\n"
"set Bkmk(W,comment) $f2.comment\n"
"}\n"
"pack $f -side top -anchor w -fill both -expand 1\n"
"incr ctr\n"
"}\n"
"set f [frame $dlg.cmd -bg $param(color-ctlbg)]\n"
"eval {button $f.ok -text OK -command bkAddOk } $bopts\n"
"eval {button $f.cancel -text Cancel -command bkAddCancel } $bopts\n"
"pack $f.ok $f.cancel -side left -expand 1 -fill x\n"
"pack $f -expand 1 -fill both\n"
"set Bkmk(bind_SLMotion) [bind $widget(SL) <Motion>]\n"
"bind $widget(SL) <Motion> {\n"
"focus .bkdlg\n"
"if { [expr abs(%y - $param(SL,mid))] < 10 } {\n"
"set Bkmk(set_time) [max 0 [SLPosToTime %x]]\n"
"}\n"
"}\n"
"set Bkmk(bind_SLB1) [bind $widget(SL) <Button-1>]\n"
"bind $widget(SL) <Button-1> {\n"
"if { [expr abs(%y - $param(SL,mid))] < 10 } {\011\011\n"
"bkAddMarker yes\n"
"}\n"
"focus .bkdlg\n"
"}\n"
"set Bkmk(bind_SLLeave) [bind $widget(SL) <Leave>]\n"
"bind $widget(SL) <Leave> {\n"
"set w [$widget(SL) find withtag bkmk$Bkmk(Num)]\n"
"if { $w != \"\" } {\n"
"set Bkmk(set_time) \\\n"
"[SLPosToTime [lindex [$widget(SL) coords $w] 0]] \n"
"}\n"
"focus .bkdlg\n"
"}\n"
"set Bkmk(bind_B1) [bind $widget(graph,0) <Button-1>]\n"
"set Bkmk(bind_Motion) [bind $widget(graph,0) <B1-Motion>]\n"
"set Bkmk(bind_Release) [bind $widget(graph,0) <ButtonRelease-1>]\n"
"bind $widget(graph,0) <Button-1> {\n"
"set x [lindex [$widget(graph,0) invtransform %x %y] 0]\n"
"set Bkmk(set_time) [prec [expr $x / $param(_scale) ]]\n"
"bkAddMarker yes\n"
"focus .bkdlg\n"
"}\n"
"bind $widget(graph,0) <B1-Motion> {}\n"
"bind $widget(graph,0) <ButtonRelease-1> {}\011\n"
"}\n"
"proc prec { var {num 2}} { set s \"%.${num}f\" ; return [format $s $var] }\n"
"proc bkAddOk { } {\n"
"global Bkmk widget\n"
"set n $Bkmk(Num)\n"
"set cmnt [$Bkmk(W,comment) get 1.0 end]\n"
"if { $cmnt == \"\" } {\n"
"set cmnt \"<None>\"\n"
"}\n"
"foreach field $Bkmk(record) {\n"
"if { $field != \"comment\" } {\n"
"set Bkmk($n,$field) $Bkmk(set_$field)\n"
"}\n"
"}\n"
"set Bkmk($n,comment) $cmnt\n"
"set chk [bkAddCheck]\n"
"if {$chk != \"\"} {\n"
"ErrorBox \"$chk\" \"Bookmark Value Error\" .bkerr\n"
"bkReleaseLock\n"
"} else {\n"
"bkAddMarker\n"
"incr Bkmk(Num)\n"
"bkAddCleanup\n"
"BkmkSave\n"
"if { !$Bkmk(auto) } {\n"
"bkListUpdate\n"
"}\n"
"}\n"
"}\n"
"proc bkAddCheck { {t \"NULL\"} {p \"NULL\"} {ty \"NULL\"} } {\n"
"global Bkmk\n"
"if { $t == \"NULL\"  } { set t $Bkmk(set_time) }\n"
"if { $p == \"NULL\"  } { set p $Bkmk(set_priority) }\n"
"if { $ty == \"NULL\" } { set ty $Bkmk(set_type) }\n"
"set r \"\"\n"
"set numexp {-?[0-9]+\\.?[0-9]*}\n"
"if { ! [regexp -- $numexp $t] } {\n"
"set r \"Invalid time: must be a number.\\n\"\n"
"}\n"
"if { ! [regexp -- $numexp $p] } {\n"
"set r \"${r}Invalid severity: must be a number.\\n\"\n"
"}\n"
"if { ! [regexp \"U|S\" $ty] } {\n"
"set r \"${r}Invalid type: must be U(ser) or S(ystem).\\n\"\n"
"}\n"
"return $r\n"
"}\n"
"proc bkAddMarker { {move no} {t -1} {n -1}} {\n"
"global widget Bkmk\n"
"if { $n < 0 } {\n"
"set n $Bkmk(Num)\n"
"}\n"
"if { $t < 0 } { \n"
"set t $Bkmk(set_time)\n"
"}\n"
"set w [$widget(SL) find withtag bkmk$n]\n"
"if { $w == \"\" } {\n"
"SLAddMarker bkmk$n $widget(SL) adown $Bkmk(color) $t up no\n"
"} elseif { $move } {\n"
"SLMoveMarker $widget(SL) bkmk$n $t\n"
"}\n"
"}\n"
"proc bkAddCancel { } {\n"
"global Bkmk widget\n"
"SLRemoveMarker $widget(SL) bkmk$Bkmk(Num)\n"
"bkAddCleanup\n"
"}\n"
"proc bkAddCleanup { } {\n"
"global widget Bkmk\n"
"destroy .bkdlg\n"
"$widget(SL) config -cursor {left_ptr}\n"
"bind $widget(SL) <Motion> $Bkmk(bind_SLMotion)\n"
"bind $widget(SL) <Button-1> $Bkmk(bind_SLB1)\n"
"bind $widget(SL) <Leave> $Bkmk(bind_SLLeave)\n"
"bind $widget(graph,0) <Button-1> $Bkmk(bind_B1)\n"
"bind $widget(graph,0) <B1-Motion> $Bkmk(bind_Motion)\n"
"bind $widget(graph,0) <ButtonRelease-1> $Bkmk(bind_Release)\n"
"bkReleaseLock\n"
"}\n"
"proc BkmkModify { } {\n"
"}\n"
"proc BkmkSave { } {\n"
"global Bkmk\n"
"if { $Bkmk(file) == \"\" } { return }\n"
"set f [open $Bkmk(file) \"w\"]\n"
"for { set i 0 } { $i < $Bkmk(Num) } { incr i } {\n"
"foreach field $Bkmk(record) {\n"
"regsub -all \"\\n\" $Bkmk($i,$field) \" \" $field\n"
"}\n"
"puts $f [bkSaveFormat \"$time\" \"$type\" \"$severity\" \"$loc\" \"$comment\" \"$eset\" ]\n"
"}\n"
"close $f\n"
"}\n"
"proc bkSaveFormat { time type severity loclist comment eset } {\n"
"if { $type == \"User\" || $type == \"U\" } {\n"
"set ctype \"U\"\n"
"} else {\n"
"set ctype \"S\"\n"
"}\n"
"set locstr [join $loclist \",\"]\n"
"return \"$ctype;$severity;$time;$locstr;$comment;$eset\"\n"
"}\n"
"proc bkLoadAdd { f } {\n"
"global Bkmk\n"
"set cnt 0\n"
"set i $Bkmk(Num)\n"
"set l1 [gets $f]\n"
"while { ![eof $f] } {\n"
"if { $l1 == \"\" } {\n"
"ErrorBox \"Empty line in bookmark file.\\n$cnt bookmarks loaded.\" \\\n"
"\"Bookmark Load Error\" .bkerr\n"
"set Bkmk(Num) $i\n"
"return\n"
"}\n"
"set r [bkLoadParse $i \"$l1\"]\n"
"if { $r != \"\" } {\n"
"ErrorBox \"$r.\\n$cnt bookmarks loaded.\" \"Bookmark Load Error\" .bkerr\n"
"set Bkmk(Num) $i\n"
"return\n"
"}\011    \n"
"set r [bkAddCheck $Bkmk($i,time) $Bkmk($i,severity) $Bkmk($i,type)]\n"
"if { $r != \"\" } {\n"
"ErrorBox \"$r.\\n$cnt bookmarks loaded.\" \"Bookmark Load Error\" .bkerr\n"
"set Bkmk(Num) $i\n"
"return\n"
"}\n"
"bkAddMarker no $Bkmk($i,time) $i\n"
"bkShowPosition $Bkmk($i,time)\n"
"incr cnt\n"
"incr i\n"
"set l1 [gets $f]\n"
"}\n"
"set Bkmk(Num) $i\n"
"}\n"
"proc bkLoadParse { num s } {\n"
"global Bkmk\n"
"set locs \"\"\n"
"regexp -nocase {([^\\;]+);([0-9]*);([0-9.E-]*);([^;]*);([^;]*);([^;]*)} $s \\\n"
"matchvar Bkmk($num,type) Bkmk($num,severity) Bkmk($num,time) \\\n"
"locs Bkmk($num,comment) Bkmk($num,eset)\n"
"set Bkmk($num,loc) [split $locs \",\"]\n"
"return\n"
"}\n"
"proc bkLoadMerge { f } {\n"
"global Bkmk\n"
"if { $f == \"\" } { return }\n"
"bkLoadAdd $f\n"
"close $f\n"
"bkListUpdate\n"
"}\n"
"proc bkLoadReplace { f } {\n"
"global Bkmk\n"
"if { $f == \"\" } { return }\n"
"set Bkmk(Num) 0\n"
"bkLoadAdd $f\n"
"close $f\n"
"bkListUpdate\n"
"}\n"
"proc BkmkList { } {\n"
"global param widget Bkmk\n"
"if { [BkmkDlgSetup 1] != 0 } {\n"
"return\n"
"}\n"
"set Bkmk(View) yes\n"
"set dlg .bklist\n"
"toplevel $dlg\n"
"wm title $dlg \"List of Bookmarks\"\n"
"wm resizable $dlg 0 0\n"
"set lopts $Bkmk(lopts)\n"
"set bopts $Bkmk(bopts)\n"
"frame $dlg.lbl -bg $param(color-ctlbg)\n"
"frame $dlg.but -bg $param(color-ctlbg)\n"
"frame $dlg.but.1 -bg $param(color-ctlbg)\n"
"frame $dlg.but.2 -bg $param(color-ctlbg)\n"
"set f $dlg.lbl\n"
"eval {label $f.nm1 -padx 5 -text \"Type\"     -width 4} $lopts\n"
"eval {label $f.nm2 -padx 5 -text \"Lvl\"      -width 3} $lopts\n"
"eval {label $f.nm3 -padx 5 -text \"Time (sec)\" -width 8} $lopts\n"
"eval {label $f.nm4 -padx 5 -text \"Comment\"  -width 36} $lopts\n"
"eval {label $f.nm5 -padx 5 -text \"Key Set\" -width 8} $lopts\n"
"pack $f.nm1 $f.nm2 $f.nm3 $f.nm4 $f.nm5  -side left\n"
"pack $dlg.lbl -side top -expand 1 -fill both\n"
"set f $dlg.but.1 \n"
"eval {button $f.sv -text \"Save\" -command BkmkSave} $bopts\n"
"eval {button $f.ld -text \"Load\" -command BkmkLoad} $bopts\n"
"if { $Bkmk(auto) } {\n"
"$f.sv configure -state disabled\n"
"$f.ld configure -state disabled\n"
"}\n"
"pack $f.sv $f.ld -side left\n"
"set f $dlg.but.2\n"
"eval {button $f.ad -text \"Add\" -command BkmkAdd } $bopts\n"
"eval {button $f.rm -text \"Delete\" -command bkListDelete } $bopts\n"
"eval {button $f.go -text \"Goto\" -command bkListGoto } $bopts\n"
"eval {button $f.sw -text \"Show\" -command bkListShow } $bopts\n"
"eval {button $f.ok -text \"Done\" -command bkListOk } $bopts\n"
"pack $f.ad $f.rm $f.go $f.sw -side left -anchor w\n"
"pack $f.ok -side right -anchor e\n"
"pack $dlg.but.1 $dlg.but.2 -side left -expand 1\n"
"pack $dlg.but -side bottom -fill both -expand 1\n"
"set f [frame $dlg.f2 -bg $param(color-ctlbg)]\n"
"set lb1 [ScrolledLBh $f.1 -width 4  -selectmode 1 -height 10 -background white]\n"
"set lb2 [ScrolledLBh $f.2 -width 3  -selectmode 1 -height 10 -background white]\n"
"set lb3 [ScrolledLBh $f.3 -width 8 -selectmode 1 -height 10 -background white]\n"
"set lb4 [ScrolledLBh $f.4 -width 36 -selectmode 1 -height 10 -background white]\n"
"set lb5 [ScrolledLB $f.5 -width 8 -selectmode 1 -height 10 -background white]\n"
"$f.5.sy configure -command [list multiscroll $f]\n"
"pack $f.1 $f.2 $f.3 $f.4 $f.5 -side left\n"
"pack $f -side bottom -expand 1 -fill both\n"
"foreach i {1 2 3 4 5} { \n"
"set widget(BkmkL$i) [set lb$i]\n"
"}\n"
"bkListUpdate\n"
"foreach i {1 2 3 4} {\n"
"set e lb$i\n"
"bind [set $e] <ButtonPress-1> { set Bkmk(GotoSel) [%W nearest %y] }       \n"
"bind [set $e] <ButtonPress-2> { set Bkmk(GotoSel) [%W nearest %y]; bkListGoto } \n"
"}\n"
"}\n"
"proc multiscroll { b cmd v {wrd \"!\"}} {\n"
"foreach i {1 2 3 4 5} {\n"
"if { $wrd == \"!\" } {\n"
"$b.$i.lb yview $cmd $v\n"
"} else {\n"
"$b.$i.lb yview $cmd $v $wrd\n"
"}\n"
"}\n"
"}\n"
"proc bkListUpdate { } {\n"
"global Bkmk widget\n"
"if { ![info exists Bkmk(View)] } { \n"
"bkReleaseLock\n"
"return \n"
"}\n"
"foreach i {1 2 3 4 5} {\n"
"$widget(BkmkL$i) delete 0 end\n"
"}\n"
"for { set i 0 } { $i < $Bkmk(Num) } { incr i } {\n"
"$widget(BkmkL1) insert end $Bkmk($i,type)\n"
"$widget(BkmkL2) insert end $Bkmk($i,severity)\n"
"$widget(BkmkL3) insert end [prec $Bkmk($i,time)]\n"
"$widget(BkmkL4) insert end \"$Bkmk($i,comment) \"\n"
"$widget(BkmkL5) insert end $Bkmk($i,eset) \n"
"}\n"
"update idletasks\n"
"}\n"
"proc bkListOk { } {\n"
"global widget Bkmk\n"
"bkListCleanup\n"
"}\n"
"proc bkListCleanup { } {\n"
"global widget Bkmk\n"
"destroy .bklist\n"
"unset Bkmk(View)\n"
"}\n"
"proc bkListGoto { } {\n"
"global Bkmk widget param\n"
"if { ![info exists Bkmk(GotoSel)] } {\n"
"bkReleaseLock\n"
"return\n"
"}\n"
"set sel $Bkmk(GotoSel)\n"
"if { ![info exists Bkmk($sel,time)] } {\n"
"bkReleaseLock\n"
"return\n"
"}\n"
"set t [expr $Bkmk($sel,time) - $param(TimeWindow) / 2]\n"
"if { $t < 0 } { set t 0 }\n"
"SLMoveMarker $widget(SL) $widget(SL,urhere) $t\n"
"Refresh 1\n"
"bkListShow no\n"
"bkReleaseLock\n"
"}\n"
"proc bkListShow { {refresh no} } {\n"
"global Bkmk widget param\n"
"if { ![info exists Bkmk(GotoSel)] } {\n"
"bkReleaseLock\n"
"return\n"
"}\n"
"set sel $Bkmk(GotoSel)\n"
"if { ![info exists Bkmk($sel,time)] } {\n"
"bkReleaseLock\n"
"return\n"
"}\n"
"bkShowPosition $Bkmk($sel,time)\n"
"SetFilePosSymbols $Bkmk($sel,loc) $param(bookmarksymbol)\n"
"if { $refresh } {\n"
"Refresh 1\n"
"}\n"
"bkReleaseLock\n"
"}\n"
"proc bkListDelete { } {\n"
"global Bkmk widget\n"
"if { ![bkGetLock] } { return }\n"
"set sel [$widget(BkmkL1) curselection]\n"
"if { [llength $sel] > 1 || ![info exists Bkmk($sel,time)] } { \n"
"bkReleaseLock\n"
"return\n"
"}\n"
"SLRemoveMarker $widget(SL) bkmk$sel\n"
"for { set i $sel } { $i < [expr $Bkmk(Num)-1] } { incr i } {\n"
"set j [expr $i+1]\n"
"foreach fld $Bkmk(record) {\n"
"set Bkmk($i,$fld) $Bkmk($j,$fld)\n"
"}\n"
"SLRenameMarker $widget(SL) bkmk$j bkmk$i\n"
"}\n"
"for {set i 1} {$i <= 5} {incr i} {\n"
"$widget(BkmkL$i) delete $sel\n"
"}\n"
"incr Bkmk(Num) -1\n"
"BkmkSave\n"
"bkReleaseLock\n"
"}\n"
"proc bkShowPosition { t } {\n"
"global param widget\n"
"set g $widget(graph,0)\n"
"set t [expr $t * $param(_scale) * 1.0 ]\n"
"$g element configure bkmk -xdata [list $t $t] -ydata [$g yaxis limits]\n"
"}\n"
"proc BkmkFileDlg { } {\n"
"global Bkmk param env\n"
"if { ![bkGetLock] } { return }\n"
"BkmkDlgSetup 0\n"
"set eopts $Bkmk(eopts)\n"
"set lopts $Bkmk(lopts)\n"
"set bopts $Bkmk(bopts)\n"
"set dlg .bkfile\n"
"toplevel $dlg\n"
"wm title $dlg \"Choose Bookmark File\"\n"
"wm minsize $dlg 350 150\n"
"set f1 [frame $dlg.f1 -bg $param(color-ctlbg)]\n"
"set f2 [frame $dlg.f2 -bg $param(color-ctlbg)]\n"
"set f3 [frame $dlg.f3 -bg $param(color-ctlbg)]\n"
"eval { label $f1.dnm -text \"Directory\" -width 10 } $lopts\n"
"eval { entry $f1.de -textvariable Bkmk(dir) -width 32 } $eopts\n"
"eval { label $f2.fnm -text \"File\" -width 10 } $lopts\n"
"eval { entry $f2.fe -textvariable Bkmk(fname) -width 32 } $eopts\n"
"eval { button $f3.ok -text \"OK\" -command bkFileOK } $bopts\n"
"eval { button $f3.cancel -text \"Cancel\" -command bkFileCancel } $bopts\n"
"eval { checkbutton $f3.auto -text \"Auto-update\" -variable Bkmk(auto) } $bopts\n"
"set Bkmk(old_dir)   $Bkmk(dir)\n"
"set Bkmk(old_file)  $Bkmk(file)\n"
"set Bkmk(old_fname) $Bkmk(fname)\n"
"set Bkmk(old_auto)  $Bkmk(auto)\n"
"if { $Bkmk(dir) == \"!NEW!\" } {\n"
"set df [bkCleanFilename $env(PWD) $param(fname)]\n"
"set f [lindex $df 1]\n"
"set len [string length $f]\n"
"if { $len > 5 && [string range $f [expr $len - 4] end] == \".log\" } {\n"
"set Bkmk(fname) \"[string range $f 0 [expr $len - 5]].bkmk\"\n"
"} else {\n"
"set Bkmk(fname) \"$f.bkmk\"\n"
"}\n"
"set Bkmk(dir) [lindex $df 0]\n"
"} else {\n"
"set df [bkCleanFilename $Bkmk(dir) $Bkmk(fname)]\n"
"set Bkmk(dir) [lindex $df 0]\n"
"set Bkmk(fname) [lindex $df 1]\n"
"}\n"
"pack $f1.dnm $f1.de -side left -anchor w\n"
"pack $f2.fnm $f2.fe -side left -anchor w\n"
"pack $f3.ok -side left -padx 20\n"
"pack $f3.auto -side right -anchor e\n"
"pack $f3.cancel -side right -padx 20\n"
"pack $f1 $f2 $f3 -side top -anchor w -expand 1 -fill both\n"
"}\n"
"proc bkFileOK { {gui 1} } {\n"
"global Bkmk\n"
"set err \"Bookmark Error\"\n"
"set win .errdlg\n"
"if { $Bkmk(fname) == \"\" } {\n"
"ErrorBox \"No file specified.\" $err $win\n"
"} else {\n"
"set tmp [bkCleanFilename $Bkmk(dir) $Bkmk(fname)]\n"
"set Bkmk(dir) [lindex $tmp 0]\n"
"set Bkmk(fname) [lindex $tmp 1]\n"
"set Bkmk(file) \"$Bkmk(dir)/$Bkmk(fname)\"\n"
"puts \"file = $Bkmk(file)\"\n"
"set f $Bkmk(file)\n"
"if { ![file exists $f] } {\n"
"close [open $f \"w\"]\n"
"}\n"
"if { ![file writable $f] || ![file readable $f] } {\n"
"ErrorBox \"Cannot read and write to file '$f'.\" $err $win\n"
"} else {\n"
"if { $gui } { bkFileRemoveDlg }\n"
"bkUpdateFromFile\n"
"}\n"
"}\n"
"}\n"
"proc bkFileCancel { } {\n"
"global Bkmk\n"
"set Bkmk(file) $Bkmk(old_file)\n"
"set Bkmk(fname) $Bkmk(old_fname)\n"
"set Bkmk(dir)  $Bkmk(old_dir)\n"
"set Bkmk(auto) $Bkmk(old_auto)\n"
"bkFileRemoveDlg\n"
"}\n"
"proc bkFileRemoveDlg { } {\n"
"bkReleaseLock\n"
"destroy .bkfile\n"
"}\n"
"proc bkCleanFilename { cwd f } {\n"
"regexp {^.*\\/} $f fpath\n"
"if { [info exists fpath] } {\n"
"regsub {^.*\\/} $f \"\" f\n"
"cd $fpath\n"
"set x [pwd]\n"
"cd $cwd\n"
"return [list $x $f]\n"
"}\n"
"return [list $cwd $f]\n"
"}\n"
"proc bkUpdateFromFile { } {\n"
"global Bkmk\n"
"if { ![bkGetLock] } { return }\n"
"bkLoadReplace [open $Bkmk(file) \"r\"]\n"
"bkReleaseLock\n"
"}\n"
"proc bkGetLock { } {\n"
"global Bkmk\n"
"if { !$Bkmk(lock) } {\n"
"set Bkmk(lock) 1\n"
"return 1\n"
"}\n"
"return 0\n"
"}\n"
"proc bkReleaseLock { } {\n"
"global Bkmk\n"
"set Bkmk(lock) 0\n"
"}\n"
;
static char Et_zFile39[] = 
"set param(EVENT,DEFAULT,GTYPE)     LINE\n"
"set param(EVENT,DEFAULT,ID)        HOST\n"
"set param(EVENT,DEFAULT,GROUP)     HOST\n"
"set param(EVENT,DEFAULT,HOSTALIAS) NULL\n"
"set param(EVENT,DEFAULT,VAL)       NULL\n"
"set param(EVENT,DEFAULT,EVIS)      +\n"
"set param(EVENT,DEFAULT,SVIS)      +\n"
"set param(EVENT,DEFAULT,CALCPARM)  NULL\n"
"proc EK_readFile { filename } {\n"
"global param\n"
"set ctr 0\n"
"set nextline \"\"\n"
"if { ![file exists $filename] || ![file readable $filename] } {\n"
"return \"!File $filename is not readable.\"\n"
"}\n"
"set fd [open $filename r]\n"
"set param(EVENT,HOSTALIAS) {}\n"
"set nextline [EK_skipComments $fd [gets $fd]]\n"
"while { ![eof $fd] } {\n"
"while { [string range $nextline 0 8] == \"hostalias\" } {\n"
"if { $param(EVENT,HOSTALIAS) != \"\" } {\n"
"set param(EVENT,HOSTALIAS) \\\n"
"[lappend param(EVENT,HOSTALIAS) \"&\"]\n"
"}\n"
"set param(EVENT,HOSTALIAS) \\\n"
"[lappend param(EVENT,HOSTALIAS) \\\n"
"\"[string trim [string range $nextline 10 end]]\"]\n"
"set nextline [EK_skipComments $fd [gets $fd]]\n"
"}\n"
"set nextline [EK_readSet $fd $ctr $nextline]\n"
"if { [string range $nextline 0 0] == \"!\" } {\n"
"return $nextline\n"
"}\n"
"incr ctr\n"
"}\n"
"set param(EVENT,NUMSETS) $ctr\n"
"if { [llength $param(EVENT,HOSTALIAS)] == 0 } {\n"
"set param(EVENT,HOSTALIAS) $param(EVENT,DEFAULT,HOSTALIAS)\n"
"}\n"
"return\n"
"}\n"
"proc EK_readSet { fd ctr line } {\n"
"global param\n"
"if { $line == \"\" } {\n"
"set line [EK_cleanLine $fd]\n"
"}\n"
"set line [EK_skipComments $fd $line]\n"
"if { [eof $fd] } {\n"
"return\n"
"}\n"
"if { [string range $line 0 3] == \"set \" } {\n"
"set nm [string trim [string range $line 3 end]]\n"
"if { $nm == \"\" } {\n"
"return \"!Empty set name\"\n"
"}\n"
"set c [string range $nm 0 0]\n"
"if {  $c != \"+\" && $c != \"-\" } {\n"
"set nm $param(EVENT,DEFAULT,SVIS)$nm\n"
"}\n"
"set param(EVENT,$ctr) $nm\n"
"set r [EK_readHeader $fd $ctr]\n"
"if { [string range $r 0 0] == \"!\" } {\n"
"return $r\n"
"}\n"
"set r [EK_readEvents $fd $ctr $r]\n"
"if { [string range $r 0 0] == \"!\" } {\n"
"return $r\n"
"}\n"
"} else {\n"
"return \"!Word 'set' expected on this line:\\n$line\"\n"
"}\n"
"return $r\n"
"}\n"
"proc EK_readHeader { fd ctr } {\n"
"global param\n"
"set line [EK_cleanLine $fd]\n"
"set line [EK_skipComments $fd $line]\n"
"if { [eof $fd] } {\n"
"return \"!EOF encountered before reading set header.\"\n"
"}\n"
"set param(EVENT,ID,$ctr) {}\n"
"set param(EVENT,HOSTID,$ctr) {}\n"
"set param(EVENT,GTYPE,$ctr) {}\n"
"set param(EVENT,VAL,$ctr) {}\n"
"set param(EVENT,CALCPARM,$ctr) \"\"\n"
"set param(EVENT,NUMFORMS,$ctr) 0\n"
"while { 1 } {\n"
"if { [string range $line 0 1] == \"id\" } {\n"
"set param(EVENT,ID,$ctr) \\\n"
"\"[string trim [string range $line 2 end]]\"\n"
"} elseif { [string range $line 0 5] == \"hostid\" } {\n"
"set param(EVENT,HOSTID,$ctr) \\\n"
"\"[string trim [string range $line 6 end]]\"\n"
"} elseif { [string range $line 0 3] == \"type\" } {\n"
"set param(EVENT,GTYPE,$ctr) \\\n"
"\"[string trim [string range $line 4 end]]\"\n"
"} elseif { [string range $line 0 2] == \"val\" } {\n"
"set param(EVENT,VAL,$ctr) \\\n"
"\"[string trim [string range $line 3 end]]\"\n"
"} elseif { [string range $line 0 6] == \"formula\" } {\n"
"set n $param(EVENT,NUMFORMS,$ctr)\n"
"set param(EVENT,FORM$n,$ctr) \\\n"
"\"[string trim [string range $line 7 end]]\"\n"
"incr param(EVENT,NUMFORMS,$ctr)\n"
"} elseif { [string range $line 0 3] == \"calc\" } {\n"
"if { $param(EVENT,CALCPARM,$ctr) != \"\" } {\n"
"set param(EVENT,CALCPARM,$ctr) \\\n"
"[lappend param(EVENT,CALCPARM,$ctr) \"&\"]\n"
"}\n"
"set param(EVENT,CALCPARM,$ctr) \\\n"
"[lappend param(EVENT,CALCPARM,$ctr) \\\n"
"\"[string trim [string range $line 4 end]]\"]\n"
"} else {\n"
"break\n"
"}\n"
"set line [EK_cleanLine $fd]\n"
"set line [EK_skipComments $fd $line]\n"
"}\n"
"foreach p {ID HOSTID GTYPE CALCPARM} {\n"
"if { [llength $param(EVENT,$p,$ctr)] == 0 } {\n"
"set param(EVENT,$p,$ctr) $param(EVENT,DEFAULT,$p)\n"
"}\n"
"}\n"
"return $line\n"
"}\n"
"proc EK_readEvents { fd ctr line } {\n"
"global param\n"
"set ectr 0\n"
"if { $line == \"\" } {\n"
"set line [EK_cleanLine $fd]\n"
"}\n"
"set line [EK_skipComments $fd $line]\n"
"while { ![eof $fd] && [string range $line 0 2] != \"set\" } {\n"
"set c [string range $line 0 0]\n"
"if { $c != \"+\" && $c != \"-\" } {\n"
"set line $param(EVENT,DEFAULT,EVIS)$line\n"
"}\n"
"set param(EVENT,$ctr,$ectr) $line\n"
"incr ectr\n"
"set line [EK_cleanLine $fd]\n"
"set line [EK_skipComments $fd $line]\n"
"}\n"
"if { $ectr == 0 } {\n"
"return \"!EOF encountered before reading any events.\"\n"
"}\n"
"set param(EVENT,NUMKEYS,$ctr) $ectr\n"
"return $line\n"
"}\n"
"proc EK_cleanLine { fd } {\n"
"return [string trim [gets $fd] \" \\t\"]\n"
"}\n"
"proc EK_skipComments { fd line } {\n"
"while { [string range $line 0 0] == \"#\" && ![eof $fd] } {\n"
"set line [EK_cleanLine $fd]\n"
"}\n"
"return $line\n"
"}\n"
;
static char Et_zFile40[] = 
"proc IPSelect { parent } {\n"
"global param\n"
"set bwid 10\n"
"set bbg $param(color-buttonbg)\n"
"set bag $param(color-buttonabg)\n"
"set bfg $param(color-buttonfg)\n"
"set cbg $param(color-ctlbg)\n"
"set lbg #ffffff\n"
"toplevel $parent\n"
"frame $parent.1 -background $cbg\n"
"frame $parent.2 -background $cbg\n"
"frame $parent.3 -background $cbg\n"
"frame $parent.1.spacer -background $cbg -width $bwid\n"
"frame $parent.2.but -background $cbg\n"
"label $parent.1.l1 -text \"IP Addresses\" -anchor w -justify left -width 20 \\\n"
"-background $cbg\n"
"pack $parent.1.l1 $parent.1.l1 -side left\n"
"set lsht 8\n"
"set list1 [ScrolledLB $parent.2.lb1 -width 20 -selectmode 1 -height $lsht -background $lbg]\n"
"$parent.2.lb1.pad configure -background $cbg\n"
"bind $list1 <ButtonPress-1> \\\n"
"[list SelectIP $list1 %y]\n"
"button $parent.2.but.sel -text \"+All\" -width $bwid \\\n"
"-background $bbg -foreground $bfg -activebackground $bag \\\n"
"-borderwidth 4 -highlightbackground $cbg \\\n"
"-command [list SetIPs $list1 +]\n"
"button $parent.2.but.desel -text \"-All\" -width $bwid \\\n"
"-background $bbg -foreground $bfg -activebackground $bag \\\n"
"-borderwidth 4 -highlightbackground $cbg \\\n"
"-command [list SetIPs $list1 -] \n"
"pack $parent.2.but.sel $parent.2.but.desel -side top\n"
"pack $parent.2.lb1 $parent.2.but -side left\n"
"button $parent.3.ok -text \"OK\" -padx 5 -pady 5 \\\n"
"-background $bbg -foreground $bfg -activebackground $bag \\\n"
"-borderwidth 4 -highlightbackground $cbg \\\n"
"-command [list ipOKButtonPressed $parent]\n"
"button $parent.3.cancel -text \"Cancel\" -padx 5 -pady 5 \\\n"
"-background $bbg -foreground $bfg -activebackground $bag \\\n"
"-borderwidth 4 -highlightbackground $cbg \\\n"
"-command [list ipCancelButtonPressed $parent]\n"
"pack $parent.3.ok $parent.3.cancel \\\n"
"-side left -padx 20 -pady 10\n"
"pack $parent.1 $parent.2 $parent.3 -side top -fill both\n"
"ShowIPs $list1\n"
"$list1 selection set 0\n"
"return $parent\n"
"}\n"
"proc SetIPs { tgt_lb val } {\n"
"global param\n"
"set len [llength $param(IPList)]\n"
"for { set i 0 } { $i < $len } { incr i } {\n"
"SetAtIndex $i $val\n"
"}\n"
"ShowIPs $tgt_lb\n"
"return\n"
"}\n"
"proc ToggleIP { ip } {\n"
"set val [string range $ip 0 0]\n"
"if { $val == \"+\" } {\n"
"return \"-[string range $ip 1 end]\"\n"
"} else {\n"
"return \"+[string range $ip 1 end]\"\n"
"}\n"
"}    \n"
"proc SetIP { ip newval } {\n"
"return \"$newval[string range $ip 1 end]\"\n"
"}    \n"
"proc ToggleAtIndex { idx } {\n"
"global param\n"
"set ip [lindex $param(IPList) $idx]\n"
"set ip [ToggleIP $ip]\n"
"set param(IPList) [lreplace $param(IPList) $idx $idx $ip]\n"
"}\n"
"proc SetAtIndex { idx newval } {\n"
"global param\n"
"set ip [lindex $param(IPList) $idx]\n"
"set ip [SetIP $ip $newval]\n"
"set param(IPList) [lreplace $param(IPList) $idx $idx $ip]\n"
"}\n"
"proc SelectIP { lb y } {\n"
"global param\n"
"set idx [$lb nearest $y]\n"
"ToggleAtIndex $idx\n"
"ShowIPs $lb\n"
"return\n"
"}\n"
"proc ShowIPs { lb } {\n"
"global param\n"
"$lb delete 0 end\n"
"set i 0\n"
"foreach i $param(IPList) {\n"
"$lb insert end $i\n"
"}\n"
"}\n"
"proc ipOKButtonPressed { parent } {\n"
"global param didPause\n"
"SetIPList\n"
"set param(ViewChanged) 1\n"
"Refresh\n"
"destroy $parent\n"
"update idletasks\n"
"if { $didPause } {\n"
"set param(Paused) 0\n"
"Play\n"
"}\n"
"}\n"
"proc ipCancelButtonPressed { parent } {\n"
"global didPause\n"
"destroy $parent\n"
"if { $didPause } {\n"
"set param(Paused) 0\n"
"Play\n"
"}\n"
"}\n"
"proc ShowIPDlg { } {\n"
"global param didPause\n"
"if { $param(Paused) == 0 } { \n"
"set param(Paused) 1\n"
"Pause\n"
"set didPause 1 \n"
"} else {\n"
"set didPause 0\n"
"}\n"
"GetIPList\n"
"set dlg [IPSelect .ip]\n"
"wm title $dlg \"Select IP Addresses to Display\"\n"
"wm geometry $dlg +100+200\n"
"}\n"
"global didPause\n"
;
static char Et_zFile41[] = 
"proc ScrolledLB { parent args} {\n"
"global param\n"
"set sbg $param(color-ctlbg)\n"
"frame $parent\n"
"eval {listbox $parent.lb \\\n"
"-yscrollcommand [list $parent.sy set] \\\n"
"-xscrollcommand [list $parent.sx set]} $args\n"
"scrollbar $parent.sy \\\n"
"-orient vertical \\\n"
"-width 12 \\\n"
"-background $sbg \\\n"
"-activebackground $sbg \\\n"
"-command [list $parent.lb yview]\n"
"frame $parent.bottom\n"
"scrollbar $parent.sx  \\\n"
"-orient horizontal \\\n"
"-width 12 \\\n"
"-background $sbg \\\n"
"-activebackground $sbg \\\n"
"-command [list $parent.lb xview]\n"
"set pad [expr [$parent.sy cget -width] + 2* \\\n"
"([$parent.sy cget -bd] + \\\n"
"[$parent.sy cget -highlightthickness])]\n"
"frame $parent.pad \\\n"
"-width $pad \\\n"
"-height $pad \\\n"
"-bg $sbg\n"
"pack $parent.bottom -side bottom -fill x\n"
"pack $parent.pad -in $parent.bottom -side right\n"
"pack $parent.sx -in $parent.bottom -side bottom -fill x\n"
"pack $parent.sy -side right -fill y\n"
"pack $parent.lb -side left -fill both -expand true\n"
"return $parent.lb\n"
"}\n"
"proc ScrolledLBh { parent args} {\n"
"global param\n"
"set sbg $param(color-ctlbg)\n"
"frame $parent\n"
"eval {listbox $parent.lb \\\n"
"-yscrollcommand [list $parent.sy set] \\\n"
"-xscrollcommand [list $parent.sx set]} $args\n"
"scrollbar $parent.sy \\\n"
"-orient vertical \\\n"
"-width 12 \\\n"
"-background $sbg \\\n"
"-activebackground $sbg \\\n"
"-command [list $parent.lb yview]\n"
"frame $parent.bottom\n"
"scrollbar $parent.sx  \\\n"
"-orient horizontal \\\n"
"-width 12 \\\n"
"-background $sbg \\\n"
"-activebackground $sbg \\\n"
"-command [list $parent.lb xview]\n"
"pack $parent.bottom -side bottom -fill x\n"
"pack $parent.sx -in $parent.bottom -side bottom -fill x\n"
"pack $parent.lb -side left -fill both -expand true\n"
"return $parent.lb\n"
"}\n"
"proc KeySelect { parent } {\n"
"global CKeySet CKey param\n"
"set bopts [list -background $param(color-buttonbg) \\\n"
"-foreground $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-highlightbackground $param(color-ctlbg) \\\n"
"-width 5]\n"
"set cbg $param(color-ctlbg)\n"
"set fopts [list -background $cbg]\n"
"set lbg #ffffff\n"
"toplevel $parent\n"
"eval {frame $parent.1} $fopts\n"
"eval {frame $parent.2} $fopts\n"
"eval {frame $parent.3} $fopts\n"
"eval {frame $parent.1.spacer} $fopts -width 5\n"
"eval {frame $parent.2.but} $fopts\n"
"label $parent.1.l1 -text \"Event Sets\" -anchor w -justify left -width 12 \\\n"
"-background $cbg\n"
"label $parent.1.l2 -text \"Events\" -anchor w -justify left -width 20 \\\n"
"-background $cbg\n"
"pack $parent.1.l2 $parent.1.l1 -side right\n"
"set lsht 8\n"
"set list1 [ScrolledLB $parent.2.lb1 -width 12 -selectmode 1 -height $lsht -background $lbg]\n"
"$parent.2.lb1.pad configure -background $cbg\n"
"set list2 [ScrolledLB $parent.2.lb2 -width 20 -height $lsht -background $lbg]\n"
"$parent.2.lb2.pad configure -background $cbg\n"
"bind $list1 <ButtonPress-1> [list CSel 1 $list1 $list2 %y]\n"
"bind $list2 <ButtonPress-1> [list CSel 2 $list1 $list2 %y]\n"
"eval { button $parent.2.but.sel -text \"+/- Set\"  \\\n"
"-command [list ToggleSet $list1 $list2]} $bopts\n"
"eval {button $parent.2.but.up -text \"^ UP\"\\\n"
"-command [list MoveSet up $list1 $list2 ]} $bopts\n"
"eval {button $parent.2.but.down -text \"v DOWN\" \\\n"
"-command [list MoveSet down $list1 $list2]} $bopts\n"
"pack $parent.2.but.up $parent.2.but.sel $parent.2.but.down -side top\n"
"pack $parent.2.lb2 $parent.2.lb1 $parent.2.but -side right\n"
"eval {button $parent.3.ok -text \"OK\" -padx 5 -pady 5 \\\n"
"-command [list keyOKButtonPressed $parent]} $bopts\n"
"eval {button $parent.3.cancel -text \"Cancel\" -padx 5 -pady 5 \\\n"
"-command [list keyCancelButtonPressed $parent]} $bopts\n"
"pack $parent.3.ok $parent.3.cancel \\\n"
"-side left -padx 10 -pady 5\n"
"pack $parent.1 $parent.2 $parent.3 -side top -fill both\n"
"set CKeySet 0\n"
"set CKey    0\n"
"Redraw 2 $list1 $list2\n"
"return $parent\n"
"}\n"
"proc Redraw { num lb1 lb2 } {\n"
"global CSet CKeySet param\n"
"if { $num == 2 } {\n"
"$lb1 delete 0 end\n"
"for { set i 0 } { $i < $param(EVENT,NUMSETS) } { incr i } {\n"
"$lb1 insert end $param(EVENT,$i)\n"
"}\n"
"}\n"
"$lb2 delete 0 end\n"
"for { set j 0 } { $j < $param(EVENT,NUMKEYS,$CKeySet) } { incr j } {\n"
"$lb2 insert end $param(EVENT,$CKeySet,$j)\n"
"}\n"
"}\n"
"proc CSel { lnum lb1 lb2 y } {\n"
"global CKeySet CKey\n"
"switch $lnum \\\n"
"\"1\" { set CKeySet [$lb1 index @0,$y];\n"
"Redraw 2 $lb1 $lb2 } \\\n"
"\"2\" { set CKey    [$lb2 index @0,$y];\n"
"ToggleKey $lb1 $lb2 }\n"
"}\n"
"proc ToggleKey { lb1 lb2 } {\n"
"global param CKeySet CKey\n"
"set param(EVENT,$CKeySet,$CKey) [Toggle $param(EVENT,$CKeySet,$CKey)]\n"
"if { $param(EVENT,NUMKEYS,$CKeySet) == 1 && \\\n"
"[firstch $param(EVENT,$CKeySet)] != [firstch $param(EVENT,$CKeySet,$CKey)] } {\n"
"ToggleSet $lb1 $lb2\n"
"} else {\n"
"Redraw 1 none $lb2\n"
"}\n"
"}\n"
"proc ToggleSet { lb1 lb2 } {\n"
"global param CKeySet ON OFF\n"
"if { $param(EVENT,NUMKEYS,$CKeySet) == 1 && \\\n"
"[firstch $param(EVENT,$CKeySet)] == $OFF && \\\n"
"[firstch $param(EVENT,$CKeySet,0)] == $OFF } {\n"
"return\n"
"}\n"
"set param(EVENT,$CKeySet) [Toggle $param(EVENT,$CKeySet)]\n"
"Redraw 2 $lb1 $lb2\n"
"}\n"
"proc MoveSet { dir lb1 lb2 } {\n"
"global param CKey CKeySet\n"
"set old $CKeySet\n"
"set plist [list NUMKEYS]\n"
"switch $dir {\n"
"up { \n"
"if {$CKeySet == 0} return;\n"
"incr CKeySet -1\n"
"}\n"
"down {\n"
"if {$CKeySet == [expr $param(EVENT,NUMSETS) - 1]} return;\n"
"incr CKeySet\n"
"}\n"
"}\n"
"set tmp(0)  $param(EVENT,$old)\n"
"foreach i $plist {\n"
"set tmp($i) $param(EVENT,$i,$old)\n"
"}\n"
"for { set i 0 } { $i < $param(EVENT,NUMKEYS,$old) } { incr i } {\n"
"set tmp(E,$i)  $param(EVENT,$old,$i)\n"
"unset param(EVENT,$old,$i)\n"
"}\n"
"set param(EVENT,$old)         $param(EVENT,$CKeySet)\n"
"foreach i $plist {\n"
"set param(EVENT,$i,$old) $param(EVENT,$i,$CKeySet)\n"
"}\n"
"for { set i 0 } { $i < $param(EVENT,NUMKEYS,$CKeySet) } { incr i } {\n"
"set param(EVENT,$old,$i) $param(EVENT,$CKeySet,$i)\n"
"}\n"
"set param(EVENT,$CKeySet)         $tmp(0)\n"
"foreach i $plist {\n"
"set param(EVENT,$i,$CKeySet) $tmp($i)\n"
"}\n"
"for { set i 0 } { $i < $param(EVENT,NUMKEYS,$CKeySet) } { incr i } {\n"
"set param(EVENT,$CKeySet,$i) $tmp(E,$i)\n"
"}\n"
"Redraw 2 $lb1 $lb2\n"
"}\n"
"proc firstch { s } { return [string range $s 0 0] }\n"
"proc Toggle { s } {\n"
"global ON OFF\n"
"if { [firstch $s] == $ON } {\n"
"return \"$OFF[string range $s 1 end]\"\n"
"} else {\n"
"return \"$ON[string range $s 1 end]\"\n"
"}\n"
"}\n"
"proc keyOKButtonPressed { parent } {\n"
"global param\n"
"global didPause\n"
"RemapKeys\n"
"HighlightsChanged\n"
"destroy $parent\n"
".graph yaxis configure -max [YAxisMax]\n"
".graph y2axis configure -max [YAxisMax]\n"
"set param(ViewChanged) 1\n"
"Refresh\n"
"update idletasks\n"
"if { $didPause }  {\n"
"set param(Paused) 0\n"
"Play\n"
"}\n"
"}\n"
"proc keyCancelButtonPressed { parent } {\n"
"global didPause\n"
"destroy $parent\n"
"if { $didPause }  {\n"
"set param(Paused) 0\n"
"Play\n"
"}\n"
"}\n"
"proc ShowKeyDlg { } {\n"
"global param didPause\n"
"if { $param(Paused) == 0 } { \n"
"set param(Paused) 1\n"
"Pause\n"
"set didPause 1 \n"
"} else {\n"
"set didPause 0\n"
"}\n"
"GetKeys\n"
"set dlg [KeySelect .k]\n"
"wm title $dlg \"Select Events to Display\"\n"
"wm geometry $dlg +100+200\n"
"set param(ViewChanged) 0\n"
"}\n"
"global CKeySet\n"
"global CKey\n"
"global didPause\n"
"global ON OFF\n"
"set ON \"+\"\n"
"set OFF \"-\"\n"
;
static char Et_zFile42[] = 
"proc min { x y } { if { $x < $y } { return $x }; return $y }\n"
"proc max { x y } { if { $x > $y } { return $x }; return $y }\n"
"proc calcstep { min max } {\n"
"return [expr int(($min-$max)/5)]\n"
"}\n"
"proc MakeHighlight { symbol i } {\n"
"global widget\n"
"$widget(graph,0) element create $i \\\n"
"-label \"\" \\\n"
"-symbol $symbol\n"
"return\n"
"}\n"
"proc ColorHighlight { i match } {\n"
"global widget\n"
"$widget(graph,0) element configure $i \\\n"
"-color [$widget(graph,0) element cget $match -color]\n"
"return\n"
"}\n"
"proc ColorHighlights { eltlist } {\n"
"global widget\n"
"set i 0\n"
"foreach e $eltlist {\n"
"set c [$widget(graph,0) element cget $e -color]\n"
"$widget(graph,0) element configure hi$i -color $c\n"
"incr i\n"
"}\n"
"return\n"
"}\n"
"proc ToggleAutoResize { } {\n"
"global param \n"
"if { $param(autoresize) } {\n"
"set param(autoresize) 0\n"
"} else {\n"
"set param(autoresize) 1\n"
"}\n"
"GraphToggleAutoResize\n"
"}\n"
"proc IndexerMoved { time } {\n"
"global widget param maxMaxWindow SLStart SLEnd SLZoom\n"
"if { $time > $param(LastFileTime) } {\n"
"set param(LastFileTime) $time\n"
"set SLEnd $time\n"
"if { $time > $maxMaxWindow } {\n"
"set maxMaxWindow $time\n"
".mwindow configure -to $maxMaxWindow\n"
"}\n"
"SLUpdateScale $widget(Summ) $SLStart $SLEnd\n"
"}\n"
"SLMoveMarker $widget(SL) $widget(SL,idx) $time\n"
"}\n"
"proc TellZoom { depth } {\n"
"zscroll::title \"Depth=$depth\"\n"
"}\n"
"proc Zoom { } {\n"
"global param widget zmstack zmstack2\n"
"set newzoom 1\n"
"set g $widget(graph,0)\n"
"set zb $param(zoombox)\n"
"set x0 [lrange $zb 0 0]\n"
"set y0 [lrange $zb 1 1]\n"
"set x1 [lrange $zb 2 2]\n"
"set y1 [lrange $zb 3 3]\n"
"set xd [expr abs($x0 - $x1)]\n"
"set yd [expr abs($y0 - $y1)]\n"
"if { $xd < $param(ZoomEps) } {\n"
"if { [llength $zmstack2] == 0  } {\n"
"return \n"
"}\n"
"set newzoom 0\n"
"set ix 0\n"
"foreach i { x0 x1 y0 y1 } {\n"
"set $i [lrange $zmstack2 $ix $ix]\n"
"incr ix\n"
"}\n"
"set zmstack2 [lrange $zmstack2 4 end]\n"
"} else {\n"
"set newzoom 1\n"
"set zmstack2 {}\n"
"if { [llength $zmstack] == 0 } {\n"
"set param(zoom,orig) [list \\\n"
"[$g axis cget x -min] \\\n"
"[$g axis cget x -max] \\\n"
"[$g axis cget y -min] \\\n"
"[$g axis cget y -max]]\n"
"}\n"
"}\n"
"if { $x0 > $x1 } { set t $x0; set x0 $x1; set x1 $t }\n"
"if { $y0 > $y1 } { set t $y0; set y0 $y1; set y1 $t }\n"
"foreach i {y1 y0 x1 x0} {\n"
"set zmstack [linsert $zmstack 0 [set $i]]\n"
"}\n"
"$g axis configure x -min $x0 -max $x1 -stepsize [calcstep $x0 $x1]\n"
"$g axis configure y -min $y0 -max $y1  -stepsize 1 -subdivisions 0\n"
"$g axis configure y2 -min $y0 -max $y1 -stepsize 1 -subdivisions 0\n"
"TellZoom [expr [llength $zmstack] / 4]\n"
"set r [scale_for_zscroll $x0 $y0 $x1 $y1]\n"
"zscroll::resize [lindex $r 0] [lindex $r 1] [lindex $r 2] [lindex $r 3]\n"
"if { $newzoom } { DelZoombox }\n"
"}\n"
"proc scale_for_zscroll { x0 y0 x1 y1 } {\n"
"global param\n"
"set o $param(zoom,orig)\n"
"set xmin   [lindex $o 0]\n"
"set xrange [expr [lindex $o 1] - $xmin]\n"
"set ymin   [lindex $o 2]\n"
"set yrange [expr [lindex $o 3] - $ymin]\n"
"return [list \\\n"
"[expr ($x0 - $xmin + 0.0) / $xrange * 1.0] \\\n"
"[expr ($y0 - $ymin + 0.0) / $yrange * 1.0] \\\n"
"[expr ($x1 - $xmin + 0.0) / $xrange * 1.0] \\\n"
"[expr ($y1 - $ymin + 0.0) / $yrange * 1.0] ]\n"
"}\n"
"proc MoveZoom { x0 y0 x1 y1 } {\n"
"global widget param zmstack\n"
"set g $widget(graph,0)\n"
"set o $param(zoom,orig)\n"
"set xmin   [lindex $o 0]\n"
"set xrange [expr [lindex $o 1] - $xmin + 0.0]\n"
"set ymin   [lindex $o 2]\n"
"set yrange [expr [lindex $o 3] - $ymin + 0.0]\n"
"set new_xmin [expr $x0 * $xrange + $xmin - ($xrange / 100.0) ]\n"
"set new_xmax [expr $x1 * $xrange + $xmin + ($xrange / 100.0) ]\n"
"set new_ymin [expr $y0 * $yrange + $ymin - ($yrange / 100.0) ]\n"
"set new_ymax [expr $y1 * $yrange + $ymin + ($yrange / 100.0) ]\n"
"$g xaxis configure -min $new_xmin -max $new_xmax\n"
"$g yaxis configure -min $new_ymin -max $new_ymax\n"
"$g y2axis configure -min $new_ymin -max $new_ymax\n"
"}\n"
"proc ZoomWin { } {\n"
"global param widget zmstack zmstack2\n"
"set g $widget(graph,0)\n"
"set zb $param(zoombox)\n"
"set x0 [lrange $zb 0 0]\n"
"set y0 [lrange $zb 1 1]\n"
"set x1 [lrange $zb 2 2]\n"
"set y1 [lrange $zb 3 3]\n"
"set xd [expr abs($x0 - $x1)]\n"
"set yd [expr abs($y0 - $y1)]\n"
"if { $xd < $param(ZoomEps) } {\n"
"return\n"
"}\n"
"if { $x0 > $x1 } { set t $x0; set x0 $x1; set x1 $t }\n"
"if { $y0 > $y1 } { set t $y0; set y0 $y1; set y1 $t }\n"
"set param(RewScaleValue) [max 0 [expr $x0 / $param(_scale)]]\n"
"set param(TimeWindow) [expr $xd / $param(_scale)]\n"
"$g axis configure x -min $x0 -max $x1 -stepsize [calcstep $x0 $x1]\n"
"Rewind slide 1\n"
"DelZoombox\n"
"set zmstack {}\n"
"set zmstack2 {}\n"
"TellZoom 0\n"
"}\n"
"proc DelZoombox { } {\n"
"global widget param\n"
"$widget(graph,0) element delete zbox\n"
"set param(zoombox) [list -1 -1 -1 -1]\n"
"}\n"
"proc Unzoom { } {\n"
"global widget param zmstack zmstack2\n"
"if { $zmstack == {} } { return }\n"
"set g $widget(graph,0)\n"
"set ix 0\n"
"foreach i { x0 x1 y0 y1 } {\n"
"set $i [lrange $zmstack $ix $ix]\n"
"incr ix\n"
"}\n"
"if { [expr $x0 + $x1 + $y0 + $y1] > 0 } {\n"
"foreach i {y1 y0 x1 x0} {\n"
"set zmstack2 [linsert $zmstack2 0 [set $i]]\n"
"}\n"
"} else {\n"
"set zmstack2 {}\n"
"}\n"
"if { [llength $zmstack] == 4 } {\n"
"set x0 [lindex $param(zoom,orig) 0]\n"
"set x1 [lindex $param(zoom,orig) 1]\n"
"set y0 [lindex $param(zoom,orig) 2]\n"
"set y1 [lindex $param(zoom,orig) 3]\n"
"set zmstack {}\n"
"} else {\n"
"set zmstack [lrange $zmstack 4 end]\n"
"set ix 0\n"
"foreach i { x0 x1 y0 y1 } {\n"
"set $i [lrange $zmstack $ix $ix]\n"
"incr ix\n"
"}\n"
"}\n"
"TellZoom [expr [llength $zmstack] / 4]\n"
"set r [scale_for_zscroll $x0 $y0 $x1 $y1]\n"
"zscroll::resize [lindex $r 0] [lindex $r 1] [lindex $r 2] [lindex $r 3]\n"
"$g axis configure x -min $x0 -max $x1 -stepsize [calcstep $x0 $x1]\n"
"$g axis configure y -min $y0 -max $y1\n"
"$g axis configure y2 -min $y0 -max $y1\n"
"if { [lrange $param(zoombox) 0 0] != -1 } {DelZoombox}\n"
"}\n"
"proc UnzoomAll { } { \n"
"global zmstack zmstack2\n"
"if { [llength $zmstack] == 0 } { return }\n"
"set zmstack {0 0 0 0} ;# forces pop & return to original\n"
"Unzoom\n"
"}\n"
"proc YLabel {pathname tick} {\n"
"set lbl [TickLabel $tick]\n"
"return $lbl\n"
"}\n"
"proc YScale {pathname tick} {\n"
"set lbl [TickScale $tick]\n"
"return $lbl\n"
"}\n"
"proc PauseButtonPressed { } {\n"
"global param\n"
"if { $param(Playing) == 0 } { Play } else { Pause }\n"
"return\n"
"}\n"
"proc ServerButtonChanged { widgetName } {\n"
"global param serverChangedList\n"
"set index [lsearch -exact $serverChangedList $widgetName]\n"
"if {  $index == -1 } {\n"
"lappend serverChangedList $widgetName\n"
"} else {\n"
"set serverChangedList [lreplace $serverChangedList $index $index]\n"
"}\n"
"if { $param(autolegendrefresh) } {\n"
"HighlightsChanged\n"
"Refresh\n"
"}\n"
"return\n"
"}\n"
"proc IsServerChanged { } {\n"
"global param serverChangedList\n"
"if { [llength $serverChangedList] != 0 } {\n"
"HighlightsChanged\n"
"set ischanged 1\n"
"} else {\n"
"set ischanged 0\n"
"}\n"
"set serverChangedList {}\n"
"return $ischanged\n"
"}\n"
"proc IncreaseTimeWindow { v } {\n"
"global param maxTimeWindow\n"
"set p $param(TimeWindow)\n"
"if { $p >= $maxTimeWindow } { return }\n"
"if { $p < $v } {\n"
"set p [expr $p + $v]\n"
"} else {\n"
"set p [expr $p + $p]\n"
"}\n"
"if { $p > $maxTimeWindow } {\n"
"set p $maxTimeWindow\n"
"}\n"
"set param(TimeWindow) $p\n"
".twindow configure -to $p\n"
"TimeWindowChanged nil\n"
"update idletasks\n"
"}\n"
"proc TimeWindowChanged { ignore } {\n"
"global param\n"
"set param(ViewChanged) 1\n"
"}\n"
"proc MaxTimeWindowChanged { ignore } {\n"
"global param maxTimeWindow\n"
"if { $maxTimeWindow < $param(TimeWindow) } {\n"
"set maxTimeWindow $param(TimeWindow)\n"
".mwindow set $param(TimeWindow)\n"
"} else {\n"
".twindow configure -to $maxTimeWindow\n"
"}\n"
"}\n"
"proc RewindScaleChanged { } {\n"
"global param\n"
"set param(ViewChanged) 1\n"
"}\n"
"proc HighlightsChanged { } {\n"
"global param\n"
"set param(_HighlightsChanged) 1\n"
"}\n"
"proc Pause { } {\n"
"global param widget\n"
"if { $param(Playing) == 0 } return;\n"
"set param(Playing) 0\n"
"SLMakeDraggable $widget(SL) $widget(SL,urhere)\n"
"PlayBackControls normal\n"
"ServerButtons    normal\n"
"GraphRedraw      off\n"
"PauseFile\n"
"StatusLine       \"Paused\"\n"
"return\n"
"}\n"
"proc Play { } {\n"
"global param widget\n"
"if { $param(Playing) } {\n"
"return\n"
"}\n"
"set param(Playing) 1\n"
"StatusLine \"Playing..\"\n"
"destroy $widget(graph,0).popupann\n"
"PlayBackControls disabled\n"
"ServerButtons disabled\n"
"SLUnbind 1 $widget(SL) $widget(SL,urhere)\n"
"UnzoomAll\n"
"if { $param(ViewChanged) } {\n"
"set param(LeftX) $param(RewScaleValue)\n"
"}\n"
"Refresh\n"
"GraphRedraw on\n"
"PlayFile\n"
"return\n"
"}\n"
"proc GraphRedraw { toggle } {\n"
"global param\n"
"switch $toggle {\n"
"off {\n"
"after cancel $param(LastRedraw)\n"
"set param(ateof) 0\n"
"}\n"
"on {\n"
"set param(NextLeftX) [expr $param(LeftX) + $param(RedrawTime) * $param(replayspeed) * $param(_scale)]\n"
"GraphUpdate\n"
"}\n"
"default {\n"
"ErrorBox \"Invalid parameter for GraphRedraw: $toggle\"\n"
"}\n"
"}\n"
"return\n"
"}\n"
"proc PlayBackControls { controlState } {\n"
"global widget\n"
"foreach i $widget(pcontrolNames) {\n"
"$i configure -state $controlState\n"
"}\n"
"}\n"
"proc ServerButtons { buttonState } {\n"
"global widget\n"
"foreach i $widget(serverButtons) {\n"
"$i configure -state $buttonState\n"
"}\n"
"update idletasks\n"
"}\n"
"proc ForgetAnnotated { {w NULL} } {\n"
"global param\n"
"if { [info exists param(AnnElt)] } {\n"
"if { $w != \"NULL\" } {\n"
"$w element configure $param(AnnElt) -color $param(AnnEltColor)\n"
"}\n"
"unset param(AnnElt) param(AnnEltColor)\n"
"}\n"
"return\n"
"}\n"
"proc Refresh { {force 0} } {\n"
"global param widget\n"
"set schange [IsServerChanged]\n"
"if { $force || $param(ViewChanged) || $schange } {\n"
"StatusLine \"Updating display..\"\n"
"update idletasks\n"
"if { $schange } {\n"
"SetVisibleClients $param(CLIST,orgname)\n"
"}\n"
"ClearCachedLines\n"
"Rewind slide 1\n"
"if { $param(_HighlightsChanged) } {\n"
"BkmkRefresh\n"
"set param(_HighlightsChanged) 0\n"
"}\n"
"if { $param(Playing) == 0 } {\n"
"StatusLine \"Paused\"\n"
"} else {\n"
"StatusLine \"Playing..\"\n"
"}\n"
"set param(ViewChanged) 0\n"
"}\n"
"return\n"
"}\n"
"proc Rewind { fn { forceRedraw 0 } } {\n"
"global param widget \n"
"set lf  $param(LastFileTime)\n"
"set tw  $param(TimeWindow)\n"
"set x   [expr $param(LeftX) / $param(_scale) ]\n"
"set jmp [expr $tw / 2 ]\n"
"switch $fn {\n"
"begin {\n"
"set x 0\n"
"}\n"
"left {\n"
"set x [max 0 [expr $x - $jmp]] \n"
"}\n"
"right {\n"
"if {[expr $x + $jmp] < $lf } {\n"
"set x [expr $x + $jmp]\n"
"}\n"
"}\n"
"slide {\n"
"set x [min $param(RewScaleValue) $lf]\n"
"} \n"
"end {\n"
"set x [max [expr $lf - $tw] 0]\n"
"}\n"
"}\n"
"if { $x != $param(LeftX) || $forceRedraw } {\n"
"StatusLine \"Updating display..\"\n"
"destroy $widget(graph,0).popupann\n"
"update idletasks\n"
"if { [IsServerChanged] } {\n"
"SetVisibleClients $param(CLIST,orgname)\n"
"ClearCachedLines\n"
"}\n"
"GraphUpdate $x\n"
"StatusLine \"Paused\"\n"
"ServerButtons normal\n"
"update idletasks\n"
"}\n"
"}\n"
"proc JumpAndPlay { } {\n"
"global param\n"
"set param(eofpolicy) 0 ; # Turn off stop-on-eof\n"
"set param(_skipreq) [list -1 $param(LastFileTime)]\n"
"if { $param(Playing) } {\n"
"Pause\n"
"}\n"
"Play\n"
"}\n"
"proc GraphUpdate { { x -1 } } {\n"
"global param widget\n"
"set scl $param(_scale)\n"
"set tw [expr $param(TimeWindow)*$scl]\n"
"set lf $param(LastFileTime)\n"
"set param(LastReadTime) [LastReadTime]\n"
"set lr $param(LastReadTime)\n"
"if { $lr > $lf } {\n"
"set param(LastFileTime) $lr\n"
"set lf $lr\n"
"}\n"
"if { $x < 0 } {\n"
"if { $x == -2 } {\n"
"StatusLine \"Playing..\"\n"
"set param(ateof) 0\n"
"}\n"
"if { [expr ($param(NextLeftX) + $tw)/$scl] > $lf \n"
"&& $param(eofpolicy) } {\n"
"if { !$param(ateof) } {\n"
"StatusLine \"End-of-file..\"\n"
"set param(ateof) 1\n"
"GraphFlush\n"
"} else {\n"
"return\n"
"}\n"
"}\n"
"if { $param(_skipreq) != \"\" &&\n"
"[lindex $param(_skipreq) 0] < $param(NextLeftX) } {\n"
"set param(LeftX) [expr [lindex $param(_skipreq) 1] - $param(RedrawTime)*$param(replayspeed)*$scl ]\n"
"set param(_skipreq) \"\"\n"
"} else {\n"
"set param(LeftX) $param(NextLeftX)\n"
"}\n"
"set param(NextLeftX) [expr $param(LeftX) + $param(RedrawTime)*$param(replayspeed)*$scl]\n"
"WindowChanged $param(LeftX) [expr $param(LeftX) + $tw] D\n"
"if { ! $param(ateof) } {\n"
"set param(LastRedraw) [after $param(_redrawsec) GraphUpdate]\n"
"}\n"
"} else {\n"
"if { $x <= $lf } {\n"
"set param(LeftX) [expr $x * $scl]\n"
"WindowChanged $param(LeftX) [expr $param(LeftX) + $tw] S\n"
"}\n"
"}\n"
"$widget(graph,0) xaxis configure -min $param(LeftX) \\\n"
"-max [expr $param(LeftX) + $tw] \\\n"
"-stepsize [calcstep 0 $tw]\n"
"$widget(graph,0) yaxis configure -min 0\n"
"$widget(graph,0) y2axis configure -min 0\n"
"RewScaleUpdate\n"
"update idletasks\n"
"return\n"
"}\n"
"proc RewScaleUpdate { } {\n"
"global param widget \n"
"global SLStart SLEnd SLZoom\n"
"if { $param(Playing) } {\n"
"set SLEnd $param(LastFileTime)\n"
"}\n"
"set param(RewScaleValue) [expr $param(LeftX)/$param(_scale)]\n"
"SLUpdateScale $widget(SL)  $SLStart $SLEnd\n"
"SLUpdateUrhere\n"
"return\n"
"}\n"
"proc CreateLegend { fName } {\n"
"global param widget\n"
"set sz $param(ctlsize)\n"
"set fn $param(${sz}font)\n"
"frame $fName -background white\n"
"frame $fName.0 -height 30 -background white\n"
"label $fName.0.keytxt -text \"$param(serverlabel):\" -background \"\\#fff\"\n"
"pack $fName.0.keytxt -side left\n"
"pack $fName.0 -side top -anchor w -fill both -expand 1\n"
"pack $fName -side bottom -anchor w -fill both -expand 0\n"
"set widget(serverButtons) {}\n"
"set widget(GraphLegend) $fName\n"
"set param(legendwid)  8\n"
"set param(legendline) 0\n"
"return\n"
"}\n"
"proc AddToLegend { Base serverName colorIndex } {\n"
"global param widget\n"
"set color [lindex $param(color-ip) [expr $colorIndex % [llength $param(color-ip)]]] \n"
"set orgName $serverName\n"
"regsub -all {\\.|\\#} $serverName \\_ serverName\n"
"if { [regexp {^[0-9].*} $serverName] } {\n"
"set serverName \"_$serverName\"\n"
"}\n"
"set sname [string tolower $serverName]\n"
"set sz $param(ctlsize)\n"
"set param(legendwid) [expr $param(legendwid) + [string length $sname]]\n"
"if { $param(legendwid) > $param(legendmaxw) } {\n"
"incr param(legendline)\n"
"set f [frame $Base.$param(legendline) -height 30 -background white]\n"
"pack $f -side top -anchor w -fill x\n"
"set param(legendwid) 0\n"
"}\n"
"checkbutton $Base.$param(legendline).$sname -text $sname -bg $color -relief flat\\\n"
"-activebackground $color \\\n"
"-font $param(${sz}font)\\\n"
"-variable param(server,$orgName) \\\n"
"-highlightthickness 0\\\n"
"-command [list ServerButtonChanged $orgName]\\\n"
"-fg \"#fff\" \\\n"
"-disabledforeground \"#ccc\" \\\n"
"-activeforeground \"\\#fff\" \\\n"
"-selectcolor \"\\#fff\" \\\n"
"-state disabled\n"
"pack $Base.$param(legendline).$sname -side left -anchor w -fill both -expand 1\n"
"set param(server,$orgName) 1\n"
"lappend widget(serverButtons) $Base.$param(legendline).$sname\n"
"lappend param(CLIST,name) $sname\n"
"lappend param(CLIST,orgname) $orgName\n"
"set param(CLIST,color,$sname) $color\n"
"return\n"
"}\n"
"proc ExitProgram {} {\n"
"Exit\n"
"}\n"
"proc SetControlSize { } {\n"
"global param widget\n"
"set w $widget(Controls)\n"
"set sz $param(ctlsize)\n"
"set fn $param(${sz}font)\n"
"set wid $param(${sz}width)\n"
"set b1 $param(${sz}bdim1)\n"
"set b2w [expr 3*$param(${sz}mag)/4]\n"
"set b2h [expr $param(${sz}mag)]\n"
".progstatus configure -font $fn\n"
".speedscale configure -font $fn -width $wid\n"
".twindow configure -font $fn -width $wid\n"
".mwindow configure -font $fn -width $wid\n"
".zzoom   configure -height $b2h -width $b2w\n"
".zunzoom configure -height $b2h -width $b2w\n"
".zzwin   configure -height $b2h -width $b2w\n"
"zscroll::title_font $fn\n"
"zscroll::frame_size $param(${sz}scrollheight) $param(${sz}scrollwidth)\n"
"foreach i $widget(pcontrolNames) {\n"
"$i configure -width $b1 -height $b1\n"
"}\n"
".rwtoggle configure -width $b1 -height $b1\n"
"foreach i $widget(serverButtons) {\n"
"$i configure -font $fn\n"
"}\n"
"update \n"
"return\n"
"}\n"
"proc SetGraphSize { } {\n"
"global param widget\n"
"switch $param(graphsize) {\n"
"big { set w 10i; set h 7i }\n"
"small { set w 8i; set h 5i }\n"
"tiny { set w 5i; set h 3i }\n"
"}\n"
"$widget(graph,0) configure -width $w -height $h\n"
"}\n"
"proc CreateControls { w } {\n"
"global widget param\n"
"global lastRefreshTime maxTimeWindow  maxMaxWindow\n"
"set bopts [list -bg $param(color-buttonbg) -fg $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-highlightbackground $param(color-ctlbg) -font $param(bigfont) ]\n"
"set sopts [list -bg $param(color-ctlbg) \\\n"
"-highlightbackground $param(color-ctlbg) -orient horiz \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-troughcolor #fcd4b0 -highlightthickness 0 \\\n"
"-width $param(bigwidth) -font $param(bigfont)]\n"
"set eopts [list -bg $param(color-ctlbg) -relief flat \\\n"
"-borderwidth 0 -highlightthickness 0]\n"
"set fbg $param(color-ctlbg)\n"
"frame $w -bg $fbg\n"
"frame $w.l -bg $fbg\n"
"frame $w.r -bg $fbg\n"
"frame $w.l.t -bg $fbg\n"
"frame $w.l.b -bg $fbg\n"
"frame $w.r.t -bg $fbg\n"
"frame $w.r.b -bg $fbg\n"
"frame $w.r.t.l -bg $fbg\n"
"frame $w.r.t.r -bg $fbg\n"
"frame $w.r.b.l -bg $fbg\n"
"frame $w.r.b.r -bg $fbg\n"
"frame $w.l.t.r -bg $fbg\n"
"frame $w.l.t.l -bg $fbg\n"
"frame $w.l.t.r.t -bg $fbg\n"
"frame $w.l.t.r.b -bg $fbg\n"
"eval { scale .twindow \\\n"
"-from 0.1 -to $maxTimeWindow \\\n"
"-variable param(TimeWindow) \\\n"
"-command TimeWindowChanged \\\n"
"-tickinterval 0 -resolution 0.1 -showvalue true \\\n"
"-label \"Window (s)\"} $sopts\n"
"eval { scale .mwindow \\\n"
"-from $maxTimeWindow -to $maxMaxWindow \\\n"
"-variable maxTimeWindow \\\n"
"-command MaxTimeWindowChanged \\\n"
"-tickinterval 0 -resolution 0.1 -showvalue true \\\n"
"-label \"Max (s)\"} $sopts \n"
"bind .twindow <B1-ButtonRelease> {Rewind slide 1}\n"
"set wid 25\n"
"eval {button .rwbegin -borderwidth 2 \\\n"
"-padx 4 -pady 3 -bitmap begin -width 3 \\\n"
"-width $wid -command [list Rewind begin]} $bopts\n"
"eval {button .rwend -borderwidth 2 \\\n"
"-padx 4 -pady 3 -bitmap end -width 3 \\\n"
"-width $wid -command [list Rewind end]} $bopts\n"
"eval {button .rwleft -borderwidth 2 \\\n"
"-padx 4 -pady 3 -bitmap rew  \\\n"
"-width $wid \\\n"
"-command [list Rewind left]} $bopts\n"
"eval {button .rwright -borderwidth 2 \\\n"
"-padx 4 -pady 3 -bitmap ff \\\n"
"-width $wid \\\n"
"-command [list Rewind right]} $bopts\n"
"eval {button .rwtoggle \\\n"
"-bitmap pause_toggle -command PauseButtonPressed \\\n"
"-borderwidth 2 -width $wid } $bopts \n"
"eval {button .rwrefresh \\\n"
"-bitmap refresh -command [list Refresh 1]\\\n"
"-borderwidth 2 -width $wid } $bopts\n"
"eval {button .rwrealtime \\\n"
"-command JumpAndPlay \\\n"
"-bitmap realtime \\\n"
"-borderwidth 2 -width $wid } $bopts\n"
"set param(RewScaleValue) 0\n"
"set widget(scaleControl) 0\n"
"eval {button .zzoom -width 40 -height 40 -bitmap mag \\\n"
"-borderwidth 2 -command {Zoom}} $bopts\n"
"eval {button .zunzoom -width 40 -height 40 -bitmap nomag \\\n"
"-borderwidth 2 -command {Unzoom}} $bopts\n"
"eval {button .zzwin -width 40 -height 40 -bitmap magwin \\\n"
"-borderwidth 2 -command {ZoomWin}} $bopts\n"
"eval {scale .speedscale \\\n"
"-variable param(replayspeed) -from 0.05 -to 8 \\\n"
"-resolution 0.05 -tickinterval 0 \\\n"
"-borderwidth 0 -showvalue true -orient horiz \\\n"
"-label \"Speed\"} $sopts\n"
"eval {entry .progstatus -justify left -width 30 -state disabled \\\n"
"-textvariable param(ProgStatus)} $eopts\n"
"set zbox [zscroll::create $w.r.b.l MoveZoom]\n"
"set canvas [SLInit $w.l.b 0 0 300 30 2]\n"
"set widget(Summ) [SummInit $canvas]\n"
"set widget(SL,urhere) [SLAddMarker urhere $canvas tdown \\#0000ff [SLTimeToPos 0] up yes]\n"
"set widget(SL,idx) [SLAddMarker idx $canvas idx \\#00ff00 [SLTimeToPos 0] up no]\n"
"SLMakeDraggable $canvas $widget(SL,urhere)\n"
"$canvas bind $widget(SL,urhere) <B1-ButtonRelease> {\n"
"if { !$param(Playing) } {\n"
"set widget(drag) 0 \n"
"Rewind slide 1\n"
"}\n"
"}\n"
"$canvas bind all <Button-2> {\n"
"global param \n"
"if { $param(Playing) } { return }\n"
"SLMoveUrhere $widget(SL) %W [max 0 [SLPosToTime %x]]\n"
"Rewind slide 1\n"
"}    \n"
"pack .zzoom .zunzoom .zzwin -side left -anchor w -in $w.r.t\n"
"pack $zbox -side left -anchor w\n"
"pack .twindow .mwindow -side left -in $w.l.t.l \\\n"
"-anchor center -expand 1 -fill x\n"
"pack .rwleft .rwtoggle .rwright .rwrefresh \\\n"
"-in $w.l.t.r.t -side left -expand 1\n"
"pack .rwbegin .rwend .rwrealtime -in $w.l.t.r.b -side left -anchor e \n"
"pack .speedscale -side left -anchor ne -in $w.r.t -fill x\n"
"pack .progstatus -side left -anchor w -in $w.l.b -fill x\n"
"pack $w.l -side left -anchor w\n"
"pack $w.r -side left -anchor nw -fill both -expand 1\n"
"pack $w.r.t -side top -anchor nw -fill both -expand 1\n"
"pack $w.r.b -side bottom -anchor sw -fill both -expand 1\n"
"pack $w.r.b.l $w.r.b.r -side left -fill both -expand 1\n"
"pack $w.l.t -side top -anchor nw\n"
"pack $w.l.b -side bottom -anchor w -fill x -expand 1\n"
"pack $w.r.t.l -side left\n"
"pack $w.l.t.l -side left\n"
"pack $w.l.t.r -side right\n"
"pack $w.l.t.r.t $w.l.t.r.b -side top -fill x -expand 1\n"
"pack $w -side bottom -anchor s -expand 1 -fill both\n"
"set widget(Controls) $w\n"
"set widget(pcontrolNames) \\\n"
"[list .rwend .rwright .rwleft .rwbegin .rwrefresh .rwrealtime \\\n"
".zzoom .zunzoom .zzwin]\n"
"SetControlSize\n"
"TellZoom 0\n"
"}\n"
"proc GraphTitleDlg { {cmd create} } {\n"
"global param widget\n"
"switch $cmd {\n"
"create {\n"
"if { ![info exists widget(gtdlg)] } {\n"
"set param(gtdlg,newtitle) $widget(graph,title)\n"
"set t [toplevel .graphtitle]\n"
"set f [frame $t.main -bg $param(color-winbg)]\n"
"label $f.label \\\n"
"-text \"Graph Title\" \\\n"
"-bg $param(color-winbg) \\\n"
"-fg \"black\"\n"
"entry $f.entry \\\n"
"-textvariable param(gtdlg,newtitle) \\\n"
"-bg \"white\" \\\n"
"-fg \"black\"\n"
"set f [frame $t.confirm -bg $param(color-winbg)]\n"
"button $f.ok \\\n"
"-text \"OK\" \\\n"
"-command [list GraphTitleDlg ok] \\\n"
"-bg $param(color-buttonbg) \\\n"
"-fg $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg)\n"
"button $f.cancel \\\n"
"-text \"Cancel\" \\\n"
"-command  [list GraphTitleDlg cancel] \\\n"
"-bg $param(color-buttonbg) \\\n"
"-fg $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg)\n"
"pack $t.confirm.ok $t.confirm.cancel \\\n"
"-side right \\\n"
"-anchor center \\\n"
"-padx 20\n"
"pack $t.main.label $t.main.entry \\\n"
"-side top \\\n"
"-anchor w \\\n"
"-fill x\n"
"pack $t.main $t.confirm \\\n"
"-side top \\\n"
"-fill both \\\n"
"-expand 1\n"
"set widget(gtdlg) .graphtitle\n"
"} else {\n"
"wm deiconify $widget(gtdlg)\n"
"}\n"
"}\n"
"ok { \n"
"SetGraphTitle $param(gtdlg,newtitle)\n"
"wm withdraw $widget(gtdlg)\n"
"}\n"
"cancel {\n"
"wm withdraw $widget(gtdlg)\n"
"}\n"
"}\n"
"}\n"
"proc SetGraphTitle { {title @FromDialogBox@} } {\n"
"global widget\n"
"if { $title == \"@FromDialogBox@\" } {\n"
"set title $widget(graph,title)\n"
"}\n"
"if {[ info exists widget(graph,0) ]} {\n"
"$widget(graph,0) configure -title \"$title\"\n"
"}\n"
"set widget(graph,title) $title\n"
"return\n"
"}\n"
"proc InitGraph { w Title } {\n"
"global param widget\n"
"set maxy [YAxisMax]\n"
"set widget(graph,0) $w\n"
"$w configure -title $widget(graph,title)\n"
"$w configure -font $param(graphtitlefont)\n"
"$w configure -plotbackground $param(color-graphbg)\n"
"$w configure -background $param(color-winbg)\n"
"$w configure -rightmargin 100\n"
"$w configure -bottommargin 0\n"
"if { $param(timeunit) == \"seconds\" } {\n"
"$w xaxis configure -title \"time(s)\"\n"
"} else {\n"
"$w xaxis configure -title \"time(ms)\"\n"
"}\n"
"$w xaxis configure \\\n"
"-stepsize $param(_scale) \\\n"
"-max [ expr $param(TimeWindow)*$param(_scale)] \\\n"
"-subdivisions 5 \\\n"
"-min 0\n"
"$w yaxis configure \\\n"
"-title \"Events\" \\\n"
"-min 0 \\\n"
"-max $maxy \\\n"
"-stepsize 1 \\\n"
"-subdivisions 0 \\\n"
"-command YLabel\n"
"$w y2axis configure \\\n"
"-hide no \\\n"
"-title \"Scale\" \\\n"
"-min 0 \\\n"
"-max $maxy \\\n"
"-stepsize 1 \\\n"
"-subdivisions 0 \\\n"
"-command YScale\n"
"SetGraphSize\n"
"$w grid configure \\\n"
"-hide no \\\n"
"-minor 1 \\\n"
"-dashes 0 \\\n"
"-color $param(color-graphgrid)\n"
"pack $w -side top -fill both -expand 1\n"
"$w legend configure -hide yes\n"
"$w element create bkmk -xdata {0 0} -ydata {0 0} -dashes 3 -symbol none\n"
"bind  $w <ButtonPress-1> {\n"
"global param\n"
"set p [%W invtransform %x %y]\n"
"if { [lrange $param(zoombox) 0 0] != -1 } {\n"
"%W element delete zbox\n"
"}\n"
"%W element create zbox -dashes 2 -data {0 0} -symbol none\n"
"set param(zoombox) [list 0 0 0 0]\n"
"set param(zbox,x0) [lrange $p 0 0]\n"
"set param(zbox,y0) [lrange $p 1 1]\n"
"}\n"
"bind $w <B1-Motion> {\n"
"global param\n"
"set p [%W invtransform %x %y]\n"
"set x0 $param(zbox,x0)\n"
"set y0 $param(zbox,y0)\n"
"set x1 [lrange $p 0 0]\n"
"set y1 [lrange $p 1 1]\n"
"%W element configure zbox \\\n"
"-data [list $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1 $x0 $y0]\n"
"update idletasks\n"
"}\n"
"bind $w <ButtonRelease-1> {\n"
"global param\n"
"set p [%W invtransform %x %y]\n"
"set x1 [lrange $p 0 0]\n"
"set y1 [lrange $p 1 1]\n"
"set param(zoombox) [list $param(zbox,x0) $param(zbox,y0) $x1 $y1]\n"
"}\n"
"bind $w <ButtonPress-3> {\n"
"global param widget\n"
"if { $param(Playing) } { return }\n"
"destroy %W.popupann\n"
"ForgetAnnotated %W\n"
"set isElt [%W element closest %x %y c -halo 5 \\\n"
"-interpolate no]\n"
"if { ! $isElt } {\n"
"set isElt [%W element closest %x %y c -halo 5 \\\n"
"-interpolate yes]\n"
"}\n"
"if { $isElt } {\n"
"if { [catch {\n"
"set alist [GetAnnotation $c(name) [expr int($c(y))]]\n"
"} ] == 0 } { \n"
"set color [lindex $alist 0]\n"
"set alist [lrange $alist 1 end]\n"
"set astr \"\"\n"
"set linectr 0\n"
"for { set i 0 } { $i < [llength $alist] } { incr i 2 } {\n"
"set i2 [expr $i + 1]\n"
"set s \"[lindex $alist $i]=[lindex $alist $i2]\"\n"
"if { [expr [string length $s] + $linectr] > 40 } {\n"
"set astr \"$astr\\n\"\n"
"set linectr 0\n"
"}\n"
"set astr \"$astr $s\"\n"
"incr linectr [expr [string length $s] + 1]\n"
"}\n"
"label %W.popupann -bg yellow -fg black \\\n"
"-text $astr -justify left\n"
"place %W.popupann -x %x -y %y\n"
"set param(AnnElt) $c(name)\n"
"set param(AnnEltColor) $color\n"
"%W element configure $c(name) -color $param(color-annotation)\n"
"update idletasks\n"
"}\n"
"}\n"
"}\n"
"}\n"
"proc CreateElements { path type num } {\n"
"global param\n"
"set symstr $param(SYM,[lrange $param(SYM,types) $type $type])\n"
"for { set i 0 } { $i < $num } { incr i } {\n"
"if { [expr $i % 100] == 0 } {\n"
"puts -nonewline \"Create element type $type number $i / $num \\r\"\n"
"flush stdout\n"
"}\n"
"$path line create ${type}t${i} -label \"\" -symbol $symstr\n"
"}\n"
"puts \"Done with element type $type                                         \"\n"
"update\n"
"return\n"
"}\n"
"proc CreateWindow { } {\n"
"wm title . NetLogger\n"
"wm iconbitmap . nlvicon\n"
"wm resizable . 1 1\n"
"CreateMenu     .menu\n"
"InitGraph      .graph \"Graph Title\"\n"
"CreateControls .controls\n"
"CreateLegend   .legend\n"
"update\n"
"}\n"
"proc ErrorBox { msg { title Error } { win . }} {\n"
"set w $win\n"
"if { $w == \".\" } {\n"
"set b \"\" \n"
"} else  {\n"
"set b $w\n"
"}\n"
"if { 0 == [winfo exists $w] } {\n"
"toplevel $w\n"
"}\n"
"if { 0 == [winfo ismapped $w] } {\n"
"wm deiconify $w\n"
"}\n"
"wm title $w $title\n"
"frame $b.f1 -background white\n"
"frame $b.f2 -background white\n"
"message $b.f1.err -text \"$msg\" -justify left -width 400 -background white\n"
"button $b.f2.ok -text OK -command \"destroy $w\" -background \\#00ff00 -foreground \\#ff0000\n"
"pack $b.f1.err $b.f1 -expand 1 -fill both\n"
"pack $b.f2 -expand 1 -fill both\n"
"pack $b.f2.ok\n"
"tkwait window $w\n"
"}\n"
"proc MessageBox { msg title {wait yes} } {\n"
"global param\n"
"toplevel .box -height 400\n"
"wm title .box \"$title\"\n"
"frame .box.f1 -bg $param(color-winbg)\n"
"message .box.f1.err -text \"$msg\" -width 4i \\\n"
"-background $param(color-winbg) \n"
"frame .box.f2 -bg $param(color-winbg)\n"
"button .box.f2.ok -text OK -command \"destroy .box\" \\\n"
"-bg $param(color-buttonbg)\n"
"pack .box.f1.err .box.f2.ok .box.f1 .box.f2 -expand 1 -fill both\n"
"if { $wait == \"yes\" } {\n"
"tkwait window .box\n"
"} else {\n"
"return .box\n"
"}\n"
"return\n"
"}\n"
"proc StatusLine { { msg \"Running\" } } {\n"
"global param\n"
"set param(ProgStatus) \"Status: $msg\"\n"
"update idletasks\n"
"return\n"
"}\n"
"proc LoadConfigInfo { file } {\n"
"global param\n"
"set param(printers) [list itg1 itg2 itg3]\n"
"set param(lpr) lpr\n"
"set param(lpropts) -h\n"
"set param(LeftX) 0\n"
"set param(NextLeftX) 0\n"
"set param(ViewChanged) 0\n"
"set param(RedrawTime) 0.5\n"
"set param(LastRedraw) {}\n"
"set param(Paused) 1\n"
"set param(ProgStatus) \"Status: Running\"\n"
"set param(replayspeed) 1.0\n"
"set param(color-ip)   [list \\#f00 \\#0f0 \\#99f \\#aa0 \\#0aa \\#a0a \\#b23 \\#23b ]\n"
"set param(color-winbg) #b0d9d9\n"
"set param(color-graphbg) #ffffff\n"
"set param(color-menubg) #ffffff\n"
"set param(color-menufg) #000000\n"
"set param(color-menuabg) #00f9f9\n"
"set param(color-ctlbg) #b0d9d9\n"
"set param(color-buttonbg) #c1e2e2\n"
"set param(color-buttonfg) #000000\n"
"set param(color-buttonabg) #00f9f9\n"
"set param(color-rewoff) #eeeeee\n"
"set param(color-rewon) #b0d9d9\n"
"set param(color-annotation) \\#000000\n"
"set param(color-graphgrid) \\#dddddd\n"
"set param(color-zoombg) \\#8080ee\n"
"set param(bigfont) 9x15\n"
"set param(bigwidth) 16\n"
"set param(bigbdim1) 30\n"
"set param(bigmag) 40\n"
"set param(bigscrollheight) 1.5i\n"
"set param(bigscrollwidth) 1.5i\n"
"set param(smallfont) 7x13\n"
"set param(smallwidth) 10\n"
"set param(smallbdim1) 25\n"
"set param(smallmag) 32\n"
"set param(smallscrollheight) 1.5i\n"
"set param(smallscrollwidth) 1.5i\n"
"set param(tinyfont) 6x10\n"
"set param(tinywidth) 6\n"
"set param(tinybdim1) 20 \n"
"set param(tinymag) 20\n"
"set param(tinyscrollheight) 1i\n"
"set param(tinyscrollwidth) 1i\n"
"set param(ctlsize) small\n"
"set param(graphsize) big\n"
"set param(current_time) 0\n"
"set param(summaryinterval) 1000\n"
"set param(legendmaxw) 80\n"
"set param(eofpolicy) 1\n"
"set param(skiptonextdata) 1\n"
"set param(timeunit) milliseconds\n"
"set param(serverlabel) \"Servers\"\n"
"set param(maxannotations) 50\n"
"set param(graphtitlefont) \"-*-helvetica-medium-r-*-*-18-*-*-*-*-*-*-*\"\n"
"set param(autolegendrefresh) 1\n"
"set param(bookmarksymbol) \"markmask mark\"\n"
"set param(startmode) Pause\n"
"set param(autoresize) 0\n"
"set param(maxgraphelements) 2500\n"
"set err [catch {set fd [open $file]}]\n"
"if { $err != 0  } { return 1 }\n"
"while { [gets $fd data] > -1 } {\n"
"if { $data != \"\" && [regexp \"^#\" $data] == 0 } {\n"
"scan $data \"%s %s\" f0 listWord\n"
"set f1 [string trim [string range $data [string length $f0] end]]\n"
"if { $listWord == \"list\" } {\n"
"set f1split [split [string range $f1 5 end]]\n"
"set f1 \"\"\n"
"foreach i $f1split {\n"
"if { $i != {} } {\n"
"lappend f1 $i\n"
"}\n"
"}\n"
"set len [llength $f1]\n"
"}\n"
"if { [string length $f1] > 0 && [string length $f0] > 0 } {\n"
"set param([string tolower $f0]) $f1\n"
"}\n"
"}\n"
"}\n"
"close $fd\n"
"if { $param(timeunit) == \"seconds\" } {\n"
"set param(_scale) 1.0\n"
"} else {\n"
"set param(_scale) 1000.0\n"
"}\n"
"if { $param(RedrawTime) > 5 } {\n"
"puts \"The RedrawTime parameter seems too large to be in SECONDS ( $param(RedrawTime) )\"\n"
"puts \"Perhaps you should change it and restart.\"\n"
"}\n"
"set param(_redrawsec) [expr int($param(RedrawTime)*1000)]\n"
"return 0\n"
"}\n"
"proc DumpConfigInfo { } {\n"
"global param\n"
"puts \"---CONFIG INFO---\"\n"
"foreach i [array names param] {\n"
"puts -nonewline \"$i=$param($i) \"\n"
"}\n"
"puts \"-----------------\"\n"
"return\n"
"}\n"
"proc DumpParams { } {\n"
"global param\n"
"set indent \"        \"\n"
"puts \"Colors:\"\n"
"foreach p [ array names param color-* ] {\n"
"puts \"$indent$p = $param($p)\"\n"
"}\n"
"puts \"Font/Display sizes:\"\n"
"foreach size { tiny small big } {\n"
"foreach p [ array names param $size* ] {\n"
"puts \"$indent$p = $param($p)\"\n"
"}\n"
"}\n"
"puts \"${indent}ctlsize = $param(ctlsize)\"\n"
"puts \"${indent}graphsize = $param(graphsize)\"\n"
"puts \"${indent}graphtitlefont = $param(graphtitlefont)\"\n"
"puts \"Other:\"\n"
"foreach p { replayspeed current_time summaryinterval \\\n"
"legendmaxw eofpolicy skiptonextdata timeunit \\\n"
"serverlabel maxannotations autolegendrefresh \\\n"
"bookmarksymbol startmode autoresize maxgraphelements } {\n"
"puts \"${indent}$p = $param($p)\"\n"
"}\n"
"}\n"
"proc UpdateAsynchronous { o1 o2 } {\n"
"global param widget \n"
"global Elts SLStart SLEnd\n"
"global Bkmk\n"
"set n1 [expr 0.0+[IndexTime]]\n"
"if { $n1 > $o1 } {\n"
"IndexerMoved $n1\n"
"SummRedraw $SLStart $SLEnd\n"
"if { $widget(drag) == 0 } {\n"
"RewScaleUpdate\n"
"}\n"
"}\n"
"set n2 0\n"
"if { [bkGetLock] } {\n"
"if { $Bkmk(file) != \"\" && $Bkmk(auto) } {\n"
"set n2 [file size $Bkmk(file)]\n"
"if { $n2 != $o2 } {\n"
"bkReleaseLock\n"
"bkUpdateFromFile\n"
"set n2 [file size $Bkmk(file)]\n"
"} else {\n"
"bkReleaseLock\n"
"}\n"
"} else {\n"
"bkReleaseLock\n"
"}\n"
"}\n"
"update idletasks\n"
"after 1000 UpdateAsynchronous $n1 $n2\n"
"}\n"
"proc WakeUp { t {t2 -1} } {\n"
"global param \n"
"if { $param(Playing) && $param(skiptonextdata) && $t > $param(NextLeftX) } {\n"
"if { $t2 != -1 } {\n"
"set param(_skipreq) [list $t2 $t]\n"
"} else {\n"
"set param(_skipreq) {}\n"
"if { $t > [expr $param(NextLeftX) + $param(TimeWindow)] } {\n"
"set param(NextLeftX) $t\n"
"}\n"
"GraphRedraw off\n"
"GraphUpdate -2\n"
"}\n"
"}\n"
"}\n"
"proc tcl_main {argc argv} {\n"
"global env param maxTimeWindow maxMaxWindow blt_library\n"
"global Bkmk\n"
"set fname \"\"\n"
"set home  \"\"\n"
"set khome \"\"\n"
"set cfghome \"\"\n"
"set will_dump 0\n"
"set parmset {}\n"
"set flag(s) [list b c d h k p w]\n"
"set flag(l) [list bkmkfile  cfghome dump help keyhome parameter window]\n"
"set flag(noarg) [list h help d dump]\n"
"set fmtmsg \"Format: nlv -[join $flag(s) {}] or --[join $flag(l) \",\"] logfile\"\n"
"for {set ctr 1} {$ctr < $argc} { incr ctr } {\n"
"set a [lindex $argv $ctr]\n"
"set flg \"\"\n"
"if { [string match --* $a] } {\n"
"set flg [string range $a 2 end]\n"
"set ftype l\n"
"} elseif { [string match -* $a] } {\n"
"set flg [string range $a 1 end]\n"
"set ftype s\n"
"} elseif { $fname == \"\" } {\n"
"if { ![file exists $a] } {\n"
"catch { set fid [open $a \"w\"] } worked\n"
"if { [string range $worked 0 7] != \"couldn't\" } {\n"
"close $fid\n"
"set fname $a\n"
"} else {\n"
"ErrorBox \"The file \\\"$a\\\" does not exist and could not be created.\"\n"
"exit\n"
"}\n"
"}\n"
"if { [file readable $a] } {\n"
"set fname $a\n"
"} else { \n"
"catch { set lnk [file readlink $a] } worked \n"
"if { [string range $worked 0 7] != \"couldn't\" } {\n"
"set fname $lnk\n"
"} else {\n"
"ErrorBox \"The file \\\"$a\\\" is not readable.\"\n"
"exit\n"
"}\n"
"}\n"
"} else {\n"
"ErrorBox \"File name specified twice.\\n$fmtmsg\" \"Command Line Error\"\n"
"exit\n"
"}\n"
"if { $flg != \"\" } {\n"
"if { [lsearch -exact $flag(noarg) $flg] == -1 } { \n"
"incr ctr\n"
"}\n"
"if { $ctr >= $argc } {\n"
"ErrorBox \"No value for command-line argument $a.\" \"Command Line Error\"\n"
"exit\n"
"}\n"
"set p [lsearch -exact $flag($ftype) $flg]\n"
"if { $p == -1 } {\n"
"ErrorBox \"Unrecognized command-line argument $a\\n$fmtmsg\" \"Command Line Error\"\n"
"exit\n"
"}\n"
"switch [lindex $flag(l) $p] {\n"
"window  { \n"
"set param(TimeWindow) [lindex $argv $ctr]\n"
"if { $param(TimeWindow) > $maxTimeWindow } {\n"
"set maxTimeWindow $param(TimeWindow)\n"
"if { $maxTimeWindow > $maxMaxWindow } {\n"
"set maxMaxWindow $param(TimeWindow)\n"
"}\n"
"}\n"
"}\n"
"cfghome { \n"
"set cfghome [lindex $argv $ctr]\n"
"if { $khome == \"\" } {\n"
"set khome $cfghome\n"
"}\n"
"}\n"
"dump {\n"
"set will_dump 1\n"
"}\n"
"keyhome { set khome [lindex $argv $ctr] }\n"
"bkmkfile { set Bkmk(fname) [lindex $argv $ctr] }\n"
"parameter { \n"
"set parmlist [split [lindex $argv $ctr] \"=\"]\n"
"if { [ llength $parmlist ] != 2 } {\n"
"ErrorBox \"Bad parameter argument: $parmlist\" \"Command Line Error\"\n"
"exit\n"
"}\n"
"lappend parmset $parmlist\n"
"}\n"
"help { \n"
"puts \"$fmtmsg\"\n"
"puts \"-b <file> \\t Bookmark file to read at startup\"\n"
"puts \"-c <path> \\t Path to nlv-<anything>.cfg (-k overrides)\"\n"
"puts \"-h \\t\\t Print this message\"\n"
"puts \"-k <path> \\t Path to nlv-keys.cfg\"\n"
"puts \"-w <number> \\t Initial window size (in seconds)\"\n"
"puts \"-d         \\t Dump global parameters and exit\"\n"
"puts \"-p name=value \\t Set a global parameter (repeatable)\"\n"
"exit \n"
"}\n"
"}\n"
"}    \n"
"}\n"
"if { !$will_dump && $fname == \"\" } {\n"
"ErrorBox \"You must invoke nlv with a filename.\\n$fmtmsg\" \"Command Line Error\"\n"
"exit\n"
"}\n"
"if { $home == \"\" } {\n"
"if {[info exists env(NLHOME)]} {\n"
"set home $env(NLHOME)\n"
"} elseif {[info exists env(NLVHOME)]} {\n"
"set home $env(NLVHOME)\n"
"} elseif {[info exists env(DPSSHOME)]} {\n"
"set home $env(DPSSHOME)\n"
"} else {\n"
"set home \".\"\n"
"}\n"
"}\n"
"if {[info exists env(ARCH)]} {\n"
"set arch $env(ARCH)\n"
"} else {\n"
"set arch \"unknown\"\n"
"}\n"
"if { $home == \"\" } {\n"
"wm withdraw .\n"
"ErrorBox \"Environment variable NLHOME is empty!\" \n"
"exit\n"
"}\n"
"if { $cfghome == \"\" } {\n"
"set cfglist [ list $home/cfg/nlv $home/etc $home \".\" ]\n"
"} else {\n"
"set cfglist $cfghome\n"
"set cfghome \"\"\n"
"}\n"
"foreach loc $cfglist {\n"
"if { [LoadConfigInfo \"$loc/nlv-main.cfg\"] == 0 } {\n"
"set cfghome $loc\n"
"break\n"
"}\n"
"}\n"
"if  { $cfghome == \"\" } {\n"
"ErrorBox \"Unable to load nlv-main.cfg from: $cfglist\" \"Config Error\"\n"
"exit\n"
"}\n"
"puts \"Using $cfghome/nlv-main.cfg\"\n"
"if { $will_dump } {\n"
"DumpParams\n"
"exit\n"
"}\n"
"if { [llength $parmset] > 0 } {\n"
"foreach pair $parmset {\n"
"set parmname [lindex $pair 0]\n"
"set parmval [lindex $pair 1]\n"
"if { [info exists param($parmname) ] } {\n"
"set param($parmname) $parmval\n"
"} else {\n"
"ErrorBox \"No such parameter '$parmname': use -d option to see parameters\" \\\n"
"\"Command Line Error\"\n"
"exit\n"
"}\n"
"}\n"
"}\n"
"blt::graph .graph\n"
"if { $khome == \"\" } {\n"
"set cfglist [ list \".\" $home/cfg/nlv $home/etc $home ]\n"
"} else {\n"
"set cfglist $khome\n"
"set khome \"\"\n"
"}\n"
"foreach loc $cfglist {\n"
"if { [file readable \"$loc/nlv-keys.cfg\"] } {\n"
"set khome $loc\n"
"break\n"
"} \n"
"}\n"
"if  { $khome == \"\" } {\n"
"ErrorBox \"Unable to load nlv-keys.cfg from { $cfglist }\" \"Config Error\"\n"
"exit\n"
"}\n"
"puts \"Using $loc/nlv-keys.cfg\"\n"
"if { ! [ info exists blt_library ] ||\n"
"! [ file readable $blt_library/bltGraph.pro ] } {\n"
"set foundit 0\n"
"set cfglist [ list $home/cfg/nlv $home/etc $home \".\" ]\n"
"foreach loc $cfglist {\n"
"set blt_library $loc\n"
"if { [file readable $blt_library/bltGraph.pro] } {\n"
"set foundit 1\n"
"break\n"
"}\n"
"}\n"
"if { ! $foundit  } {\n"
"ErrorBox \"Unable to load postscript file bltGraph.pro from { $cfglist } \" \"Config Error\"\n"
"exit 1\n"
"}\n"
"}\n"
"puts \"Using $blt_library/bltGraph.pro\"\n"
"set env(BLT_LIBRARY) $blt_library\n"
"Init $khome $fname $param(maxgraphelements)\n"
"if { [file size $fname] == 0 } {\n"
"set spinnum 0\n"
"wm title . \"Empty Log File\"\n"
"frame .spin1\n"
"message .spin1.m -text \"Waiting for log file '$fname' to be non-empty.\" -bg white \\\n"
"-width 200\n"
"pack .spin1 .spin1.m -fill both -expand 1\n"
"update idletasks\n"
"while { [file size $fname] == 0 } {\n"
"after 500\n"
"if { $spinnum == 0 } {\n"
".spin1.m configure -background red\n"
"set spinnum 1\n"
"} else {\n"
".spin1.m configure -background white\n"
"set spinnum 0\n"
"}\n"
"update idletasks\n"
"}\n"
"pack forget .spin1 .spin1.m\n"
"wm title . \"\"\n"
"after 500\n"
"}\n"
"Init $khome $fname $param(maxgraphelements)\n"
"CreateWindow\n"
"UpdateAsynchronous 0 0\n"
"IndexerInit $fname\n"
"if { $Bkmk(fname) != \"!NEW!\" } {\n"
"set Bkmk(dir) \"./\"\n"
"bkFileOK 0\n"
"}\n"
"set param(fname) $fname\n"
"if { [regexp -nocase $param(startmode) \"play\"] } {\n"
"Play\n"
"} else {\n"
"Rewind slide 1\n"
"}\n"
"}\n"
"source \"../../../src/nlv/annotate.tcl\"\n"
"source \"../../../src/nlv/bkmk.tcl\"\n"
"source \"../../../src/nlv/ek_cfg.tcl\"\n"
"source \"../../../src/nlv/ipdlg.tcl\"\n"
"source \"../../../src/nlv/keydlg.tcl\"\n"
"source \"../../../src/nlv/nlvmenu.tcl\"\n"
"source \"../../../src/nlv/nlvstats.tcl\"\n"
"source \"../../../src/nlv/printdlg.tcl\"\n"
"source \"../../../src/nlv/savesel.tcl\"\n"
"source \"../../../src/nlv/saveseldlg.tcl\"\n"
"source \"../../../src/nlv/statline.tcl\"\n"
"source \"../../../src/nlv/summ.tcl\"\n"
"source \"../../../src/nlv/symdlg.tcl\"\n"
"source \"../../../src/nlv/zoombox.tcl\"\n"
"#namespace eval Trace {\n"
"#proc showproc { level command argv } {\n"
"#trace variable SLStart w Trace::showval\n"
"#trace variable SLEnd   w Trace::showval\n"
"#trace variable param(LastFileTime) w Trace::showval\n"
"option add *Legend.anchor       nw\n"
"option add *Legend.activeRelief raised\n"
"option add *Legend.activeBorderWidth 2\n"
"option add *Legend.font         -*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-*\n"
"option add *Legend.relief       flat\n"
"option add *Legend.borderWidth  0\n"
"option add *Element.ScaleSymbols false\n"
"set curSet \"\"\n"
"set latestRead -1\n"
"set latestFile 0\n"
"set maxTimeWindow 10.0\n"
"set maxMaxWindow 10.0\n"
"set widget(pcontrolNames) {}\n"
"set widget(scaleControl)  0\n"
"set widget(clockName)     {}\n"
"set widget(RewScaleValue)  0\n"
"set widget(RewScaleDef)   5000\n"
"set widget(RefreshButton) {}\n"
"set widget(Autospeed)     {Auto-speed}\n"
"set widget(serverButtons) {}\n"
"set param(color-rulerfill) \\#0099ff\n"
"set param(CLIST,name)      {}\n"
"set param(CLIST,orgname)   {}\n"
"set param(DashFactor)      2\n"
"set param(Playing)         0\n"
"set param(TimeWindow)      5.0\n"
"set param(LeftX)           0\n"
"set param(LastFileTime)    0\n"
"set param(IndexerTime)     0\n"
"set param(STAT,NameWid)    32 \n"
"set param(STAT,ThruWid)    18\n"
"set param(zoombox) [list -1 -1 -1 -1]\n"
"set param(pctdone) 0\n"
"set param(AutoSlowdown) 1\n"
"set param(ateof) 0\n"
"set param(ZoomDepth) 0\n"
"set param(ZoomEps) 0.00001\n"
"set param(AnnHeight) 8\n"
"set param(ShowAnnotation) 0\n"
"set param(_HighlightsChanged) 0\n"
"set param(_skipreq) {}\n"
"set param(SYM,types) [list lines points]\n"
"set param(SYM,lines) none\n"
"set param(SYM,points) cross\n"
"set redrawSepCtr  9\n"
"set serverChangedList   {}\n"
"set tcl_precision 17\n"
"set SLStart 0\n"
"set SLEnd 0\n"
"set SLZoom 0\n"
"set zmstack {}\n"
"set zmstack2 {}\n"
"tcl_main $argc $argv\n"
;
static char Et_zFile43[] = 
"proc CreateMenu { w } {\n"
"global param\n"
"foreach col [list color-menufg color-menubg color-menuabg] {\n"
"if { ![info exists param($col)] } {\n"
"puts \"setting param($col) to white\"\n"
"set param($col) \\#ffffff\n"
"}\n"
"}\n"
"set mattr [list -activebackground $param(color-menuabg) \\\n"
"-highlightbackground $param(color-ctlbg) \\\n"
"-background $param(color-menubg) \\\n"
"-foreground $param(color-menufg)]\n"
"set battr [list -activebackground $param(color-menuabg) \\\n"
"-background $param(color-menubg) \\\n"
"-foreground $param(color-menufg) ]\n"
"set menubar [list File Screen Options Modes Help]\n"
"set mf0 [frame $w]\n"
"set mf [frame $mf0.top -bg $param(color-menubg)]\n"
"foreach i $menubar {\n"
"set pathnm [string tolower $i]\n"
"eval { menubutton $mf.$pathnm -menu $mf.$pathnm.m -text \"$i\" } $mattr\n"
"menu $mf.$pathnm.m -tearoff no\n"
"}\n"
"set b $mf.file\n"
"eval {$b.m add command -label {Bookmark file..} -command {BkmkFileDlg}} $battr \n"
"eval {$b.m add command -label {Print...} -command {ShowPrintDlg}} $battr\n"
"eval {$b.m add command -label {Quit} -command {ExitProgram}} $battr\n"
"set b $mf.screen\n"
"eval {$b.m add command -label {Graph symbols..} -command {ShowSymDlg}} $battr\n"
"eval {$b.m add cascade -label {Controls size} -menu $b.m.sub_ctl} $battr\n"
"set m2 [menu $b.m.sub_ctl -tearoff no]\n"
"eval {$m2 add radio -label big -variable param(ctlsize) -command SetControlSize} $battr\n"
"eval {$m2 add radio -label small -variable param(ctlsize) -command SetControlSize} $battr\n"
"eval {$m2 add radio -label tiny -variable param(ctlsize) -command SetControlSize} $battr\n"
"eval {$b.m add cascade -label {Graph size} -menu  $b.m.sub_graph} $battr\n"
"set m2 [menu $b.m.sub_graph -tearoff no]\n"
"eval {$m2 add radio -label big -variable param(graphsize) -command SetGraphSize} $battr\n"
"eval {$m2 add radio -label small -variable param(graphsize) -command SetGraphSize} $battr\n"
"eval {$m2 add radio -label tiny -variable param(graphsize) -command SetGraphSize} $battr\n"
"set b $mf.modes\n"
"eval {$b.m add checkbutton -label \"Stop on EOF\" -variable param(eofpolicy)} $battr\n"
"eval {$b.m add checkbutton -label \"Skip to data\" -variable param(skiptonextdata) } $battr\n"
"eval {$b.m add checkbutton -label \"Auto-resize to data\" -command ToggleAutoResize } $battr\n"
"set b $mf.options\n"
"eval {$b.m add command -label {Set graph title..} -command {GraphTitleDlg}} $battr\n"
"eval {$b.m add command -label {Select events..} -command {ShowKeyDlg}} $battr\n"
"eval {$b.m add command -label {Bookmarks..} -command {BkmkList}} $battr\n"
"set b $mf.help\n"
"eval { $b.m add command -label {About} -command {AboutMsg} } $battr\n"
"eval { $b.m add command -label {Index} -command {}         } $battr\n"
"foreach i $menubar {\n"
"set nm [string tolower $i]\n"
"if { $nm != \"help\" } {\n"
"pack $mf.$nm -side left -anchor w\n"
"} else {\n"
"pack $mf.$nm -side right -anchor w\n"
"}\n"
"}\n"
"pack $mf -side top -anchor nw -expand 1 -fill x\n"
"pack $mf0 -side top -anchor w -expand 1 -fill x\n"
"return $mf\n"
"}\n"
"proc AboutMsg { } {\n"
"set msg {\n"
"NLV - NetLogger Visualization\n"
"Written and maintained by Dan Gunter\\n\n"
"(c)1999 Lawrence Berkeley National Labs\n"
"For more information, please refer to:\n"
"www-didc.lbl.gov/NetLogger/nlv/nlvmain.html \n"
"}  \n"
"set title \"About NLV\"\n"
"MessageBox $msg $title\n"
"return\n"
"}\n"
;
static char Et_zFile44[] = 
"proc ShowStatistics { } {\n"
"global param\n"
"if { $param(StatisticsShown) } return\n"
"set bopts [list -bg $param(color-buttonbg) -fg $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-highlightbackground $param(color-ctlbg) -font $param(bigfont) \\\n"
"-padx 20 -pady 2]\n"
"set w [toplevel .statswin]\n"
"set f [frame .statswin.f1 -width 200 -height 50 -bg $param(color-winbg)]\n"
"text $f.t -wrap none\n"
"$f.t insert @0,0 [GetStatistics]\n"
"$f.t insert @0,0 \"*** For testing purposes only! *** \\\n"
"\\n*** Do NOT trust these numbers ***\\n\"\n"
"$f.t configure -state disabled\n"
"pack $f.t -side top\n"
"eval {button $f.close -text \"Close\" \\\n"
"-command [list StatClosePressed $w]} $bopts\n"
"pack $f.close -side left -anchor w\n"
"pack $f\n"
"wm title $w \"Statistics\"\n"
"wm geometry $w +10+10\n"
"set param(StatisticsShown) 1\n"
"}\n"
"proc StatClosePressed { w } {\n"
"global param\n"
"destroy $w\n"
"set param(StatisticsShown) 0\n"
"return\n"
"}\n"
;
static char Et_zFile45[] = 
"proc PrintSelect { parent } {\n"
"global param prOpt env widget\n"
"set bwid 10\n"
"set bbg $param(color-buttonbg)\n"
"set bag $param(color-buttonabg)\n"
"set bfg $param(color-buttonfg)\n"
"set cbg $param(color-ctlbg)\n"
"set fbg \"#cccccc\"\n"
"set lbg #ffffff\n"
"toplevel $parent\n"
"frame $parent.printers -bg $cbg\n"
"frame $parent.options  -bg $cbg\n"
"frame $parent.cmd      -bg $cbg\n"
"frame $parent.formats  -bg $cbg\n"
"set f $parent.printers\n"
"label $f.flabel -text \"Printers\" -bg $lbg \\\n"
"-highlightbackground $lbg\n"
"pack $f.flabel -side top\n"
"if {[info exists env(PRINTER)]} {\n"
"set defpr 0\n"
"} else {\n"
"set defpr 1\n"
"set env(PRINTER) [lindex $param(printers) 0]\n"
"}\n"
"foreach i $param(printers) {\n"
"radiobutton [string tolower \"$f.$i\"] -text $i -value $i -variable prOpt(printer) \\\n"
"-bg $cbg -highlightbackground $cbg\n"
"if { !$defpr && $i == $env(PRINTER) } {\n"
"set defpr 1\n"
"}\n"
"pack $f.$i -side top -anchor w\n"
"}\n"
"if { $defpr == 0 } {\n"
"set i $env(PRINTER)\n"
"radiobutton $f.$i -text $i -value $i -variable prOpt(printer) \\\n"
"-bg $cbg -highlightbackground $cbg\n"
"pack $f.$i -side top -anchor w\n"
"}\n"
"set prOpt(printer) $env(PRINTER)\n"
"set file [frame $f.file -bg $cbg]\n"
"set widget(prOpt,file) $file\n"
"checkbutton $file.c1 -text \"Print to a file\" \\\n"
"-variable prOpt(file) \\\n"
"-command DrawFileWidget \\\n"
"-bg $cbg \\\n"
"-highlightbackground $cbg\n"
"frame $file.fmt -bg $fbg\n"
"label       $file.c2 -text \"Filename\" \\\n"
"-bg $cbg\n"
"entry       $file.c3 -textvar prOpt(filename) \\\n"
"-relief sunken \\\n"
"-bg \"white\"\n"
"DrawFileWidget\n"
"pack $file.c1 $file.fmt $file.c2 $file.c3 -side top -anchor w\n"
"pack $file -side bottom\n"
"set f $parent.formats\n"
"label $f.title \\\n"
"-text \"Format\" \\\n"
"-bg $lbg \\\n"
"-highlightbackground $lbg\n"
"set f [frame $f.options -bg $cbg]\n"
"radiobutton $f.ps \\\n"
"-bg $cbg \\\n"
"-highlightbackground $cbg \\\n"
"-text \"PostScript(tm)\" \\\n"
"-variable prOpt(format) \\\n"
"-value \"postscript\" \\\n"
"-command ToggleGnuplotChoices\n"
"radiobutton $f.gp \\\n"
"-bg $cbg \\\n"
"-highlightbackground $cbg \\\n"
"-text \"Gnuplot\" \\\n"
"-variable prOpt(format) \\\n"
"-value \"gnuplot\" \\\n"
"-command ToggleGnuplotChoices\n"
"pack $f.ps $f.gp -side left -anchor w\n"
"set f $parent.formats\n"
"frame $f.gpc \\\n"
"-bg $fbg\n"
"CreateGnuplotChoices $f.gpc\n"
"pack $f.title $f.options -side top -anchor w\n"
"ToggleGnuplotChoices\n"
"set f $parent.options\n"
"label $f.flabel -text \"Options\" -bg $lbg \\\n"
"-highlightbackground $lbg\n"
"frame $f.display -bg $cbg\n"
"set disp $f.display\n"
"pack $f.flabel $disp -side top\n"
"label       $disp.a0 -text \"ORIENTATION\" -bg $cbg -highlightbackground $cbg\n"
"radiobutton $disp.a1 -text \"Landscape\" -variable prOpt(orient) \\\n"
"-value 1 -bg $cbg  -highlightbackground $cbg\n"
"radiobutton $disp.a2 -text \"Portrait\" -variable prOpt(orient) \\\n"
"-value 0 -bg $cbg  -highlightbackground $cbg\n"
"label       $disp.b0 -text \"COLOR\" -bg $cbg \\\n"
"-highlightbackground $cbg\n"
"radiobutton $disp.b3 -text \"Color\" -variable prOpt(color) -value 0 -bg $cbg \\\n"
"-highlightbackground $cbg\n"
"radiobutton $disp.b1 -text \"Black and White\" -variable prOpt(color) \\\n"
"-value 2 -bg $cbg -highlightbackground $cbg\n"
"pack $disp.a0 $disp.a1 $disp.a2 -side top -anchor w\n"
"pack $disp.b0 $disp.b1 $disp.b3 -side top -anchor w\n"
"button $parent.cmd.ok -text \"OK\" \\\n"
"-command [list prOKButtonPressed $parent] \\\n"
"-borderwidth 4 -highlightbackground $cbg \\\n"
"-bg $bbg -activebackground $bag -fg $bfg -padx 5 -pady 5\n"
"button $parent.cmd.cancel -text \"Cancel\" \\\n"
"-command [list prCancelButtonPressed $parent] \\\n"
"-borderwidth 4 -highlightbackground $cbg \\\n"
"-bg $bbg -activebackground $bag -fg $bfg -padx 5 -pady 5\n"
"pack $parent.cmd.ok $parent.cmd.cancel -side left\n"
"pack $parent.cmd \\\n"
"-side bottom \\\n"
"-fill x\n"
"pack $parent.printers $parent.formats $parent.options \\\n"
"-fill both \\\n"
"-side left \\\n"
"-anchor n\n"
"return $parent\n"
"}\n"
"proc DrawFileWidget { } {\n"
"global widget param prOpt\n"
"set file $widget(prOpt,file)\n"
"switch -exact $prOpt(file) {\n"
"1 {\n"
"set newstate normal\n"
"set newbg \"white\"\n"
"set newfg \"black\"\n"
"}\n"
"0 { \n"
"set newstate disabled\n"
"set newbg \"#999999\"\n"
"set newfg $newbg\n"
"}\n"
"}\n"
"$file.c2 configure -fg $newfg\n"
"$file.c3 configure -bg $newbg -state $newstate\n"
"}\n"
"proc CreateGnuplotChoices { parent } {\n"
"global prOpt param widget\n"
"set choices { \\\n"
"gnuplot \\\n"
"aed512         aed767         aifm           bitgraph \\\n"
"cgm            corel          dumb           dxf \\\n"
"eepic          emtex          epson-180dpi   epson-60dpi \\\n"
"epson-lx800    fig            gif            gpic \\\n"
"hp2623a        hp2648         hp500c         hpdj \\\n"
"hpgl           hpljii         hppj           imagen \\\n"
"kc-tek40xx     km-tek40xx     latex          \\\n"
"mf             mif            nec-cp6        okidata \\\n"
"pbm            pcl5           png            postscript \\\n"
"pslatex        pstex          pstricks       qms \\\n"
"regis          selanar        starc          table \\\n"
"tandy-60dpi    tek40xx        tek410x        texdraw \\\n"
"tgif           tkcanvas       tpic           vttek \\\n"
"x11            xlib }\n"
"set cols 4\n"
"set len [llength $choices]\n"
"for { set i 0 } { $i < $cols } { incr i } {\n"
"frame $parent.$i -bg $param(color-ctlbg)\n"
"}\n"
"for { set i 0 ; set j 0 } { $i < $len } { incr i } {\n"
"radiobutton $parent.$j.$i -text [lindex $choices $i] \\\n"
"-variable prOpt(gnuplot_format) \\\n"
"-value [lindex $choices $i] \\\n"
"-bg $param(color-ctlbg) \\\n"
"-highlightbackground $param(color-ctlbg)\n"
"pack $parent.$j.$i -side top -anchor w\n"
"incr j\n"
"set j [expr $j % $cols]\n"
"}\n"
"for { set i 0 } { $i < $cols } { incr i } {\n"
"pack $parent.$i -side left -fill y\n"
"}\n"
"set widget(gpc_cols) $cols\n"
"set widget(gpc) $parent\n"
"}\n"
"proc ToggleGnuplotChoices { } {\n"
"global prOpt widget param\n"
"if { $prOpt(format) == \"gnuplot\" } {\n"
"$widget(gpc) configure -bg $param(color-ctlbg)\n"
"pack $widget(gpc) -side top\n"
"} else {\n"
"pack forget $widget(gpc)\n"
"}\n"
"}\n"
"proc prOKButtonPressed { parent } {\n"
"global param didPause prOpt\n"
"set graphWidget .graph\n"
"if { $prOpt(file) == 1 && $prOpt(filename) == \"\" } {\n"
"return\n"
"}\n"
"set landscape $prOpt(orient)\n"
"set colormode [lindex {color gray mono} $prOpt(color)]\n"
"if { $prOpt(format) == \"gnuplot\" } {\n"
"if { $prOpt(file) } {\n"
"set dev $prOpt(filename)\n"
"} else {\n"
"set dev \"|$param(lpr) $prOpt(printer)\"\n"
"}\n"
"set box [MessageBox \"Writing the window to device '$dev' \\\n"
"using format '$prOpt(gnuplot_format)'.\" \"Status\" nowait]\n"
"PrintGnuplot $prOpt(file) $prOpt(filename) $prOpt(gnuplot_format) \\\n"
"$landscape $colormode\n"
"destroy $box\n"
"} else { \n"
"if { $colormode == \"mono\" } {\n"
"Decolor\n"
"}\n"
"set ctr 0\n"
"set f $param(DashFactor)\n"
"foreach c $param(CLIST,name) {\n"
"if { 0 == [ catch { $graphWidget element configure L$ctr } ] } {\n"
"$graphWidget element delete L$ctr\n"
"}\n"
"if { $colormode == \"mono\" } {\n"
"$graphWidget element create L$ctr -label $c \\\n"
"-symbol none -dashes [expr $ctr*$f + 1]\n"
"} else {\n"
"$graphWidget element create L$ctr -label $c \\\n"
"-symbol none -color $param(CLIST,color,$c)\011 \n"
"}\n"
"incr ctr\n"
"}\n"
"$graphWidget legend configure -hide no\n"
"update idletasks\n"
"if { $prOpt(file) == 1 } {\n"
"set ofile $prOpt(filename)\n"
"} else {\n"
"set ofile \"killme.tmp.ps\"\n"
"}\n"
"$graphWidget postscript output $ofile \\\n"
"-landscape $landscape \\\n"
"-colormode $colormode \\\n"
"-paperheight 11i \\\n"
"-paperwidth 8.5i \\\n"
"-height 7.5i \\\n"
"-width 9.5i \\\n"
"-padx 0 \\\n"
"-pady 0\n"
"if { $colormode == \"mono\" } {\n"
"Recolor\n"
"}\n"
"$graphWidget legend configure -hide yes\n"
"set ctr 0\n"
"foreach c $param(CLIST,name) {\n"
"$graphWidget element delete L$ctr\n"
"incr ctr\n"
"}\n"
"if { $prOpt(file) == 0 } {\n"
"set printCommand \\\n"
"[exec $param(lpr) -P$prOpt(printer) $param(lpropts) $ofile]\n"
"exec rm $ofile\n"
"}\n"
"}\n"
"destroy $parent\n"
"update idletasks\n"
"if { $didPause } {\n"
"set param(Paused) 0\n"
"Play\n"
"}\n"
"}\n"
"proc prCancelButtonPressed { parent } {\n"
"global didPause\n"
"destroy $parent\n"
"if { $didPause } {\n"
"set param(Paused) 0\n"
"Play\n"
"}\n"
"}\n"
"proc ShowPrintDlg { } {\n"
"global param didPause\n"
"if { $param(Paused) == 0 } { \n"
"set param(Paused) 1\n"
"Pause\n"
"set didPause 1 \n"
"} else {\n"
"set didPause 0\n"
"}\n"
"set dlg [PrintSelect .print]\n"
"wm title $dlg \"Print\"\n"
"wm geometry $dlg +100+200\n"
"}\n"
"proc standalone { } {\n"
"global param\n"
"set param(Paused) 1\n"
"set param(color-winbg) #b0d9d9\n"
"set param(color-graphbg) #ffffff\n"
"set param(color-menubg) #ffffff\n"
"set param(color-menufg) #000000\n"
"set param(color-menuabg) #00f9f9\n"
"set param(color-ctlbg) #b0d9d9\n"
"set param(color-buttonbg) #c1e2e2\n"
"set param(color-buttonfg) #000000\n"
"set param(color-buttonabg) #00f9f9\n"
"set param(color-rewoff) #eeeeee\n"
"set param(color-rewon) #b0d9d9\n"
"set param(color-annotation) \\#000000\n"
"set param(printers) { itg1 itg2 itg3 }\n"
"}\n"
"global didPause\n"
"set prOpt(orient) 1\n"
"set prOpt(color) 2\n"
"set prOpt(format) postscript\n"
"set prOpt(gnuplot_format) gnuplot\n"
;
static char Et_zFile46[] = 
""
;
static char Et_zFile47[] = 
"proc SaveSelect { parent } {\n"
"global param prOpt env\n"
"set bwid 10\n"
"set bbg $param(color-buttonbg)\n"
"set bag $param(color-buttonabg)\n"
"set bfg $param(color-buttonfg)\n"
"set cbg $param(color-ctlbg)\n"
"set lbg #ffffff\n"
"toplevel $parent\n"
"frame $parent.main -bg $cbg\n"
"frame $parent.main.other -bg $cbg\n"
"frame $parent.main.other.range -bg $cbg\n"
"frame $parent.main.events -bg $cbg\n"
"frame $parent.button -bg $cbg\n"
"set f $parent.main.other\n"
"label $f.rtitle -text \"Time Range\" -bg $lbg -highlightbackground $lbg\n"
"entry $f.range.r1 -bg white\n"
"entry $f.range.r2 -bg white\n"
"label $f.ftitle -text \"File\" -bg $lbg -highlightbackground $lbg\n"
"entry $f.f -bg white\n"
"pack $f.range.r1 $f.range.r2 -side left -side top -fill both -expand 1\n"
"pack $f.rtitle -anchor w -side top -fill both -expand 1\n"
"pack $f.range -side top -fill both -expand 1\n"
"pack $f.ftitle -anchor w -side top -fill both -expand 1\n"
"pack $f.f -side top -fill both -expand 1\n"
"set f $parent.main.events\n"
"label $f.etitle -text \"Events\" -bg $lbg -highlightbackground $lbg\n"
"pack $f.etitle -side top -fill x -anchor n\n"
"pack $parent.main.other $parent.main.events -side left -anchor n  \\\n"
"-fill both -expand 1\n"
"set f $parent.button\n"
"button $f.merge -text \"Merge\"\n"
"button $f.replace -text \"Replace\"\n"
"button $f.cancel -text \"Cancel\"\n"
"pack $f.merge $f.replace $f.cancel -side left -fill both\n"
"pack $parent.main $parent.button -side top -expand 1 -fill both\n"
"return $parent\n"
"}\n"
"proc ShowSaveselDlg { } {\n"
"global param didPause\n"
"if { $param(Paused) == 0 } { \n"
"set param(Paused) 1\n"
"Pause\n"
"set didPause 1 \n"
"} else {\n"
"set didPause 0\n"
"}\n"
"set dlg [SaveSelect .savesel]\n"
"wm title $dlg \"Save Selection\"\n"
"wm geometry $dlg +100+200\n"
"}\n"
"global didPause\n"
;
static char Et_zFile48[] = 
"proc SLInit { path x0 y0 x1 y1 lw } {\n"
"global param widget\n"
"if { $path == \".\" } {\n"
"set path \"\"\n"
"}\n"
"incr x0 20\n"
"incr x1 20\n"
"incr y0 20\n"
"incr y1 20\n"
"set param(SL,x0) $x0\n"
"set param(SL,x1) $x1\n"
"set param(SL,y0) $y0\n"
"set param(SL,y1) $y1\n"
"set param(SL,lw) $lw\n"
"set param(SL,lw2) [expr $lw / 2]\n"
"set param(SL,inner) [expr $x1 - $x0 - $lw]\n"
"set param(SL,mid) [expr $y0 + ($y1 - $y0)/2]\n"
"set widget(SL) [canvas $path.c \\\n"
"-background \\#ffffff \\\n"
"-highlightthickness 0 \\\n"
"-bd 0 ]\n"
"$widget(SL) create line $x0 $param(SL,mid) $x1 $param(SL,mid) \\\n"
"-width [expr ($y1-$y0)] -fill \\#ffffff\n"
"$widget(SL) create line $x0 $y0 $x0 $y1 $x0 $param(SL,mid) \\\n"
"$x1 $param(SL,mid) $x1 $y0 $x1 $y1 \\\n"
"-width $lw \\\n"
"-tag ruler \\\n"
"-fill $param(color-rulerfill)\n"
"$widget(SL) create text $x0 $y1 -text \"?\" -anchor n -tag lbound\n"
"$widget(SL) create text $x1 $y1 -text \"?\" -anchor n -tag rbound\n"
"SLUpdateScale $widget(SL) 0 $param(LastFileTime)\n"
"SLRefit $widget(SL)\n"
"pack $widget(SL) -side top -anchor center -expand 1 -fill both \n"
"return $widget(SL)\n"
"}\n"
"proc fmt_t { t } { \n"
"global param \n"
"return [format \"%.1f\" $t]\n"
"}\n"
"proc SLTimeToPos { time } {\n"
"global param SLStart SLEnd\n"
"set t0 $SLStart\n"
"set t1 $SLEnd\n"
"if { $time <= $t0 || [expr $t1-$t0+0.0] == 0 } {\n"
"return [expr $param(SL,x0) + $param(SL,lw)]\n"
"} \n"
"if { $time > $t1 } {\n"
"return [expr $param(SL,x0) + $param(SL,inner) + 0.0] \n"
"}\n"
"set x1 [expr ($time - $t0+0.0)/($t1-$t0+0.0)]\n"
"set x2 [expr $x1*($param(SL,inner)+0.0)]\n"
"set x3 [expr $x2+$param(SL,x0)]\n"
"return $x3\n"
"}\n"
"proc SLPosToTime { pos } {\n"
"global param SLStart SLEnd\n"
"set t0 $SLStart\n"
"set t1 $SLEnd\n"
"set x1 [expr $pos - $param(SL,x0)]\n"
"set x2 [expr $x1 / ($param(SL,inner)+0.0)]\n"
"set x3 [expr $x2 * ($t1 - $t0 + 0.0) + $t0]\n"
"return $x3\n"
"} \n"
"proc SLGetTime { path w } {\n"
"global param\n"
"return $param(SL,T$path$w)\n"
"}\n"
"proc SLAddMarker { atag path bmp {color \\#000000} time {updown down} {showtime no} } {\n"
"global param widget\n"
"if { $updown == \"up\" } {\n"
"set shft -1\n"
"set anch s\n"
"} else {\n"
"set shft 1\n"
"set anch n\n"
"}\n"
"set bx [SLTimeToPos $time]\n"
"set by [expr $param(SL,mid) + $shft * $param(SL,lw)]\n"
"$path create bitmap $bx $by \\\n"
"-bitmap $bmp \\\n"
"-foreground $color\\\n"
"-anchor $anch \\\n"
"-tags $atag\n"
"set w $atag\n"
"if { $showtime } {\n"
"set bbox [$path bbox $w]\n"
"set widget(SL,T$path$w) \\\n"
"[ $path create text $bx [expr $by + $shft*([lindex $bbox 3] - [lindex $bbox 1])] \\\n"
"-text \"0\" \\\n"
"-anchor $anch \\\n"
"-tags $atag \n"
"]\n"
"}\n"
"SLRefit $path\n"
"set param(SL,T$path$w) $time\n"
"return $w\n"
"}\n"
"proc SLMoveMarker { path tag newtime } {\n"
"global param widget\n"
"set dx [expr [SLTimeToPos $newtime] - [lindex [$path coords $tag] 0]]\n"
"$path move $tag $dx 0\n"
"set param(SL,T$path$tag) $newtime\n"
"if { $tag == $widget(SL,urhere) } {\n"
"SLMoveUrhere $path $widget(SL,T$path$tag) $param(SL,T$path$tag)\n"
"RewindScaleChanged\n"
"}\n"
"}\n"
"proc SLUpdateUrhere { }  {\n"
"global widget param SLStart SLEnd\n"
"if { $param(RewScaleValue) < $SLStart } {\n"
"set param(RewScaleValue) $SLStart\n"
"} elseif { $param(RewScaleValue) > $SLEnd } {\n"
"set param(RewScaleValue) $SLEnd\n"
"}\n"
"SLMoveMarker $widget(SL) $widget(SL,urhere) $param(RewScaleValue)\n"
"}\n"
"proc SLMoveUrhere { path w t } {\n"
"global param\n"
"$path itemconfigure $w -text [fmt_t $t]\n"
"set param(RewScaleValue) $t\n"
"}\n"
"proc SLRemoveMarker { path tag } {\n"
"$path delete $tag\n"
"}\n"
"proc SLRenameMarker { path oldtag newtag } {\n"
"$path addtag $newtag withtag $oldtag\n"
"$path dtag $oldtag\n"
"}\n"
"proc SLMakeDraggable { path tag } {\n"
"global widget\n"
"set widget(drag) 0\n"
"$path bind $tag <Button-1> \" \\\n"
"global widget;\\\n"
"SLMark %W %x $tag; \\\n"
"set widget(drag) 1\" \n"
"$path bind $tag <B1-Motion> \"SLDrag %W %x $tag\"\n"
"}\n"
"proc SLUnbind { n path tag } {\n"
"set click \"<Button-$n>\"\n"
"set move \"<B$n-Motion>\"\n"
"eval { $path bind $tag $click {} }\n"
"eval { $path bind $tag $move {} }\n"
"}\n"
"proc SLMark { path x what } {\n"
"global param\n"
"set param(SL,X$path$what) $x\n"
"set param(SL,T$path$what) [SLPosToTime $x]\n"
"}\n"
"proc SLDrag { path x what } {\n"
"global param widget\n"
"set m $param(SL,lw2)\n"
"if { $x < [expr $param(SL,x0) + $m ] || $x > [expr $param(SL,x1) - $m ] } {\n"
"return;\n"
"}\n"
"set param(SL,X$path$what) $x\n"
"SLMoveMarker $path $what [SLPosToTime $x]\n"
"update idletasks\n"
"}\n"
"proc SLUpdateScale { path t0 t1 } {\n"
"global param\n"
"set w lbound\n"
"$path dchars $w 0 end\n"
"$path insert $w 0 [fmt_t $t0]\n"
"set w rbound\n"
"$path dchars $w 0 end\n"
"$path insert $w 0 [fmt_t $t1]\n"
"SLRefit $path\n"
"}\n"
"proc SLRefit { path } {\n"
"set bbox [$path bbox all]\n"
"$path config -height [expr [lindex $bbox 3] + 4] \\\n"
"-width [expr [lindex $bbox 2] + 10]\n"
"}\n"
"set widget(SL) {}\n"
"set param(LastFileTime) 10000\n"
"set param(SL,entries)   0\n"
"set param(SL,numentries) 0\n"
"set param(SL,highest) 0\n"
;
static char Et_zFile49[] = 
"proc SummInit { w } {\n"
"global Elts param\n"
"set lw $param(SL,lw)\n"
"set Elts(Width)   2\n"
"set Elts(Display) [expr $param(SL,inner) / $Elts(Width)]\n"
"set Elts(MinY)    $param(SL,y1)\n"
"set Elts(MaxY)    [expr $param(SL,mid) + $lw]\n"
"set Elts(YRange)  [expr $Elts(MinY)-$Elts(MaxY)]\n"
"set Elts(MinX)    [expr $param(SL,x0) + $lw]\n"
"set Elts(MaxX)    [expr $param(SL,x1) + $lw]\n"
"set Elts(YScale)  1\n"
"for {set i 0} {$i < $Elts(Display)} {incr i} {\n"
"set Elts($i) [$w create line 0 0 0 0 -tag Elts -width 1]\n"
"}\n"
"return $w\n"
"}\n"
"proc SummRedraw { t1 t2 } {\n"
"global Elts widget\n"
"set n [SLSize $t2]\n"
"if { $n == 0 } { return }\n"
"set skip [expr ($n*1.0) / ($Elts(Display)*1.0)]\n"
"set tmskip [expr int(($t2-$t1) * $skip / $n + 1)  ]\n"
"set h [expr ($Elts(YRange)+0.0) / ([SLHighest]+0.00001) ]\n"
"if { $h == 0 } { return }\n"
"catch {\n"
"SLScanStart $t1\n"
"} scan_result\n"
"if { $scan_result != \"\" } {\n"
"return \n"
"}\n"
"for { set t $t1; set i 0 } { $t < $t2 } { incr t $tmskip; incr i } {\n"
"set a [SLScanNext $skip]\n"
"set height [expr ($a+0.0) * ($h+0.0)]\n"
"if { $height < 0 } { set height 0 }\n"
"set y [expr int($Elts(MinY) - $height)]\n"
"set x [expr int([SLTimeToPos $t])]\n"
"$widget(Summ) coords $Elts($i) $x $Elts(MinY) $x $y\n"
"}\n"
"SLScanDone\n"
"for { } { $i < $Elts(Display) } { incr i } {\n"
"$widget(Summ) coords $Elts($i) 0 0 0 0\n"
"}\n"
"SLUpdateScale $widget(Summ) $t1 $t2\n"
"}\n"
"global Elts()\n"
;
static char Et_zFile50[] = 
"proc ShowSymDlg { } {\n"
"global param widget symtmp\n"
"set types $param(SYM,types)\n"
"if { [info exists param(_symdlg)] } {\n"
"wm iconify $param(_symdlg)\n"
"wm deiconify $param(_symdlg)\n"
"return\n"
"} else {\n"
"set param(_symdlg) [toplevel .symdlg]\n"
"wm title .symdlg \"Graph Symbols\"\n"
"foreach i $types {\n"
"set symtmp($i) $param(SYM,$i)\n"
"}\n"
"}\n"
"set bopts [list -background $param(color-buttonbg) \\\n"
"-foreground $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-highlightbackground $param(color-ctlbg)]\n"
"set b $param(_symdlg)\n"
"set f [frame $b.instructions -background $param(color-winbg)]\n"
"label $f.txt -text \"Click with mouse-button 1 on the desired symbol.\" \\\n"
"-bg $param(color-menubg) \\\n"
"-fg \\#000000\n"
"pack $f.txt $f -side top -fill x -expand 1\n"
"set f [frame $b.decision -background $param(color-winbg)]\n"
"eval {button $f.ok -text \"OK\" -command CommitSymDlg} $bopts\n"
"eval {button $f.cancel -text \"Cancel\" -command CancelSymDlg} $bopts\n"
"pack $f.ok $f.cancel -side left -expand 1\n"
"pack $f -side bottom -fill x\n"
"foreach i $types {\n"
"set f [frame $b.$i -background $param(color-winbg)]\n"
"label $f.label -text $i -background $param(color-winbg)\n"
"set g [ blt::graph $f.graph \\\n"
"-plotbackground $param(color-graphbg) \\\n"
"-title \"\" \\\n"
"-background $param(color-winbg) \\\n"
"-rightmargin 0 \\\n"
"-leftmargin 0 \\\n"
"-bottommargin 0 \\\n"
"-topmargin 0 \\\n"
"-width 2i \\\n"
"-height 2i\n"
"]\n"
"$g yaxis configure \\\n"
"-min 0 \\\n"
"-max 2 \\\n"
"-stepsize 1 \\\n"
"-subdivisions 0 \\\n"
"-command SymLabel\n"
"$g xaxis configure -hide yes\n"
"$g grid configure -hide yes\n"
"SymPlace $g [list [SymLabel zz 0] [SymLabel zz 1] [SymLabel zz 2]]\n"
"SymHighlight $g $param(SYM,$i)\n"
"pack $g -side bottom\n"
"pack $f.label -side top -fill x -expand 1\n"
"pack $f -side left\n"
"bind $g <Button-1> {\n"
"global symtmp\n"
"set coords [%W invtransform %x %y]\n"
"set y [expr int(floor([lindex $coords 1] +0.5))]\n"
"set sym [SymLabel zz $y]\n"
"regexp symdlg\\.(.*)\\.graph %W zz ty\n"
"SymHighlight %W $symtmp($ty) no\n"
"set symtmp($ty) $sym\n"
"SymHighlight %W $sym\n"
"}\n"
"}\n"
"}\n"
"proc SymPlace {graphname symlist} {\n"
"set ctr 0\n"
"foreach sym $symlist {\n"
"if { $sym == \"none\" } { set sym \"diamond\" }\n"
"$graphname element create e$ctr \\\n"
"-data [list 0 $ctr] \\\n"
"-symbol $sym \\\n"
"-linewidth 1 \\\n"
"-label \"\"\n"
"SymHighlight $graphname $sym off\n"
"incr ctr\n"
"}\n"
"return\n"
"}\n"
"proc SymHighlight {graphname symname {highlight on}} {\n"
"set num [SymNumber $symname]\n"
"if { $highlight } {\n"
"$graphname element configure e$num \\\n"
"-color \\#ff0000\n"
"} else {\n"
"$graphname element configure e$num \\\n"
"-color \\#000000\n"
"}\n"
"return\n"
"}\n"
"proc SymLabel {pathname tick} {\n"
"switch $tick {\n"
"0 { return none }\n"
"1 { return cross }\n"
"2 { return circle }\n"
"}\n"
"return unknown\n"
"}\n"
"proc SymStringFromTypenum {typenum} {\n"
"global param\n"
"set typename [lindex $param(SYM,types) $typenum]\n"
"return $param(SYM,$typename)\n"
"}\n"
"proc SymNumber {label} {\n"
"switch $label {\n"
"none {return 0}\n"
"diamond {return 0}\n"
"cross {return 1}\n"
"circle {return 2}\n"
"}\n"
"puts \"Warning: Unrecognized symbol $label\"\n"
"return -1\n"
"}\n"
"proc CommitSymDlg { } {\n"
"global param symtmp\n"
"foreach i $param(SYM,types) {\n"
"if { $param(SYM,$i) != $symtmp($i) } {\n"
"set param(SYM,$i) $symtmp($i)\n"
"ChangeSymbols $i $param(SYM,$i)\n"
"}\n"
"}\n"
"destroy $param(_symdlg)\n"
"unset param(_symdlg)\n"
"}\n"
"proc CancelSymDlg { } {\n"
"global param\n"
"destroy $param(_symdlg)\n"
"unset param(_symdlg)\n"
"}\n"
"proc ChangeSymbols { which what } {\n"
"global param\n"
"toplevel .changing\n"
"wm title .changing \"Changing Symbols\"\n"
"set b .changing\n"
"set f [frame $b.f1 -bg $param(color-winbg)]\n"
"label $f.label -text \"I am now changing the symbols for\\ngraph element type '$which' to: $what\\nPlease wait...\" \\\n"
"-bg $param(color-winbg) \\\n"
"-justify left\n"
"pack $f.label $f -side top -fill both -expand 1\n"
"update idletasks\n"
"set whichnum [lsearch $param(SYM,types) $which]\n"
"SetGraphSymbols $whichnum $what\n"
"destroy .changing\n"
"}\n"
;
static char Et_zFile51[] = 
"namespace eval zscroll {\n"
"proc create { path callback } {\n"
"global widget param\n"
"set bopts [list -bg $param(color-buttonbg) -fg $param(color-buttonfg) \\\n"
"-activebackground $param(color-buttonabg) \\\n"
"-highlightbackground $param(color-ctlbg) -font $param(bigfont) ]\011\n"
"set path [frame $path.all -bg $param(color-ctlbg)]\n"
"frame $path.mid -bg $param(color-ctlbg)\n"
"frame $path.mid.r -bg $param(color-ctlbg)\n"
"frame $path.mid.l -bg $param(color-ctlbg)\n"
"frame $path.bot -bg $param(color-ctlbg)\n"
"eval { button $path.mid.r.zup -bitmap arrow_up -width 11 -height 10 \\\n"
"-command zscroll::up } $bopts\n"
"eval { button $path.mid.r.zdown -bitmap arrow_down -width 11 -height 10 \\\n"
"-command zscroll::down } $bopts\n"
"eval { button $path.bot.zleft -bitmap arrow_left -width 11 -height 10 \\\n"
"-command zscroll::left } $bopts\n"
"eval { button $path.bot.zright -bitmap arrow_right -width 11 -height 10 \\\n"
"-command zscroll::right } $bopts\011\n"
"blt::graph $path.zscroll \\\n"
"-title \"\" \\\n"
"-width 50 \\\n"
"-height 50 \\\n"
"-plotpadx 0 \\\n"
"-plotpady 0 \\\n"
"-leftmargin 5 \\\n"
"-topmargin 20 \\\n"
"-bottommargin 5 \\\n"
"-rightmargin 5 \\\n"
"-bg $param(color-ctlbg)\n"
"$path.zscroll xaxis configure -hide 1\n"
"$path.zscroll yaxis configure -hide 1\n"
"$path.zscroll grid configure \\\n"
"-color #eeeeee \\\n"
"-dashes 0 \\\n"
"-hide 0\n"
"$path.zscroll legend configure -hide 1\n"
"set c \"#cc2222\"\n"
"$path.zscroll element create zsbox \\\n"
"-symbol none \\\n"
"-linewidth 5 \\\n"
"-color $c \\\n"
"-data { 0 0 0 1 1 1 1 0 0 0 }\n"
"pack $path.bot.zleft $path.bot.zright -side left -fill both -expand 1\n"
"pack $path.zscroll -in $path.mid.l -side left -fill both -expand 1\n"
"pack $path.mid.r.zup $path.mid.r.zdown -side top -fill both -expand 1\n"
"pack $path.mid.l $path.mid.r -side left -fill both -expand 1\n"
"pack $path.mid $path.bot -side top -fill both -expand 1\n"
"pack $path\n"
"set widget(zscroll) $path.zscroll\n"
"set param(zscroll,callback) $callback\n"
"set param(zscroll,b1) { -1 -1 }\n"
"bind $path.zscroll <ButtonPress-1> {\n"
"set isElt [%W element closest %x %y e -halo 5 \\\n"
"-interpolate yes]\n"
"if { $isElt } {\n"
"set param(zscroll,b1) [%W invtransform %x %y]\n"
"} else {\n"
"set param(zscroll,b1) { -1 -1 }\n"
"}\n"
"}\n"
"bind $path.zscroll <ButtonRelease-1> {\n"
"}\n"
"bind $path.zscroll <B1-Motion> {\n"
"global param\n"
"if { [lindex $param(zscroll,b1) 0] != -1 } {\n"
"set coords [%W invtransform %x %y]\n"
"set x [lindex $coords 0]\n"
"set y [lindex $coords 1]\n"
"if { $x < 0 || $x > 1 || $y < 0 || $y > 1 } { \n"
"} else {\n"
"set deltax [expr $x - [lindex $param(zscroll,b1) 0] + 0.0]\n"
"set deltay [expr $y - [lindex $param(zscroll,b1) 1] + 0.0]\n"
"zscroll::shift $deltax $deltay\n"
"set param(zscroll,b1) $coords\n"
"}\n"
"}\n"
"}\n"
"return $path.zscroll\n"
"}\n"
"proc bounds { } {\n"
"global widget\n"
"$widget(zscroll) xaxis configure -min 0 -max 1\n"
"$widget(zscroll) yaxis configure -min 0 -max 1\n"
"}\n"
"proc resize { x0 y0 x1 y1 } {\n"
"global widget\n"
"$widget(zscroll) element configure zsbox \\\n"
"-data [ list \\\n"
"$x0 $y0 $x0 $y1 \\\n"
"$x1 $y1 $x1 $y0 $x0 $y0 ]\n"
"bounds\n"
"}\n"
"proc shift { dx dy } {\n"
"global widget param\n"
"set cur [$widget(zscroll) element cget zsbox -data]\n"
"set curlen [llength $cur]\n"
"set new { }\n"
"for { set i 0 } { $i < $curlen } { incr i 2 } {\n"
"lappend new [expr [lindex $cur $i] + $dx * 1.0]\n"
"lappend new [expr [lindex $cur [expr $i + 1]] + $dy * 1.0]\n"
"}\n"
"if { [lindex $new 0] < 0 || [lindex $new 1] < 0 \\\n"
"|| [lindex $new 4] > 1 || [lindex $new 5] > 1 } {\n"
"return\n"
"}\n"
"$widget(zscroll) element configure zsbox -data $new\n"
"bounds\n"
"$param(zscroll,callback) [lindex $new 0] [lindex $new 1] [lindex $new 4] [lindex $new 5]\n"
"}\n"
"proc curwidth { } {\n"
"global widget\n"
"set cur [$widget(zscroll) element cget zsbox -data]\n"
"return [expr [lindex $cur 4] - [lindex $cur 0]]\n"
"}\n"
"proc curheight { } {\n"
"global widget\n"
"set cur [$widget(zscroll) element cget zsbox -data]\n"
"return [expr [lindex $cur 3] - [lindex $cur 1]]\n"
"}\n"
"proc up { } {\n"
"shift 0 [expr [curheight] / 10 ]\n"
"}\n"
"proc down { } {\n"
"shift 0 [expr [curheight] / -10 ]\n"
"}\n"
"proc left { } {\n"
"shift [expr [curwidth] / -10 ] 0\n"
"}\n"
"proc right { } {\n"
"shift [expr [curwidth] / 10 ] 0\n"
"}\n"
"proc title { str } {\n"
"global widget\n"
"$widget(zscroll) configure -title $str\n"
"}\n"
"proc title_font { fn } {\n"
"global widget\n"
"$widget(zscroll) configure -font $fn\n"
"}\n"
"proc frame_size { w h } {\n"
"global widget\n"
"$widget(zscroll) configure -width $w -height $h\n"
"}\n"
"}\n"
;
struct EtFile {
  char *zName;
  char *zData;
  int nData;
  int shrouded;
  struct EtFile *pNext;
};
static struct EtFile Et_FileSet[] = {
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/auto.tcl", Et_zFile0, sizeof(Et_zFile0)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/history.tcl", Et_zFile1, sizeof(Et_zFile1)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/init.tcl", Et_zFile2, sizeof(Et_zFile2)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/ldAout.tcl", Et_zFile3, sizeof(Et_zFile3)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/package.tcl", Et_zFile4, sizeof(Et_zFile4)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/parray.tcl", Et_zFile5, sizeof(Et_zFile5)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/safe.tcl", Et_zFile6, sizeof(Et_zFile6)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/tclIndex", Et_zFile7, sizeof(Et_zFile7)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tcl/word.tcl", Et_zFile8, sizeof(Et_zFile8)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/bgerror.tcl", Et_zFile9, sizeof(Et_zFile9)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/button.tcl", Et_zFile10, sizeof(Et_zFile10)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/clrpick.tcl", Et_zFile11, sizeof(Et_zFile11)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/comdlg.tcl", Et_zFile12, sizeof(Et_zFile12)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/console.tcl", Et_zFile13, sizeof(Et_zFile13)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/dialog.tcl", Et_zFile14, sizeof(Et_zFile14)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/entry.tcl", Et_zFile15, sizeof(Et_zFile15)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/focus.tcl", Et_zFile16, sizeof(Et_zFile16)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/listbox.tcl", Et_zFile17, sizeof(Et_zFile17)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/menu.tcl", Et_zFile18, sizeof(Et_zFile18)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/msgbox.tcl", Et_zFile19, sizeof(Et_zFile19)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/obsolete.tcl", Et_zFile20, sizeof(Et_zFile20)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/optMenu.tcl", Et_zFile21, sizeof(Et_zFile21)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/palette.tcl", Et_zFile22, sizeof(Et_zFile22)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/safetk.tcl", Et_zFile23, sizeof(Et_zFile23)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/scale.tcl", Et_zFile24, sizeof(Et_zFile24)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/scrlbar.tcl", Et_zFile25, sizeof(Et_zFile25)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/tclIndex", Et_zFile26, sizeof(Et_zFile26)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/tearoff.tcl", Et_zFile27, sizeof(Et_zFile27)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/text.tcl", Et_zFile28, sizeof(Et_zFile28)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/tk.tcl", Et_zFile29, sizeof(Et_zFile29)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/tkfbox.tcl", Et_zFile30, sizeof(Et_zFile30)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/tk/xmfbox.tcl", Et_zFile31, sizeof(Et_zFile31)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/blt/bltDnd.tcl", Et_zFile32, sizeof(Et_zFile32)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/blt/bltGraph.tcl", Et_zFile33, sizeof(Et_zFile33)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/blt/bltHier.tcl", Et_zFile34, sizeof(Et_zFile34)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/blt/bltTabset.tcl", Et_zFile35, sizeof(Et_zFile35)-1, 0, 0 },
  { "/home/g2/src/distributions/NetLogger-NLV/src/tcllib/blt/tclIndex", Et_zFile36, sizeof(Et_zFile36)-1, 0, 0 },
  { "../../../src/nlv/annotate.tcl", Et_zFile37, sizeof(Et_zFile37)-1, 0, 0 },
  { "../../../src/nlv/bkmk.tcl", Et_zFile38, sizeof(Et_zFile38)-1, 0, 0 },
  { "../../../src/nlv/ek_cfg.tcl", Et_zFile39, sizeof(Et_zFile39)-1, 0, 0 },
  { "../../../src/nlv/ipdlg.tcl", Et_zFile40, sizeof(Et_zFile40)-1, 0, 0 },
  { "../../../src/nlv/keydlg.tcl", Et_zFile41, sizeof(Et_zFile41)-1, 0, 0 },
  { "nlv.tcl", Et_zFile42, sizeof(Et_zFile42)-1, 0, 0 },
  { "../../../src/nlv/nlvmenu.tcl", Et_zFile43, sizeof(Et_zFile43)-1, 0, 0 },
  { "../../../src/nlv/nlvstats.tcl", Et_zFile44, sizeof(Et_zFile44)-1, 0, 0 },
  { "../../../src/nlv/printdlg.tcl", Et_zFile45, sizeof(Et_zFile45)-1, 0, 0 },
  { "../../../src/nlv/savesel.tcl", Et_zFile46, sizeof(Et_zFile46)-1, 0, 0 },
  { "../../../src/nlv/saveseldlg.tcl", Et_zFile47, sizeof(Et_zFile47)-1, 0, 0 },
  { "../../../src/nlv/statline.tcl", Et_zFile48, sizeof(Et_zFile48)-1, 0, 0 },
  { "../../../src/nlv/summ.tcl", Et_zFile49, sizeof(Et_zFile49)-1, 0, 0 },
  { "../../../src/nlv/symdlg.tcl", Et_zFile50, sizeof(Et_zFile50)-1, 0, 0 },
  { "../../../src/nlv/zoombox.tcl", Et_zFile51, sizeof(Et_zFile51)-1, 0, 0 },
{0, 0}};
static struct EtFile *Et_FileHashTable[105];
/* The following copyright notice applies to code generated by
** "mktclapp".  The "mktclapp" program itself is covered by the
** GNU Public License.
**
** Copyright (c) 1998 D. Richard Hipp
**
** The author hereby grants permission to use, copy, modify, distribute,
** and license this software and its documentation for any purpose, provided
** that existing copyright notices are retained in all copies and that this
** notice is included verbatim in any distributions. No written agreement,
** license, or royalty fee is required for any of the authorized uses.
** Modifications to this software may be copyrighted by their authors
** and need not follow the licensing terms described here, provided that
** the new terms are clearly indicated on the first page of each file where
** they apply.
**
** In no event shall the author or the distributors be liable to any party
** for direct, indirect, special, incidental, or consequential damages
** arising out of the use of this software, its documentation, or any
** derivatives thereof, even if the author has been advised of the 
** possibility of such damage.  The author and distributors specifically
** disclaim any warranties, including but not limited to the implied
** warranties of merchantability, fitness for a particular purpose, and
** non-infringment.  This software is provided at no fee on an
** "as is" basis.  The author and/or distritutors have no obligation
** to provide maintenance, support, updates, enhancements and/or
** modifications.
**
** GOVERNMENT USE: If you are acquiring this software on behalf of the
** U.S. government, the Government shall have only "Restricted Rights"
** in the software and related documentation as defined in the Federal 
** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
** are acquiring the software on behalf of the Department of Defense, the
** software shall be classified as "Commercial Computer Software" and the
** Government shall have only "Restricted Rights" as defined in Clause
** 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
** author grants the U.S. Government and others acting in its behalf
** permission to use and distribute the software in accordance with the
** terms specified in this license. 
*/
#include <ctype.h>
#include <string.h>
#include <stdarg.h>
#include <stdio.h>
#if ET_ENABLE_TK
# include <tk.h>
#else
# include <tcl.h>
#endif
#include <stdlib.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>

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

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

/*
** Omit <unistd.h> under windows.
*/
#if !defined(__WIN32__)
# include <unistd.h>
#endif

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

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

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

/*
** Set ET_HAVE_OBJ to true if we are able to link against the
** new Tcl_Obj interface.
*/
#if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8
# define ET_HAVE_OBJ 1
#else
# define ET_HAVE_OBJ 0
#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  zData = FindBuiltinFile(zFilename, 1, &nData);
  if( zData==0 ) return NULL;
  p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );
  if( p==0 ) return NULL;
  p->zData = zData;
  p->nData = nData;
  p->cursor = 0;
  sprintf(zName,"builtin%08x",(unsigned int)zData);
  chan = Tcl_CreateChannel(&builtinChannelType, zName, 
                           (ClientData)p, TCL_READABLE);
  return chan;
}

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

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

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

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

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

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

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

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


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

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

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

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

  /* Insert our alternative stat(), access() and open() procedures
  ** so that any attempt to work with a file will check our built-in
  ** scripts first.
  */
#ifdef ET_HAVE_INSERTPROC
  extern int TclStatInsertProc(int (*)(char*, struct stat *));
  extern int TclAccessInsertProc(int (*)(char*, int));
  extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
                                                          char*,int));
  TclStatInsertProc(Et_FileStat);
  TclAccessInsertProc(Et_FileAccess);
  TclOpenFileChannelInsertProc(Et_FileOpen);
#endif

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

  /* The Et_NewBuiltFile command is inserted for use by FreeWrap
  ** and similar tools.
  */
#if ET_HAVE_OBJ
  Tcl_CreateObjCommand(interp,"Et_NewBuiltinFile",Et_NewBuiltinFileCmd,0,0);
#else
  Tcl_CreateCommand(interp,"Et_NewBuiltinFile",Et_NewBuiltinFileCmd,0,0);
#endif

  /* Overload the "file" and "source" commands
  */
#ifndef ET_HAVE_INSERTPROC
  {
    static char zRename[] = "rename file Et_FileCmd";
    Tcl_Eval(interp,zRename);
    Tcl_CreateCommand(interp,"file",Et_FileExists,0,0);
  }
#endif
  Tcl_CreateCommand(interp,"source",Et_Source,0,0);

  Et_Interp = interp;
#ifdef ET_TCL_LIBRARY
  Tcl_SetVar(interp,"tcl_library",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
  Tcl_SetVar(interp,"tcl_libPath",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
  Tcl_SetVar2(interp,"env","TCL_LIBRARY",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
#endif
#ifdef ET_TK_LIBRARY
  Tcl_SetVar(interp,"tk_library",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
  Tcl_SetVar2(interp,"env","TK_LIBRARY",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
#endif
#if ET_WIN32
  Tcl_CreateCommand(interp,"Et_MessageBox",Et_MessageBox, 0, 0);
#endif  
  Tcl_Eval(interp,zBgerror);
#if ET_HAVE_PREINIT
  if( Et_PreInit(interp) == TCL_ERROR ){
    goto initerr;
  }
#endif
  if( Tcl_Init(interp) == TCL_ERROR ){
    goto initerr;
  }
  Et_GlobalEvalF(interp,"set dir $tcl_library;source $dir/tclIndex;unset dir");
#if ET_ENABLE_TK
  if( Tk_Init(interp) == TCL_ERROR ){
    goto initerr;
  }
  Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
  Et_GlobalEvalF(interp,"set dir $tk_library;source $dir/tclIndex;unset dir");
#endif
  /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); */
  for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){
    Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
  }
#if ET_ENABLE_OBJ
  for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){
    Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
  }
#endif
  Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
#if ET_HAVE_APPINIT
  if( Et_AppInit(interp) == TCL_ERROR ){
    goto initerr;
  }
#endif
#if ET_CONSOLE
  Tcl_Eval(interp,zEtConsole);
#endif
#ifdef ET_MAIN_SCRIPT
  if( Et_EvalF(interp,"source \"%q\"", ET_MAIN_SCRIPT)!=TCL_OK ){
    goto initerr;
  }
#endif
  return TCL_OK;

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


#if ET_READ_STDIN==0 || ET_AUTO_FORK!=0
/*
** Initialize everything.
*/
static int Et_Local_Init(int argc, char **argv){
  Tcl_Interp *interp;
  char *args;
  char buf[100];
#if !ET_HAVE_CUSTOM_MAINLOOP
  static char zWaitForever[] = 
#if ET_ENABLE_TK
    "bind . <Destroy> {if {![winfo exists .]} exit}\n"
#endif
    "while 1 {vwait forever}";
#endif

  Tcl_FindExecutable(argv[0]);
  interp = Tcl_CreateInterp();
  args = Tcl_Merge(argc-1, argv+1);
  Nlv_CopyArgs( argc, argv ); 
  Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  ckfree(args);
  sprintf(buf, "%d", argc-1);
  Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
  Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
  Et_DoInit(interp);
#if ET_HAVE_CUSTOM_MAINLOOP
  Et_CustomMainLoop(interp);
#else
  Tcl_Eval(interp,zWaitForever);
#endif
  return 0;
}
#endif

/*
** This routine is called to do the complete initialization.
*/
int Et_Init(int argc, char **argv){
#ifdef ET_TCL_LIBRARY
  putenv("TCL_LIBRARY=" ET_TCL_LIBRARY);
#endif
#ifdef ET_TK_LIBRARY
  putenv("TK_LIBRARY=" ET_TK_LIBRARY);
#endif
#if ET_CONSOLE || !ET_READ_STDIN
  Et_Local_Init(argc, argv);
#else
# if ET_ENABLE_TK
  Tk_Main(argc,argv,Et_DoInit);
# else
  Tcl_Main(argc, argv, Et_DoInit);
# endif
#endif
  return 0;
}

#if !ET_HAVE_MAIN
/*
** Main routine for UNIX programs.  If the user has supplied
** their own main() routine in a C module, then the ET_HAVE_MAIN
** macro will be set to 1 and this code will be skipped.
*/
int main(int argc, char **argv){
#if ET_AUTO_FORK
  int rc = fork();
  if( rc<0 ){
    perror("can't fork");
    exit(1);
  }
  if( rc>0 ) return 0;
  close(0);
  open("/dev/null",O_RDONLY);
  close(1);
  open("/dev/null",O_WRONLY);
#endif
  return Et_Init(argc,argv)!=TCL_OK;
}
#endif
