static const char code[] = "\n\
if {[info commands package] == \"\"} {\n\
error \"version mismatch: library\\nscripts expect Tcl version 7.5b1 or later but the loaded version is\\nonly [info patchlevel]\"\n\
}\n\
package require -exact Tcl 8.0\n\
\n\
\n\
if {![info exists auto_path]} {\n\
if [catch {set auto_path $env(TCLLIBPATH)}] {\n\
set auto_path \"\"\n\
}\n\
}\n\
if {[lsearch -exact $auto_path [info library]] < 0} {\n\
lappend auto_path [info library]\n\
}\n\
catch {\n\
foreach __dir $tcl_pkgPath {\n\
if {[lsearch -exact $auto_path $__dir] < 0} {\n\
lappend auto_path $__dir\n\
}\n\
}\n\
unset __dir\n\
}\n\
\n\
\n\
package unknown tclPkgUnknown\n\
\n\
\n\
if {[info commands exec] == \"\"} {\n\
\n\
\n\
set auto_noexec 1\n\
}\n\
set errorCode \"\"\n\
set errorInfo \"\"\n\
\n\
\n\
if {[info commands tclLog] == \"\"} {\n\
proc tclLog {string} {\n\
catch {puts stderr $string}\n\
}\n\
}\n\
\n\
\n\
\n\
\n\
proc unknown args {\n\
global auto_noexec auto_noload env unknown_pending tcl_interactive\n\
global errorCode errorInfo\n\
\n\
\n\
set savedErrorCode $errorCode\n\
set savedErrorInfo $errorInfo\n\
set name [lindex $args 0]\n\
if ![info exists auto_noload] {\n\
if [info exists unknown_pending($name)] {\n\
return -code error \"self-referential recursion in \\\"unknown\\\" for command \\\"$name\\\"\";\n\
}\n\
set unknown_pending($name) pending;\n\
set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]\n\
unset unknown_pending($name);\n\
if {$ret != 0} {\n\
return -code $ret -errorcode $errorCode \\\n\
\"error while autoloading \\\"$name\\\": $msg\"\n\
}\n\
if ![array size unknown_pending] {\n\
unset unknown_pending\n\
}\n\
if $msg {\n\
set errorCode $savedErrorCode\n\
set errorInfo $savedErrorInfo\n\
set code [catch {uplevel 1 $args} msg]\n\
if {$code ==  1} {\n\
\n\
set new [split $errorInfo \\n]\n\
set new [join [lrange $new 0 [expr [llength $new] - 6]] \\n]\n\
return -code error -errorcode $errorCode \\\n\
-errorinfo $new $msg\n\
} else {\n\
return -code $code $msg\n\
}\n\
}\n\
}\n\
\n\
if {([info level] == 1) && ([info script] == \"\") \\\n\
&& [info exists tcl_interactive] && $tcl_interactive} {\n\
if ![info exists auto_noexec] {\n\
set new [auto_execok $name]\n\
if {$new != \"\"} {\n\
set errorCode $savedErrorCode\n\
set errorInfo $savedErrorInfo\n\
set redir \"\"\n\
if {[info commands console] == \"\"} {\n\
set redir \">&@stdout <@stdin\"\n\
}\n\
return [uplevel exec $redir $new [lrange $args 1 end]]\n\
}\n\
}\n\
set errorCode $savedErrorCode\n\
set errorInfo $savedErrorInfo\n\
if {$name == \"!!\"} {\n\
set newcmd [history event]\n\
} elseif {[regexp {^!(.+)$} $name dummy event]} {\n\
set newcmd [history event $event]\n\
} elseif {[regexp {^\\^([^^]*)\\^([^^]*)\\^?$} $name dummy old new]} {\n\
set newcmd [history event -1]\n\
catch {regsub -all -- $old $newcmd $new newcmd}\n\
}\n\
if [info exists newcmd] {\n\
tclLog $newcmd\n\
history change $newcmd 0\n\
return [uplevel $newcmd]\n\
}\n\
\n\
set ret [catch {set cmds [info commands $name*]} msg]\n\
if {[string compare $name \"::\"] == 0} {\n\
set name \"\"\n\
}\n\
if {$ret != 0} {\n\
return -code $ret -errorcode $errorCode \\\n\
\"error in unknown while checking if \\\"$name\\\" is a unique command abbreviation: $msg\"\n\
}\n\
if {[llength $cmds] == 1} {\n\
return [uplevel [lreplace $args 0 0 $cmds]]\n\
}\n\
if {[llength $cmds] != 0} {\n\
if {$name == \"\"} {\n\
return -code error \"empty command name \\\"\\\"\"\n\
} else {\n\
return -code error \\\n\
\"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n\
}\n\
}\n\
}\n\
return -code error \"invalid command name \\\"$name\\\"\"\n\
}\n\
\n\
\n\
proc auto_load {cmd {namespace {}}} {\n\
global auto_index auto_oldpath auto_path env errorInfo errorCode\n\
\n\
if {[string length $namespace] == 0} {\n\
set namespace [uplevel {namespace current}]\n\
}\n\
set nameList [auto_qualify $cmd $namespace]\n\
lappend nameList $cmd\n\
foreach name $nameList {\n\
if [info exists auto_index($name)] {\n\
uplevel #0 $auto_index($name)\n\
return [expr {[info commands $name] != \"\"}]\n\
}\n\
}\n\
if ![info exists auto_path] {\n\
return 0\n\
}\n\
if [info exists auto_oldpath] {\n\
if {$auto_oldpath == $auto_path} {\n\
return 0\n\
}\n\
}\n\
set auto_oldpath $auto_path\n\
\n\
\n\
set issafe [interp issafe]\n\
for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {\n\
set dir [lindex $auto_path $i]\n\
set f \"\"\n\
if {$issafe} {\n\
catch {source [file join $dir tclIndex]}\n\
} elseif [catch {set f [open [file join $dir tclIndex]]}] {\n\
continue\n\
} else {\n\
set error [catch {\n\
set id [gets $f]\n\
if {$id == \"# Tcl autoload index file, version 2.0\"} {\n\
eval [read $f]\n\
} elseif {$id == \\\n\
\"# Tcl autoload index file: each line identifies a Tcl\"} {\n\
while {[gets $f line] >= 0} {\n\
if {([string index $line 0] == \"#\")\n\
|| ([llength $line] != 2)} {\n\
continue\n\
}\n\
set name [lindex $line 0]\n\
set auto_index($name) \\\n\
\"source [file join $dir [lindex $line 1]]\"\n\
}\n\
} else {\n\
error \\\n\
\"[file join $dir tclIndex] isn't a proper Tcl index file\"\n\
}\n\
} msg]\n\
if {$f != \"\"} {\n\
close $f\n\
}\n\
if $error {\n\
error $msg $errorInfo $errorCode\n\
}\n\
}\n\
}\n\
foreach name $nameList {\n\
if [info exists auto_index($name)] {\n\
uplevel #0 $auto_index($name)\n\
if {[info commands $name] != \"\"} {\n\
return 1\n\
}\n\
}\n\
}\n\
return 0\n\
}\n\
\n\
\n\
proc auto_qualify {cmd namespace} {\n\
\n\
set n [regsub -all {::+} $cmd :: cmd]\n\
\n\
\n\
\n\
if {[regexp {^::(.*)$} $cmd x tail]} {\n\
if {$n > 1} {\n\
return [list $cmd]\n\
} else {\n\
return [list $tail]\n\
}\n\
}\n\
\n\
\n\
if {$n == 0} {\n\
if {[string compare $namespace ::] == 0} {\n\
return [list $cmd]\n\
} else {\n\
return [list ${namespace}::$cmd $cmd]\n\
}\n\
} else {\n\
if {[string compare $namespace ::] == 0} {\n\
return [list ::$cmd]\n\
} else {\n\
return [list ${namespace}::$cmd ::$cmd]\n\
}\n\
}\n\
}\n\
\n\
if {[string compare $tcl_platform(platform) windows] == 0} {\n\
\n\
\n\
proc auto_execok name {\n\
global auto_execs env tcl_platform\n\
\n\
if [info exists auto_execs($name)] {\n\
return $auto_execs($name)\n\
}\n\
set auto_execs($name) \"\"\n\
\n\
if {[lsearch -exact {cls copy date del erase dir echo mkdir md rename \n\
ren rmdir rd time type ver vol} $name] != -1} {\n\
return [set auto_execs($name) [list $env(COMSPEC) /c $name]]\n\
}\n\
\n\
if {[llength [file split $name]] != 1} {\n\
foreach ext {{} .com .exe .bat} {\n\
set file ${name}${ext}\n\
if {[file exists $file] && ![file isdirectory $file]} {\n\
return [set auto_execs($name) [list $file]]\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
set path \"[file dirname [info nameof]];.;\"\n\
if {[info exists env(WINDIR)]} {\n\
set windir $env(WINDIR) \n\
}\n\
if {[info exists windir]} {\n\
if {$tcl_platform(os) == \"Windows NT\"} {\n\
append path \"$windir/system32;\"\n\
}\n\
append path \"$windir/system;$windir;\"\n\
}\n\
\n\
if {[info exists env(PATH)]} {\n\
append path $env(PATH)\n\
}\n\
\n\
foreach dir [split $path {;}] {\n\
if {$dir == \"\"} {\n\
set dir .\n\
}\n\
foreach ext {{} .com .exe .bat} {\n\
set file [file join $dir ${name}${ext}]\n\
if {[file exists $file] && ![file isdirectory $file]} {\n\
return [set auto_execs($name) [list $file]]\n\
}\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
} else {\n\
\n\
\n\
proc auto_execok name {\n\
global auto_execs env\n\
\n\
if [info exists auto_execs($name)] {\n\
return $auto_execs($name)\n\
}\n\
set auto_execs($name) \"\"\n\
if {[llength [file split $name]] != 1} {\n\
if {[file executable $name] && ![file isdirectory $name]} {\n\
set auto_execs($name) [list $name]\n\
}\n\
return $auto_execs($name)\n\
}\n\
foreach dir [split $env(PATH) :] {\n\
if {$dir == \"\"} {\n\
set dir .\n\
}\n\
set file [file join $dir $name]\n\
if {[file executable $file] && ![file isdirectory $file]} {\n\
set auto_execs($name) [list $file]\n\
return $auto_execs($name)\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
}\n\
\n\
proc auto_reset {} {\n\
global auto_execs auto_index auto_oldpath\n\
foreach p [info procs] {\n\
if {[info exists auto_index($p)] && ![string match auto_* $p]\n\
&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup\n\
tclMacPkgSearch tclPkgUnknown} $p] < 0)} {\n\
rename $p {}\n\
}\n\
}\n\
catch {unset auto_execs}\n\
catch {unset auto_index}\n\
catch {unset auto_oldpath}\n\
}\n\
\n\
\n\
proc auto_mkindex {dir args} {\n\
global errorCode errorInfo\n\
set oldDir [pwd]\n\
cd $dir\n\
set dir [pwd]\n\
append index \"# Tcl autoload index file, version 2.0\\n\"\n\
append index \"# This file is generated by the \\\"auto_mkindex\\\" command\\n\"\n\
append index \"# and sourced to set up indexing information for one or\\n\"\n\
append index \"# more commands.  Typically each line is a command that\\n\"\n\
append index \"# sets an element in the auto_index array, where the\\n\"\n\
append index \"# element name is the name of a command and the value is\\n\"\n\
append index \"# a script that loads the command.\\n\\n\"\n\
if {$args == \"\"} {\n\
set args *.tcl\n\
}\n\
foreach file [eval glob $args] {\n\
set f \"\"\n\
set error [catch {\n\
set f [open $file]\n\
while {[gets $f line] >= 0} {\n\
if [regexp {^proc[ 	]+([^ 	]*)} $line match procName] {\n\
set procName [lindex [auto_qualify $procName \"::\"] 0]\n\
append index \"set [list auto_index($procName)]\"\n\
append index \" \\[list source \\[file join \\$dir [list $file]\\]\\]\\n\"\n\
}\n\
}\n\
close $f\n\
} msg]\n\
if $error {\n\
set code $errorCode\n\
set info $errorInfo\n\
catch {close $f}\n\
cd $oldDir\n\
error $msg $info $code\n\
}\n\
}\n\
set f \"\"\n\
set error [catch {\n\
set f [open tclIndex w]\n\
puts $f $index nonewline\n\
close $f\n\
cd $oldDir\n\
} msg]\n\
if $error {\n\
set code $errorCode\n\
set info $errorInfo\n\
catch {close $f}\n\
cd $oldDir\n\
error $msg $info $code\n\
}\n\
}\n\
\n\
\n\
proc pkg_mkIndex {dir args} {\n\
global errorCode errorInfo\n\
if {[llength $args] == 0} {\n\
return -code error \"wrong # args: should be\\\n\
\\\"pkg_mkIndex dir pattern ?pattern ...?\\\"\";\n\
}\n\
append index \"# Tcl package index file, version 1.0\\n\"\n\
append index \"# This file is generated by the \\\"pkg_mkIndex\\\" command\\n\"\n\
append index \"# and sourced either when an application starts up or\\n\"\n\
append index \"# by a \\\"package unknown\\\" script.  It invokes the\\n\"\n\
append index \"# \\\"package ifneeded\\\" command to set up package-related\\n\"\n\
append index \"# information so that packages will be loaded automatically\\n\"\n\
append index \"# in response to \\\"package require\\\" commands.  When this\\n\"\n\
append index \"# script is sourced, the variable \\$dir must contain the\\n\"\n\
append index \"# full path name of this file's directory.\\n\"\n\
set oldDir [pwd]\n\
cd $dir\n\
foreach file [eval glob $args] {\n\
\n\
set c [interp create]\n\
\n\
\n\
foreach pkg [info loaded] {\n\
if {[lindex $pkg 1] == \"Tk\"} {\n\
$c eval {set argv {-geometry +0+0}}\n\
load [lindex $pkg 0] Tk $c\n\
break\n\
}\n\
}\n\
$c eval [list set file $file]\n\
if [catch {\n\
$c eval {\n\
proc dummy args {}\n\
rename package package-orig\n\
proc package {what args} {\n\
switch -- $what {\n\
require { return ; # ignore transitive requires }\n\
default { eval package-orig {$what} $args }\n\
}\n\
}\n\
proc pkgGetAllNamespaces {{root {}}} {\n\
set list $root\n\
foreach ns [namespace children $root] {\n\
eval lappend list [pkgGetAllNamespaces $ns]\n\
}\n\
return $list\n\
}\n\
package unknown dummy\n\
set origCmds [info commands]\n\
set dir \"\"		;# in case file is pkgIndex.tcl\n\
set pkgs \"\"\n\
\n\
\n\
if {[string compare [file extension $file] \\\n\
[info sharedlibextension]] == 0} {\n\
\n\
\n\
load [file join . $file]\n\
set type load\n\
} else {\n\
set type source\n\
}\n\
foreach ns [pkgGetAllNamespaces] {\n\
namespace import ${ns}::*\n\
}\n\
foreach i [info commands] {\n\
set cmds($i) 1\n\
}\n\
foreach i $origCmds {\n\
catch {unset cmds($i)}\n\
\n\
}\n\
foreach i [array names cmds] {\n\
set absolute [namespace origin $i]\n\
if {[string compare ::$i $absolute] != 0} {\n\
set cmds($absolute) 1\n\
unset cmds($i)\n\
}\n\
}\n\
foreach i [package names] {\n\
if {([string compare [package provide $i] \"\"] != 0)\n\
&& ([string compare $i Tcl] != 0)\n\
&& ([string compare $i Tk] != 0)} {\n\
lappend pkgs [list $i [package provide $i]]\n\
}\n\
}\n\
}\n\
} msg] {\n\
tclLog \"error while loading or sourcing $file: $msg\"\n\
}\n\
foreach pkg [$c eval set pkgs] {\n\
lappend files($pkg) [list $file [$c eval set type] \\\n\
[lsort [$c eval array names cmds]]]\n\
}\n\
interp delete $c\n\
}\n\
foreach pkg [lsort [array names files]] {\n\
append index \"\\npackage ifneeded $pkg\\\n\
\\[list tclPkgSetup \\$dir [lrange $pkg 0 0] [lrange $pkg 1 1]\\\n\
[list $files($pkg)]\\]\"\n\
}\n\
set f [open pkgIndex.tcl w]\n\
puts $f $index\n\
close $f\n\
cd $oldDir\n\
}\n\
\n\
\n\
proc tclPkgSetup {dir pkg version files} {\n\
global auto_index\n\
\n\
package provide $pkg $version\n\
foreach fileInfo $files {\n\
set f [lindex $fileInfo 0]\n\
set type [lindex $fileInfo 1]\n\
foreach cmd [lindex $fileInfo 2] {\n\
if {$type == \"load\"} {\n\
set auto_index($cmd) [list load [file join $dir $f] $pkg]\n\
} else {\n\
set auto_index($cmd) [list source [file join $dir $f]]\n\
} \n\
}\n\
}\n\
}\n\
\n\
\n\
proc tclMacPkgSearch {dir} {\n\
foreach x [glob -nocomplain [file join $dir *.shlb]] {\n\
if [file isfile $x] {\n\
set res [resource open $x]\n\
foreach y [resource list TEXT $res] {\n\
if {$y == \"pkgIndex\"} {source -rsrc pkgIndex}\n\
}\n\
catch {resource close $res}\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tclPkgUnknown {name version {exact {}}} {\n\
global auto_path tcl_platform env\n\
\n\
if ![info exists auto_path] {\n\
return\n\
}\n\
for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {\n\
catch {\n\
foreach file [glob -nocomplain [file join [lindex $auto_path $i] \\\n\
* pkgIndex.tcl]] {\n\
set dir [file dirname $file]\n\
if [catch {source $file} msg] {\n\
tclLog \"error reading package index file $file: $msg\"\n\
}\n\
}\n\
}\n\
set dir [lindex $auto_path $i]\n\
set file [file join $dir pkgIndex.tcl]\n\
if {[interp issafe] || [file readable $file]} {\n\
if {[catch {source $file} msg] && ![interp issafe]}  {\n\
tclLog \"error reading package index file $file: $msg\"\n\
}\n\
}\n\
if {(![interp issafe]) && ($tcl_platform(platform) == \"macintosh\")} {\n\
set dir [lindex $auto_path $i]\n\
tclMacPkgSearch $dir\n\
foreach x [glob -nocomplain [file join $dir *]] {\n\
if [file isdirectory $x] {\n\
set dir $x\n\
tclMacPkgSearch $dir\n\
}\n\
}\n\
}\n\
}\n\
}\n\
\n\
\n\
namespace eval tcl {\n\
variable history\n\
if ![info exists history] {\n\
array set history {\n\
nextid	0\n\
keep	20\n\
oldest	-20\n\
}\n\
}\n\
}\n\
\n\
\n\
proc history {args} {\n\
set len [llength $args]\n\
if {$len == 0} {\n\
return [tcl::HistInfo]\n\
}\n\
set key [lindex $args 0]\n\
set options \"add, change, clear, event, info, keep, nextid, or redo\"\n\
switch -glob -- $key {\n\
a* { # history add\n\
\n\
if {$len > 3} {\n\
return -code error \"wrong # args: should be \\\"history add event ?exec?\\\"\"\n\
}\n\
if {![string match $key* add]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
if {$len == 3} {\n\
set arg [lindex $args 2]\n\
if {! ([string match e* $arg] && [string match $arg* exec])} {\n\
return -code error \"bad argument \\\"$arg\\\": should be \\\"exec\\\"\"\n\
}\n\
}\n\
return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]\n\
}\n\
ch* { # history change\n\
\n\
if {($len > 3) || ($len < 2)} {\n\
return -code error \"wrong # args: should be \\\"history change newValue ?event?\\\"\"\n\
}\n\
if {![string match $key* change]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
if {$len == 2} {\n\
set event 0\n\
} else {\n\
set event [lindex $args 2]\n\
}\n\
\n\
return [tcl::HistChange [lindex $args 1] $event]\n\
}\n\
cl* { # history clear\n\
\n\
if {($len > 1)} {\n\
return -code error \"wrong # args: should be \\\"history clear\\\"\"\n\
}\n\
if {![string match $key* clear]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [tcl::HistClear]\n\
}\n\
e* { # history event\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history event ?event?\\\"\"\n\
}\n\
if {![string match $key* event]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
if {$len == 1} {\n\
set event -1\n\
} else {\n\
set event [lindex $args 1]\n\
}\n\
return [tcl::HistEvent $event]\n\
}\n\
i* { # history info\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history info ?count?\\\"\"\n\
}\n\
if {![string match $key* info]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [tcl::HistInfo [lindex $args 1]]\n\
}\n\
k* { # history keep\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history keep ?count?\\\"\"\n\
}\n\
if {$len == 1} {\n\
return [tcl::HistKeep]\n\
} else {\n\
set limit [lindex $args 1]\n\
if {[catch {expr $limit}] || ($limit < 0)} {\n\
return -code error \"illegal keep count \\\"$limit\\\"\"\n\
}\n\
return [tcl::HistKeep $limit]\n\
}\n\
}\n\
n* { # history nextid\n\
\n\
if {$len > 1} {\n\
return -code error \"wrong # args: should be \\\"history nextid\\\"\"\n\
}\n\
if {![string match $key* nextid]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [expr $tcl::history(nextid) + 1]\n\
}\n\
r* { # history redo\n\
\n\
if {$len > 2} {\n\
return -code error \"wrong # args: should be \\\"history redo ?event?\\\"\"\n\
}\n\
if {![string match $key* redo]} {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
return [tcl::HistRedo [lindex $args 1]]\n\
}\n\
default {\n\
return -code error \"bad option \\\"$key\\\": must be $options\"\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistAdd {command {exec {}}} {\n\
variable history\n\
set i [incr history(nextid)]\n\
set history($i) $command\n\
set j [incr history(oldest)]\n\
if {[info exists history($j)]} {unset history($j)}\n\
if {[string match e* $exec]} {\n\
return [uplevel #0 $command]\n\
} else {\n\
return {}\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistKeep {{limit {}}} {\n\
variable history\n\
if {[string length $limit] == 0} {\n\
return $history(keep)\n\
} else {\n\
set oldold $history(oldest)\n\
set history(oldest) [expr $history(nextid) - $limit]\n\
for {} {$oldold <= $history(oldest)} {incr oldold} {\n\
if {[info exists history($oldold)]} {unset history($oldold)}\n\
}\n\
set history(keep) $limit\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistClear {} {\n\
variable history\n\
set keep $history(keep)\n\
unset history\n\
array set history [list \\\n\
nextid	0	\\\n\
keep	$keep	\\\n\
oldest	-$keep	\\\n\
]\n\
}\n\
\n\
\n\
proc tcl::HistInfo {{num {}}} {\n\
variable history\n\
if {$num == {}} {\n\
set num [expr $history(keep) + 1]\n\
}\n\
set result {}\n\
set newline \"\"\n\
for {set i [expr $history(nextid) - $num + 1]} \\\n\
{$i <= $history(nextid)} {incr i} {\n\
if ![info exists history($i)] {\n\
continue\n\
}\n\
set cmd [string trimright $history($i) \\ \\n]\n\
regsub -all \\n $cmd \"\\n\\t\" cmd\n\
append result $newline[format \"%6d  %s\" $i $cmd]\n\
set newline \\n\n\
}\n\
return $result\n\
}\n\
\n\
\n\
proc tcl::HistRedo {{event -1}} {\n\
variable history\n\
if {[string length $event] == 0} {\n\
set event -1\n\
}\n\
set i [HistIndex $event]\n\
if {$i == $history(nextid)} {\n\
return -code error \"cannot redo the current event\"\n\
}\n\
set cmd $history($i)\n\
HistChange $cmd 0\n\
uplevel #0 $cmd\n\
}\n\
\n\
\n\
proc tcl::HistIndex {event} {\n\
variable history\n\
if {[catch {expr $event}]} {\n\
for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {\n\
if {[string match $event* $history($i)]} {\n\
return $i;\n\
}\n\
if {[string match $event $history($i)]} {\n\
return $i;\n\
}\n\
}\n\
return -code error \"no event matches \\\"$event\\\"\"\n\
} elseif {$event <= 0} {\n\
set i [expr $history(nextid) + $event]\n\
} else {\n\
set i $event\n\
}\n\
if {$i <= $history(oldest)} {\n\
return -code error \"event \\\"$event\\\" is too far in the past\"\n\
}\n\
if {$i > $history(nextid)} {\n\
return -code error \"event \\\"$event\\\" hasn't occured yet\"\n\
}\n\
return $i\n\
}\n\
\n\
\n\
proc tcl::HistEvent {event} {\n\
variable history\n\
set i [HistIndex $event]\n\
if {[info exists history($i)]} {\n\
return [string trimright $history($i) \\ \\n]\n\
} else {\n\
return \"\";\n\
}\n\
}\n\
\n\
\n\
proc tcl::HistChange {cmd {event 0}} {\n\
variable history\n\
set i [HistIndex $event]\n\
set history($i) $cmd\n\
}\n\
\n\
\n\
if {$tcl_platform(platform) == \"windows\"} {\n\
set tcl_wordchars \"\\[^ \\t\\n\\]\"\n\
set tcl_nonwordchars \"\\[ \\t\\n\\]\"\n\
} else {\n\
set tcl_wordchars {[a-zA-Z0-9_]}\n\
set tcl_nonwordchars {[^a-zA-Z0-9_]}\n\
}\n\
\n\
\n\
proc tcl_wordBreakAfter {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
set str [string range $str $start end]\n\
if [regexp -indices \"$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars\" $str result] {\n\
return [expr [lindex $result 1] + $start]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_wordBreakBefore {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if {[string compare $start end] == 0} {\n\
set start [string length $str]\n\
}\n\
if [regexp -indices \"^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)\" [string range $str 0 $start] result] {\n\
return [lindex $result 1]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_endOfWord {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if [regexp -indices \"$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars\" \\\n\
[string range $str $start end] result] {\n\
return [expr [lindex $result 1] + $start]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_startOfNextWord {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if [regexp -indices \"$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars\" \\\n\
[string range $str $start end] result] {\n\
return [expr [lindex $result 1] + $start]\n\
}\n\
return -1\n\
}\n\
\n\
\n\
proc tcl_startOfPreviousWord {str start} {\n\
global tcl_nonwordchars tcl_wordchars\n\
if {[string compare $start end] == 0} {\n\
set start [string length $str]\n\
}\n\
if [regexp -indices \\\n\
\"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\\$\" \\\n\
[string range $str 0 [expr $start - 1]] result word] {\n\
return [lindex $word 0]\n\
}\n\
return -1\n\
}\n\
\n\
package provide http 2.0	;# This uses Tcl namespaces\n\
\n\
namespace eval http {\n\
variable http\n\
\n\
array set http {\n\
-accept */*\n\
-proxyhost {}\n\
-proxyport {}\n\
-useragent {Tcl http client package 2.0}\n\
-proxyfilter http::ProxyRequired\n\
}\n\
\n\
variable formMap\n\
set alphanumeric	a-zA-Z0-9\n\
\n\
for {set i 1} {$i <= 256} {incr i} {\n\
set c [format %c $i]\n\
if {![string match \\[$alphanumeric\\] $c]} {\n\
set formMap($c) %[format %.2x $i]\n\
}\n\
}\n\
array set formMap {\n\
\" \" +   \\n %0d%0a\n\
}\n\
\n\
namespace export geturl config reset wait formatQuery \n\
}\n\
\n\
\n\
proc http::config {args} {\n\
variable http\n\
set options [lsort [array names http -*]]\n\
set usage [join $options \", \"]\n\
if {[llength $args] == 0} {\n\
set result {}\n\
foreach name $options {\n\
lappend result $name $http($name)\n\
}\n\
return $result\n\
}\n\
regsub -all -- - $options {} options\n\
set pat ^-([join $options |])$\n\
if {[llength $args] == 1} {\n\
set flag [lindex $args 0]\n\
if {[regexp -- $pat $flag]} {\n\
return $http($flag)\n\
} else {\n\
return -code error \"Unknown option $flag, must be: $usage\"\n\
}\n\
} else {\n\
foreach {flag value} $args {\n\
if [regexp -- $pat $flag] {\n\
set http($flag) $value\n\
} else {\n\
return -code error \"Unknown option $flag, must be: $usage\"\n\
}\n\
}\n\
}\n\
}\n\
\n\
proc http::Finish { token {errormsg \"\"} } {\n\
variable $token\n\
upvar 0 $token state\n\
global errorInfo errorCode\n\
if {[string length $errormsg] != 0} {\n\
set state(error) [list $errormsg $errorInfo $errorCode]\n\
set state(status) error\n\
}\n\
catch {close $state(sock)}\n\
catch {after cancel $state(after)}\n\
if {[info exists state(-command)]} {\n\
if {[catch {eval $state(-command) {$token}} err]} {\n\
if {[string length $errormsg] == 0} {\n\
set state(error) [list $err $errorInfo $errorCode]\n\
set state(status) error\n\
}\n\
}\n\
unset state(-command)\n\
}\n\
}\n\
\n\
\n\
proc http::reset { token {why reset} } {\n\
variable $token\n\
upvar 0 $token state\n\
set state(status) $why\n\
catch {fileevent $state(sock) readable {}}\n\
Finish $token\n\
if {[info exists state(error)]} {\n\
set errorlist $state(error)\n\
unset state(error)\n\
eval error $errorlist\n\
}\n\
}\n\
\n\
\n\
\n\
proc http::geturl { url args } {\n\
variable http\n\
if ![info exists http(uid)] {\n\
set http(uid) 0\n\
}\n\
set token [namespace current]::[incr http(uid)]\n\
variable $token\n\
upvar 0 $token state\n\
reset $token\n\
array set state {\n\
-blocksize 	8192\n\
-validate 	0\n\
-headers 	{}\n\
-timeout 	0\n\
state		header\n\
meta		{}\n\
currentsize	0\n\
totalsize	0\n\
type            text/html\n\
body            {}\n\
status		\"\"\n\
}\n\
set options {-blocksize -channel -command -handler -headers \\\n\
-progress -query -validate -timeout}\n\
set usage [join $options \", \"]\n\
regsub -all -- - $options {} options\n\
set pat ^-([join $options |])$\n\
foreach {flag value} $args {\n\
if [regexp $pat $flag] {\n\
if {[info exists state($flag)] && \\\n\
[regexp {^[0-9]+$} $state($flag)] && \\\n\
![regexp {^[0-9]+$} $value]} {\n\
return -code error \"Bad value for $flag ($value), must be integer\"\n\
}\n\
set state($flag) $value\n\
} else {\n\
return -code error \"Unknown option $flag, can be: $usage\"\n\
}\n\
}\n\
if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \\\n\
x proto host y port srvurl]} {\n\
error \"Unsupported URL: $url\"\n\
}\n\
if {[string length $port] == 0} {\n\
set port 80\n\
}\n\
if {[string length $srvurl] == 0} {\n\
set srvurl /\n\
}\n\
if {[string length $proto] == 0} {\n\
set url http://$url\n\
}\n\
set state(url) $url\n\
if {![catch {$http(-proxyfilter) $host} proxy]} {\n\
set phost [lindex $proxy 0]\n\
set pport [lindex $proxy 1]\n\
}\n\
if {$state(-timeout) > 0} {\n\
set state(after) [after $state(-timeout) [list http::reset $token timeout]]\n\
}\n\
if {[info exists phost] && [string length $phost]} {\n\
set srvurl $url\n\
set s [socket $phost $pport]\n\
} else {\n\
set s [socket $host $port]\n\
}\n\
set state(sock) $s\n\
\n\
\n\
fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)\n\
\n\
\n\
catch {fconfigure $s -blocking off}\n\
set len 0\n\
set how GET\n\
if {[info exists state(-query)]} {\n\
set len [string length $state(-query)]\n\
if {$len > 0} {\n\
set how POST\n\
}\n\
} elseif {$state(-validate)} {\n\
set how HEAD\n\
}\n\
puts $s \"$how $srvurl HTTP/1.0\"\n\
puts $s \"Accept: $http(-accept)\"\n\
puts $s \"Host: $host\"\n\
puts $s \"User-Agent: $http(-useragent)\"\n\
foreach {key value} $state(-headers) {\n\
regsub -all \\[\\n\\r\\]  $value {} value\n\
set key [string trim $key]\n\
if {[string length $key]} {\n\
puts $s \"$key: $value\"\n\
}\n\
}\n\
if {$len > 0} {\n\
puts $s \"Content-Length: $len\"\n\
puts $s \"Content-Type: application/x-www-form-urlencoded\"\n\
puts $s \"\"\n\
fconfigure $s -translation {auto binary}\n\
puts $s $state(-query)\n\
} else {\n\
puts $s \"\"\n\
}\n\
flush $s\n\
fileevent $s readable [list http::Event $token]\n\
if {! [info exists state(-command)]} {\n\
wait $token\n\
}\n\
return $token\n\
}\n\
\n\
\n\
proc http::data {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(body)\n\
}\n\
proc http::status {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(status)\n\
}\n\
proc http::code {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(http)\n\
}\n\
proc http::size {token} {\n\
variable $token\n\
upvar 0 $token state\n\
return $state(currentsize)\n\
}\n\
\n\
proc http::Event {token} {\n\
variable $token\n\
upvar 0 $token state\n\
set s $state(sock)\n\
\n\
if [::eof $s] then {\n\
Eof $token\n\
return\n\
}\n\
if {$state(state) == \"header\"} {\n\
set n [gets $s line]\n\
if {$n == 0} {\n\
set state(state) body\n\
if ![regexp -nocase ^text $state(type)] {\n\
fconfigure $s -translation binary\n\
if {[info exists state(-channel)]} {\n\
fconfigure $state(-channel) -translation binary\n\
}\n\
}\n\
if {[info exists state(-channel)] &&\n\
![info exists state(-handler)]} {\n\
fileevent $s readable {}\n\
CopyStart $s $token\n\
}\n\
} elseif {$n > 0} {\n\
if [regexp -nocase {^content-type:(.+)$} $line x type] {\n\
set state(type) [string trim $type]\n\
}\n\
if [regexp -nocase {^content-length:(.+)$} $line x length] {\n\
set state(totalsize) [string trim $length]\n\
}\n\
if [regexp -nocase {^([^:]+):(.+)$} $line x key value] {\n\
lappend state(meta) $key $value\n\
} elseif {[regexp ^HTTP $line]} {\n\
set state(http) $line\n\
}\n\
}\n\
} else {\n\
if [catch {\n\
if {[info exists state(-handler)]} {\n\
set n [eval $state(-handler) {$s $token}]\n\
} else {\n\
set block [read $s $state(-blocksize)]\n\
set n [string length $block]\n\
if {$n >= 0} {\n\
append state(body) $block\n\
}\n\
}\n\
if {$n >= 0} {\n\
incr state(currentsize) $n\n\
}\n\
} err] {\n\
Finish $token $err\n\
} else {\n\
if [info exists state(-progress)] {\n\
eval $state(-progress) {$token $state(totalsize) $state(currentsize)}\n\
}\n\
}\n\
}\n\
}\n\
proc http::CopyStart {s token} {\n\
variable $token\n\
upvar 0 $token state\n\
if [catch {\n\
fcopy $s $state(-channel) -size $state(-blocksize) -command \\\n\
[list http::CopyDone $token]\n\
} err] {\n\
Finish $token $err\n\
}\n\
}\n\
proc http::CopyDone {token count {error {}}} {\n\
variable $token\n\
upvar 0 $token state\n\
set s $state(sock)\n\
incr state(currentsize) $count\n\
if [info exists state(-progress)] {\n\
eval $state(-progress) {$token $state(totalsize) $state(currentsize)}\n\
}\n\
if {([string length $error] != 0)} {\n\
Finish $token $error\n\
} elseif {[::eof $s]} {\n\
Eof $token\n\
} else {\n\
CopyStart $s $token\n\
}\n\
}\n\
proc http::Eof {token} {\n\
variable $token\n\
upvar 0 $token state\n\
if {$state(state) == \"header\"} {\n\
set state(status) eof\n\
} else {\n\
set state(status) ok\n\
}\n\
set state(state) eof\n\
Finish $token\n\
}\n\
\n\
\n\
proc http::wait {token} {\n\
variable $token\n\
upvar 0 $token state\n\
\n\
if {![info exists state(status)] || [string length $state(status)] == 0} {\n\
vwait $token\\(status)\n\
}\n\
if {[info exists state(error)]} {\n\
set errorlist $state(error)\n\
unset state(error)\n\
eval error $errorlist\n\
}\n\
return $state(status)\n\
}\n\
\n\
\n\
proc http::formatQuery {args} {\n\
set result \"\"\n\
set sep \"\"\n\
foreach i $args {\n\
append result  $sep [mapReply $i]\n\
if {$sep != \"=\"} {\n\
set sep =\n\
} else {\n\
set sep &\n\
}\n\
}\n\
return $result\n\
}\n\
\n\
\n\
proc http::mapReply {string} {\n\
variable formMap\n\
set alphanumeric	a-zA-Z0-9\n\
regsub -all \\[^$alphanumeric\\] $string {$formMap(&)} string\n\
regsub -all \\n $string {\\\\n} string\n\
regsub -all \\t $string {\\\\t} string\n\
regsub -all {[][{})\\\\]\\)} $string {\\\\&} string\n\
return [subst $string]\n\
}\n\
\n\
proc http::ProxyRequired {host} {\n\
variable http\n\
if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {\n\
if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {\n\
set http(-proxyport) 8080\n\
}\n\
return [list $http(-proxyhost) $http(-proxyport)]\n\
} else {\n\
return {}\n\
}\n\
}\n\
\n\
\n\
package require -exact Tk 8.0\n\
package require -exact Tcl 8.0\n\
\n\
\n\
if {[info exists auto_path]} {\n\
if {[lsearch -exact $auto_path $tk_library] < 0} {\n\
lappend auto_path $tk_library\n\
}\n\
}\n\
\n\
\n\
set tk_strictMotif 0\n\
\n\
\n\
proc tkScreenChanged screen {\n\
set x [string last . $screen]\n\
if {$x > 0} {\n\
set disp [string range $screen 0 [expr $x - 1]]\n\
} else {\n\
set disp $screen\n\
}\n\
\n\
uplevel #0 upvar #0 tkPriv.$disp tkPriv\n\
global tkPriv\n\
global tcl_platform\n\
\n\
if [info exists tkPriv] {\n\
set tkPriv(screen) $screen\n\
return\n\
}\n\
set tkPriv(activeMenu) {}\n\
set tkPriv(activeItem) {}\n\
set tkPriv(afterId) {}\n\
set tkPriv(buttons) 0\n\
set tkPriv(buttonWindow) {}\n\
set tkPriv(dragging) 0\n\
set tkPriv(focus) {}\n\
set tkPriv(grab) {}\n\
set tkPriv(initPos) {}\n\
set tkPriv(inMenubutton) {}\n\
set tkPriv(listboxPrev) {}\n\
set tkPriv(menuBar) {}\n\
set tkPriv(mouseMoved) 0\n\
set tkPriv(oldGrab) {}\n\
set tkPriv(popup) {}\n\
set tkPriv(postedMb) {}\n\
set tkPriv(pressX) 0\n\
set tkPriv(pressY) 0\n\
set tkPriv(prevPos) 0\n\
set tkPriv(screen) $screen\n\
set tkPriv(selectMode) char\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\
\n\
\n\
tkScreenChanged [winfo screen .]\n\
\n\
\n\
proc tkEventMotifBindings {n1 dummy dummy} {\n\
upvar $n1 name\n\
\n\
if $name {\n\
set op delete\n\
} else {\n\
set op add\n\
}\n\
\n\
event $op <<Cut>> <Control-Key-w>\n\
event $op <<Copy>> <Meta-Key-w> \n\
event $op <<Paste>> <Control-Key-y>\n\
}\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\
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\
}\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 <<Clear>> <Clear>\n\
}\n\
}\n\
\n\
\n\
if {$tcl_platform(platform) != \"macintosh\"} {\n\
}\n\
\n\
\n\
bind all <Tab> {tkTabToWindow [tk_focusNext %W]}\n\
bind all <Shift-Tab> {tkTabToWindow [tk_focusPrev %W]}\n\
\n\
\n\
proc tkCancelRepeat {} {\n\
global tkPriv\n\
after cancel $tkPriv(afterId)\n\
set tkPriv(afterId) {}\n\
}\n\
\n\
\n\
proc tkTabToWindow {w} {\n\
if {\"[winfo class $w]\" == \"Entry\"} {\n\
$w select range 0 end\n\
$w icur end\n\
}\n\
focus $w\n\
}\n\
\n\
proc tkColorDialog {args} {\n\
global tkPriv\n\
set w .__tk__color\n\
upvar #0 $w data\n\
\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\
\n\
set data(NUM_COLORBARS) 8\n\
\n\
set data(BARS_WIDTH) 128\n\
\n\
set data(PLGN_HEIGHT) 10\n\
\n\
set data(PLGN_WIDTH) 10\n\
\n\
tkColorDialog_Config $w $args\n\
tkColorDialog_InitValues $w\n\
\n\
if ![winfo exists $w] {\n\
toplevel $w -class tkColorDialog\n\
tkColorDialog_BuildDialog $w\n\
}\n\
wm transient $w $data(-parent)\n\
\n\
\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\
wm title $w $data(-title)\n\
\n\
\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(okBtn)\n\
\n\
\n\
tkwait variable tkPriv(selectColor)\n\
catch {focus $oldFocus}\n\
grab release $w\n\
destroy $w\n\
unset data\n\
if {$oldGrab != \"\"} {\n\
if {$grabStatus == \"global\"} {\n\
grab -global $oldGrab\n\
} else {\n\
grab $oldGrab\n\
}\n\
}\n\
return $tkPriv(selectColor)\n\
}\n\
\n\
proc tkColorDialog_InitValues {w} {\n\
upvar #0 $w data\n\
\n\
set data(intensityIncr) [expr 256 / $data(NUM_COLORBARS)]\n\
\n\
set data(colorbarWidth) \\\n\
[expr $data(BARS_WIDTH) / $data(NUM_COLORBARS)]\n\
\n\
set data(indent) [expr $data(PLGN_WIDTH) / 2]\n\
\n\
set data(colorPad) 2\n\
set data(selPad)   [expr $data(PLGN_WIDTH) / 2]\n\
\n\
set data(minX) $data(indent)\n\
\n\
set data(maxX) [expr $data(BARS_WIDTH) + $data(indent)-1]\n\
\n\
set data(canvasWidth) [expr $data(BARS_WIDTH) + \\\n\
$data(PLGN_WIDTH)]\n\
\n\
set data(selection) $data(-initialcolor)\n\
set data(finalColor)  $data(-initialcolor)\n\
set rgb [winfo rgb . $data(selection)]\n\
\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\
\n\
proc tkColorDialog_Config {w argList} {\n\
global tkPriv\n\
upvar #0 $w data\n\
\n\
set specs {\n\
{-initialcolor \"\" \"\" \"\"}\n\
{-parent \"\" \"\" \".\"}\n\
{-title \"\" \"\" \"Color\"}\n\
}\n\
\n\
tclParseConfigSpec $w $specs \"\" $argList\n\
\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\
\n\
if ![winfo exists $data(-parent)] {\n\
error \"bad window path name \\\"$data(-parent)\\\"\"\n\
}\n\
}\n\
\n\
proc tkColorDialog_BuildDialog {w} {\n\
upvar #0 $w data\n\
\n\
set topFrame [frame $w.top -relief raised -bd 1]\n\
\n\
set stripsFrame [frame $topFrame.colorStrip]\n\
\n\
foreach c { Red Green Blue } {\n\
set color [string tolower $c]\n\
\n\
set f [frame $stripsFrame.$color]\n\
\n\
set box [frame $f.box]\n\
\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\
\n\
set height [expr \\\n\
[winfo reqheight $box.entry] - \\\n\
2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])]\n\
\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\
\n\
pack $f -side top -fill x -padx 0 -pady 2\n\
\n\
set data($color,entry) $box.entry\n\
set data($color,col) $f.color\n\
set data($color,sel) $f.sel\n\
\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\
\n\
bind $data($color,sel) <Enter> \\\n\
\"tkColorDialog_EnterColorBar $w $color\"\n\
bind $data($color,sel) <Leave> \\\n\
\"tkColorDialog_LeaveColorBar $w $color\"\n\
\n\
bind $box.entry <Return> \"tkColorDialog_HandleRGBEntry $w\"\n\
}\n\
\n\
pack $stripsFrame -side left -fill both -padx 4 -pady 10\n\
\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\
\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\
\n\
bind $ent <Return> \"tkColorDialog_HandleSelEntry $w\"\n\
\n\
pack $selFrame -side left -fill none -anchor nw\n\
pack $topFrame -side top -expand yes -fill both -anchor nw\n\
\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\
\n\
set data(okBtn)      $botFrame.ok\n\
set data(cancelBtn)  $botFrame.cancel\n\
\n\
pack $botFrame.ok $botFrame.cancel \\\n\
-padx 10 -pady 10 -expand yes -side left\n\
pack $botFrame -side bottom -fill x\n\
\n\
\n\
\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\
\n\
wm protocol $w WM_DELETE_WINDOW \"tkColorDialog_CancelCmd $w\"\n\
}\n\
\n\
proc tkColorDialog_SetRGBValue {w color} {\n\
upvar #0 $w data \n\
\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\
\n\
tkColorDialog_RedrawColorBars $w all\n\
\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\
\n\
proc tkColorDialog_XToRgb {w x} {\n\
upvar #0 $w data\n\
\n\
return [expr ($x * $data(intensityIncr))/ $data(colorbarWidth)]\n\
}\n\
\n\
proc tkColorDialog_RgbToX {w color} {\n\
upvar #0 $w data\n\
\n\
return [expr ($color * $data(colorbarWidth)/ $data(intensityIncr))]\n\
}\n\
\n\
\n\
proc tkColorDialog_DrawColorScale {w c {create 0}} {\n\
global lines\n\
upvar #0 $w data\n\
\n\
set col $data($c,col)\n\
set sel $data($c,sel)\n\
\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\
\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\
\n\
set height [winfo height $col]\n\
set data($c,clickRegion) [$sel create rectangle 0 0 \\\n\
$data(canvasWidth) $height -fill {} -outline {}]\n\
\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\
\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\
\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\
\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\
\n\
if $create {\n\
set data(lines,$c,last) $index\n\
set data(lines,$c,start) [expr $index - $data(NUM_COLORBARS) + 1 ]\n\
}\n\
\n\
tkColorDialog_RedrawFinalColor $w\n\
}\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\
\n\
proc tkColorDialog_RedrawFinalColor {w} {\n\
upvar #0 $w data\n\
\n\
set color [format \"#%02x%02x%02x\" $data(red,intensity) \\\n\
$data(green,intensity) $data(blue,intensity)]\n\
\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\
\n\
proc tkColorDialog_RedrawColorBars {w colorChanged} {\n\
upvar #0 $w data\n\
\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\
\n\
\n\
proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {\n\
upvar #0 $w data\n\
\n\
if !$dontMove {\n\
tkColorDialog_MoveSelector $w $sel $color $x $delta\n\
}\n\
}\n\
\n\
proc tkColorDialog_MoveSelector {w sel color x delta} {\n\
upvar #0 $w data\n\
\n\
incr x -$delta\n\
\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\
\n\
return $x\n\
}\n\
\n\
proc tkColorDialog_ReleaseMouse {w sel color x delta} {\n\
upvar #0 $w data \n\
\n\
set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]\n\
\n\
set data($color,intensity) [tkColorDialog_XToRgb $w $x]\n\
\n\
tkColorDialog_RedrawColorBars $w $color\n\
}\n\
\n\
proc tkColorDialog_ResizeColorBars {w} {\n\
upvar #0 $w data\n\
\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\
\n\
proc tkColorDialog_HandleSelEntry {w} {\n\
upvar #0 $w data\n\
\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\
\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\
\n\
tkColorDialog_SetRGBValue $w \"$R $G $B\"\n\
set data(selection) $text\n\
}\n\
\n\
proc tkColorDialog_HandleRGBEntry {w} {\n\
upvar #0 $w data\n\
\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\
\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\
\n\
tkColorDialog_SetRGBValue $w \"$data(red,intensity) $data(green,intensity) \\\n\
$data(blue,intensity)\"\n\
}    \n\
\n\
proc tkColorDialog_EnterColorBar {w color} {\n\
upvar #0 $w data\n\
\n\
$data($color,sel) itemconfig $data($color,index) -fill red\n\
}\n\
\n\
proc tkColorDialog_LeaveColorBar {w color} {\n\
upvar #0 $w data\n\
\n\
$data($color,sel) itemconfig $data($color,index) -fill black\n\
}\n\
\n\
proc tkColorDialog_OkCmd {w} {\n\
global tkPriv\n\
upvar #0 $w data\n\
\n\
set tkPriv(selectColor) $data(finalColor)\n\
}\n\
\n\
proc tkColorDialog_CancelCmd {w} {\n\
global tkPriv\n\
\n\
set tkPriv(selectColor) \"\"\n\
}\n\
\n\
\n\
proc tclParseConfigSpec {w specs flags argList} {\n\
upvar #0 $w data\n\
\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\
\n\
if {[expr [llength $argList] %2] != 0} {\n\
foreach {cmdsw value} $argList {\n\
if ![info exists cmd($cmdsw)] {\n\
error \"unknown option \\\"$cmdsw\\\", must be [tclListValidFlags cmd]\"\n\
}\n\
}\n\
error \"value for \\\"[lindex $argList end]\\\" missing\"\n\
}\n\
\n\
foreach cmdsw [array names cmd] {\n\
set data($cmdsw) $def($cmdsw)\n\
}\n\
\n\
foreach {cmdsw value} $argList {\n\
if ![info exists cmd($cmdsw)] {\n\
error \"unknown option \\\"$cmdsw\\\", must be [tclListValidFlags cmd]\"\n\
}\n\
set data($cmdsw) $value\n\
}\n\
\n\
}\n\
\n\
proc tclListValidFlags {v} {\n\
upvar $v cmd\n\
\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\
\n\
proc tclSortNoCase {str1 str2} {\n\
return [string compare [string toupper $str1] [string toupper $str2]]\n\
}\n\
\n\
\n\
proc tclVerifyInteger {string} {\n\
lindex {1 2 3} $string\n\
}\n\
\n\
\n\
\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\
\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\
\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\
\n\
proc tkFocusGroup_Destroy {t w} {\n\
global tkPriv tkFocusIn tkFocusOut\n\
\n\
if ![string compare $t $w] {\n\
unset tkPriv(fg,$t)\n\
unset tkPriv(focus,$t) \n\
\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\
\n\
proc tkFocusGroup_In {t w detail} {\n\
global tkPriv tkFocusIn\n\
\n\
if ![info exists tkFocusIn($t,$w)] {\n\
set tkFocusIn($t,$w) \"\"\n\
return\n\
}\n\
if ![info exists tkPriv(focus,$t)] {\n\
return\n\
}\n\
if ![string compare $tkPriv(focus,$t) $w] {\n\
return\n\
} else {\n\
set tkPriv(focus,$t) $w\n\
eval $tkFocusIn($t,$w)\n\
}\n\
}\n\
\n\
proc tkFocusGroup_Out {t w detail} {\n\
global tkPriv tkFocusOut\n\
\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\
\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\
\n\
set types {}\n\
foreach t $string {\n\
set label [lindex $t 0]\n\
set exts {}\n\
\n\
if [info exists hasDoneType($label)] {\n\
continue\n\
}\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\
\n\
set hasDoneType($label) 1\n\
}\n\
\n\
return $types\n\
}\n\
\n\
\n\
if {$tcl_platform(platform) == \"macintosh\"} {\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 {$tcl_platform(platform) == \"windows\"} {\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\
\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 {$tcl_platform(platform) == \"unix\"} {\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\
\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\
\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\
\n\
bind Checkbutton <FocusIn> {}\n\
bind Checkbutton <Leave> {\n\
tkButtonLeave %W\n\
}\n\
\n\
bind Radiobutton <FocusIn> {}\n\
bind Radiobutton <Leave> {\n\
tkButtonLeave %W\n\
}\n\
\n\
if {$tcl_platform(platform) == \"windows\"} {\n\
\n\
\n\
\n\
proc tkButtonEnter w {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
if {$tkPriv(buttonWindow) == $w} {\n\
$w configure -state active -relief sunken\n\
}\n\
}\n\
set tkPriv(window) $w\n\
}\n\
\n\
\n\
proc tkButtonLeave w {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
$w config -state normal\n\
}\n\
if {$w == $tkPriv(buttonWindow)} {\n\
$w configure -relief $tkPriv(relief)\n\
}\n\
set tkPriv(window) \"\"\n\
}\n\
\n\
\n\
proc tkCheckRadioEnter w {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
if {$tkPriv(buttonWindow) == $w} {\n\
$w configure -state active\n\
}\n\
}\n\
set tkPriv(window) $w\n\
}\n\
\n\
\n\
proc tkButtonDown w {\n\
global tkPriv\n\
set tkPriv(relief) [lindex [$w conf -relief] 4]\n\
if {[$w cget -state] != \"disabled\"} {\n\
set tkPriv(buttonWindow) $w\n\
$w config -relief sunken -state active\n\
}\n\
}\n\
\n\
\n\
proc tkCheckRadioDown w {\n\
global tkPriv\n\
set tkPriv(relief) [lindex [$w conf -relief] 4]\n\
if {[$w cget -state] != \"disabled\"} {\n\
set tkPriv(buttonWindow) $w\n\
$w config -state active\n\
}\n\
}\n\
\n\
\n\
proc tkButtonUp w {\n\
global tkPriv\n\
if {$w == $tkPriv(buttonWindow)} {\n\
set tkPriv(buttonWindow) \"\"\n\
if {($w == $tkPriv(window))\n\
&& ([$w cget -state] != \"disabled\")} {\n\
$w config -relief $tkPriv(relief) -state normal\n\
uplevel #0 [list $w invoke]\n\
}\n\
}\n\
}\n\
\n\
}\n\
\n\
if {$tcl_platform(platform) == \"unix\"} {\n\
\n\
\n\
\n\
proc tkButtonEnter {w} {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
$w config -state active\n\
if {$tkPriv(buttonWindow) == $w} {\n\
$w configure -state active -relief sunken\n\
}\n\
}\n\
set tkPriv(window) $w\n\
}\n\
\n\
\n\
proc tkButtonLeave w {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
$w config -state normal\n\
}\n\
if {$w == $tkPriv(buttonWindow)} {\n\
$w configure -relief $tkPriv(relief)\n\
}\n\
set tkPriv(window) \"\"\n\
}\n\
\n\
\n\
proc tkButtonDown w {\n\
global tkPriv\n\
set tkPriv(relief) [lindex [$w config -relief] 4]\n\
if {[$w cget -state] != \"disabled\"} {\n\
set tkPriv(buttonWindow) $w\n\
$w config -relief sunken\n\
}\n\
}\n\
\n\
\n\
proc tkButtonUp w {\n\
global tkPriv\n\
if {$w == $tkPriv(buttonWindow)} {\n\
set tkPriv(buttonWindow) \"\"\n\
$w config -relief $tkPriv(relief)\n\
if {($w == $tkPriv(window))\n\
&& ([$w cget -state] != \"disabled\")} {\n\
uplevel #0 [list $w invoke]\n\
}\n\
}\n\
}\n\
\n\
}\n\
\n\
if {$tcl_platform(platform) == \"macintosh\"} {\n\
\n\
\n\
\n\
proc tkButtonEnter {w} {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
if {$tkPriv(buttonWindow) == $w} {\n\
$w configure -state active\n\
}\n\
}\n\
set tkPriv(window) $w\n\
}\n\
\n\
\n\
proc tkButtonLeave w {\n\
global tkPriv\n\
if {$w == $tkPriv(buttonWindow)} {\n\
$w configure -state normal\n\
}\n\
set tkPriv(window) \"\"\n\
}\n\
\n\
\n\
proc tkButtonDown w {\n\
global tkPriv\n\
if {[$w cget -state] != \"disabled\"} {\n\
set tkPriv(buttonWindow) $w\n\
$w config -state active\n\
}\n\
}\n\
\n\
\n\
proc tkButtonUp w {\n\
global tkPriv\n\
if {$w == $tkPriv(buttonWindow)} {\n\
$w config -state normal\n\
set tkPriv(buttonWindow) \"\"\n\
if {($w == $tkPriv(window))\n\
&& ([$w cget -state] != \"disabled\")} {\n\
uplevel #0 [list $w invoke]\n\
}\n\
}\n\
}\n\
\n\
}\n\
\n\
\n\
\n\
proc tkButtonInvoke w {\n\
if {[$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\
\n\
\n\
proc tkCheckRadioInvoke {w {cmd invoke}} {\n\
if {[$w cget -state] != \"disabled\"} {\n\
uplevel #0 [list $w $cmd]\n\
}\n\
}\n\
\n\
\n\
\n\
proc tk_dialog {w title text bitmap default args} {\n\
global tkPriv tcl_platform\n\
\n\
\n\
catch {destroy $w}\n\
toplevel $w -class Dialog\n\
wm title $w $title\n\
wm iconname $w Dialog\n\
wm protocol $w WM_DELETE_WINDOW { }\n\
\n\
\n\
wm transient $w [winfo toplevel [winfo parent $w]]\n\
if {$tcl_platform(platform) == \"macintosh\"} {\n\
unsupported1 style $w dBoxProc\n\
}\n\
\n\
frame $w.bot\n\
frame $w.top\n\
if {$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\
\n\
\n\
option add *Dialog.msg.wrapLength 3i widgetDefault\n\
label $w.msg -justify left -text $text\n\
if {$tcl_platform(platform) == \"macintosh\"} {\n\
$w.msg configure -font system\n\
} else {\n\
$w.msg configure -font {Times 18}\n\
}\n\
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m\n\
if {$bitmap != \"\"} {\n\
if {($tcl_platform(platform) == \"macintosh\") && ($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\
\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 {$tcl_platform(platform) == \"macintosh\"} {\n\
set tmp [string tolower $but]\n\
if {($tmp == \"ok\") || ($tmp == \"cancel\")} {\n\
grid columnconfigure $w.bot $i -minsize [expr 59 + 20]\n\
}\n\
}\n\
incr i\n\
}\n\
\n\
\n\
if {$default >= 0} {\n\
bind $w <Return> \"\n\
$w.button$default configure -state active -relief sunken\n\
update idletasks\n\
after 100\n\
set tkPriv(button) $default\n\
\"\n\
}\n\
\n\
\n\
bind $w <Destroy> {set tkPriv(button) -1}\n\
\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\
\n\
\n\
set oldFocus [focus]\n\
set oldGrab [grab current $w]\n\
if {$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\
\n\
\n\
tkwait variable tkPriv(button)\n\
catch {focus $oldFocus}\n\
catch {\n\
\n\
bind $w <Destroy> {}\n\
destroy $w\n\
}\n\
if {$oldGrab != \"\"} {\n\
if {$grabStatus == \"global\"} {\n\
grab -global $oldGrab\n\
} else {\n\
grab $oldGrab\n\
}\n\
}\n\
return $tkPriv(button)\n\
}\n\
\n\
\n\
\n\
bind Entry <<Cut>> {\n\
if {![catch {set data [string range [%W get] [%W index sel.first]\\\n\
[expr [%W index sel.last] - 1]]}]} {\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 [string range [%W get] [%W index sel.first]\\\n\
[expr [%W index sel.last] - 1]]}]} {\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 {\"$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\
\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>	{\n\
set tkPriv(selectMode) word\n\
tkEntryMouseSelect %W %x\n\
}\n\
bind Entry <Triple-Shift-1>	{\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 <ButtonRelease-2> {\n\
if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n\
tkEntryPaste %W %x\n\
}\n\
}\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\
\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\
\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\
\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 {$tcl_platform(platform) == \"macintosh\"} {\n\
bind Entry <Command-KeyPress> {# nothing}\n\
}\n\
\n\
bind Entry <Insert> {\n\
catch {tkEntryInsert %W [selection get -displayof %W]}\n\
}\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\
\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\
\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\
\n\
\n\
proc tkEntryButton1 {w x} {\n\
global tkPriv\n\
\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 {[lindex [$w configure -state] 4] == \"normal\"} {focus $w}\n\
}\n\
\n\
\n\
proc tkEntryMouseSelect {w x} {\n\
global tkPriv\n\
\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\
\n\
\n\
proc tkEntryPaste {w x} {\n\
global tkPriv\n\
\n\
$w icursor [tkEntryClosestGap $w $x]\n\
catch {$w insert insert [selection get -displayof $w]}\n\
if {[lindex [$w configure -state] 4] == \"normal\"} {focus $w}\n\
}\n\
\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\
\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\
\n\
\n\
proc tkEntryInsert {w s} {\n\
if {$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\
\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\
\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\
\n\
\n\
proc tkEntrySetCursor {w pos} {\n\
$w icursor $pos\n\
$w selection clear\n\
tkEntrySeeInsert $w\n\
}\n\
\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\
\n\
\n\
if {$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\
\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\
\n\
\n\
\n\
proc tk_focusNext w {\n\
set cur $w\n\
while 1 {\n\
\n\
\n\
set parent $cur\n\
set children [winfo children $cur]\n\
set i -1\n\
\n\
\n\
while 1 {\n\
incr i\n\
if {$i < [llength $children]} {\n\
set cur [lindex $children $i]\n\
if {[winfo toplevel $cur] == $cur} {\n\
continue\n\
} else {\n\
break\n\
}\n\
}\n\
\n\
\n\
set cur $parent\n\
if {[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 {($cur == $w) || [tkFocusOK $cur]} {\n\
return $cur\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tk_focusPrev w {\n\
set cur $w\n\
while 1 {\n\
\n\
\n\
if {[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\
\n\
\n\
while {$i > 0} {\n\
incr i -1\n\
set cur [lindex $children $i]\n\
if {[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 {($cur == $w) || [tkFocusOK $cur]} {\n\
return $cur\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkFocusOK w {\n\
set code [catch {$w cget -takefocus} value]\n\
if {($code == 0) && ($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 {$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) && ($value == \"disabled\")} {\n\
return 0\n\
}\n\
regexp Key|Focus \"[bind $w] [bind [winfo class $w]]\"\n\
}\n\
\n\
\n\
proc tk_focusFollowsMouse {} {\n\
set old [bind all <Enter>]\n\
set script {\n\
if {(\"%d\" == \"NotifyAncestor\") || (\"%d\" == \"NotifyNonlinear\")\n\
|| (\"%d\" == \"NotifyInferior\")} {\n\
if [tkFocusOK %W] {\n\
focus %W\n\
}\n\
}\n\
}\n\
if {$old != \"\"} {\n\
bind all <Enter> \"$old; $script\"\n\
} else {\n\
bind all <Enter> $script\n\
}\n\
}\n\
\n\
\n\
\n\
\n\
bind Listbox <1> {\n\
if [winfo exists %W] {\n\
tkListboxBeginSelect %W [%W index @%x,%y]\n\
}\n\
}\n\
\n\
\n\
bind Listbox <Double-1> {\n\
}\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\
\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\
}\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\
}\n\
bind Listbox <Shift-Control-End> {\n\
tkListboxDataExtend %W [%W index end]\n\
}\n\
bind Listbox <<Copy>> {\n\
if {[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 {[%W cget -selectmode] != \"browse\"} {\n\
%W selection clear 0 end\n\
}\n\
}\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\
\n\
\n\
proc tkListboxBeginSelect {w el} {\n\
global tkPriv\n\
if {[$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\
}\n\
\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\
}\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\
}\n\
}\n\
}\n\
\n\
\n\
proc tkListboxBeginExtend {w el} {\n\
if {[$w cget -selectmode] == \"extended\"} {\n\
if {[$w selection includes anchor]} {\n\
tkListboxMotion $w $el\n\
} else {\n\
\n\
tkListboxBeginSelect $w $el\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkListboxBeginToggle {w el} {\n\
global tkPriv\n\
if {[$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\
}\n\
}\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\
\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\
}\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\
}\n\
}\n\
}\n\
\n\
\n\
proc tkListboxExtendUpDown {w amount} {\n\
if {[$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\
\n\
\n\
proc tkListboxDataExtend {w el} {\n\
set mode [$w cget -selectmode]\n\
if {$mode == \"extended\"} {\n\
$w activate $el\n\
$w see $el\n\
if [$w selection includes anchor] {\n\
tkListboxMotion $w $el\n\
}\n\
} elseif {$mode == \"multiple\"} {\n\
$w activate $el\n\
$w see $el\n\
}\n\
}\n\
\n\
\n\
proc tkListboxCancel w {\n\
global tkPriv\n\
if {[$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\
}\n\
\n\
\n\
proc tkListboxSelectAll w {\n\
set mode [$w cget -selectmode]\n\
if {($mode == \"single\") || ($mode == \"browse\")} {\n\
$w selection clear 0 end\n\
$w selection set active\n\
} else {\n\
$w selection set 0 end\n\
}\n\
}\n\
\n\
\n\
\n\
\n\
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 {$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\
\n\
\n\
bind Menu <FocusIn> {}\n\
\n\
bind Menu <Enter> {\n\
set tkPriv(window) %W\n\
if {[%W cget -type] == \"tearoff\"} {\n\
if {\"%m\" != \"NotifyUngrab\"} {\n\
if {$tcl_platform(platform) == \"unix\"} {\n\
tk_menuSetFocus %W\n\
}\n\
}\n\
}\n\
tkMenuMotion %W %x %y %s\n\
}\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\
\n\
\n\
if {$tcl_platform(platform) == \"unix\"} {\n\
bind all <Alt-KeyPress> {\n\
tkTraverseToMenu %W %A\n\
}\n\
\n\
bind all <F10> {\n\
tkFirstMenu %W\n\
}\n\
} else {\n\
bind Menubutton <Alt-KeyPress> {\n\
tkTraverseToMenu %W %A\n\
}\n\
\n\
bind Menubutton <F10> {\n\
tkFirstMenu %W\n\
}\n\
}\n\
\n\
\n\
proc tkMbEnter w {\n\
global tkPriv\n\
\n\
if {$tkPriv(inMenubutton) != \"\"} {\n\
tkMbLeave $tkPriv(inMenubutton)\n\
}\n\
set tkPriv(inMenubutton) $w\n\
if {[$w cget -state] != \"disabled\"} {\n\
$w configure -state active\n\
}\n\
}\n\
\n\
\n\
proc tkMbLeave w {\n\
global tkPriv\n\
\n\
set tkPriv(inMenubutton) {}\n\
if ![winfo exists $w] {\n\
return\n\
}\n\
if {[$w cget -state] == \"active\"} {\n\
$w configure -state normal\n\
}\n\
}\n\
\n\
\n\
proc tkMbPost {w {x {}} {y {}}} {\n\
global tkPriv errorInfo\n\
global tcl_platform\n\
\n\
if {([$w cget -state] == \"disabled\") || ($w == $tkPriv(postedMb))} {\n\
return\n\
}\n\
set menu [$w cget -menu]\n\
if {$menu == \"\"} {\n\
return\n\
}\n\
set tearoff [expr {($tcl_platform(platform) == \"unix\") \\\n\
|| ([$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 {$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\
\n\
set tkPriv(postedMb) $w\n\
set tkPriv(focus) [focus]\n\
$menu activate none\n\
tkGenerateMenuSelect $menu\n\
\n\
\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 {($entry != {}) && ([$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 {($entry != {}) && ([$menu entrycget $entry -state] != \"disabled\")} {\n\
$menu activate $entry\n\
tkGenerateMenuSelect $menu\n\
}\n\
}\n\
default {\n\
if [$w cget -indicatoron] {\n\
if {$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\
\n\
set savedInfo $errorInfo\n\
tkMenuUnpost {}\n\
error $msg $savedInfo\n\
\n\
}\n\
\n\
set tkPriv(tearoff) $tearoff\n\
if {$tearoff != 0} {\n\
focus $menu\n\
tkSaveGrabInfo $w\n\
grab -global $w\n\
}\n\
}\n\
\n\
\n\
proc tkMenuUnpost menu {\n\
global tcl_platform\n\
global tkPriv\n\
set mb $tkPriv(postedMb)\n\
\n\
\n\
catch {focus $tkPriv(focus)}\n\
set tkPriv(focus) \"\"\n\
\n\
\n\
catch {\n\
if {$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 {$tkPriv(popup) != \"\"} {\n\
$tkPriv(popup) unpost\n\
set tkPriv(popup) {}\n\
} elseif {(!([$menu cget -type] == \"menubar\")\n\
&& !([$menu cget -type] == \"tearoff\"))} {\n\
\n\
while 1 {\n\
set parent [winfo parent $menu]\n\
if {([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 {($type == \"menubar\")|| ($type == \"tearoff\")} {\n\
break\n\
}\n\
set menu $parent\n\
}\n\
if {[$menu cget -type] != \"menubar\"} {\n\
$menu unpost\n\
}\n\
}\n\
}\n\
\n\
if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != \"\")} {\n\
\n\
if {$menu != \"\"} {\n\
set grab [grab current $menu]\n\
if {$grab != \"\"} {\n\
grab release $grab\n\
}\n\
}\n\
tkRestoreOldGrab\n\
if {$tkPriv(menuBar) != \"\"} {\n\
$tkPriv(menuBar) configure -cursor $tkPriv(cursor)\n\
set tkPriv(menuBar) {}\n\
}\n\
if {$tcl_platform(platform) != \"unix\"} {\n\
set tkPriv(tearoff) 0\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkMbMotion {w upDown rootx rooty} {\n\
global tkPriv\n\
\n\
if {$tkPriv(inMenubutton) == $w} {\n\
return\n\
}\n\
set new [winfo containing $rootx $rooty]\n\
if {($new != $tkPriv(inMenubutton)) && (($new == \"\")\n\
|| ([winfo toplevel $new] == [winfo toplevel $w]))} {\n\
if {$tkPriv(inMenubutton) != \"\"} {\n\
tkMbLeave $tkPriv(inMenubutton)\n\
}\n\
if {($new != \"\") && ([winfo class $new] == \"Menubutton\")\n\
&& ([$new cget -indicatoron] == 0)\n\
&& ([$w cget -indicatoron] == 0)} {\n\
if {$upDown == \"down\"} {\n\
tkMbPost $new $rootx $rooty\n\
} else {\n\
tkMbEnter $new\n\
}\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkMbButtonUp w {\n\
global tkPriv\n\
global tcl_platform\n\
\n\
set tearoff [expr {($tcl_platform(platform) == \"unix\") \\\n\
|| ([[$w cget -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\
\n\
\n\
proc tkMenuMotion {menu x y state} {\n\
global tkPriv\n\
if {$menu == $tkPriv(window)} {\n\
if {[$menu cget -type] == \"menubar\"} {\n\
if {[info exists tkPriv(focus)] && \\\n\
([string compare $menu $tkPriv(focus)] != 0)} {\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\
\n\
\n\
proc tkMenuButtonDown menu {\n\
global tkPriv\n\
global tcl_platform\n\
$menu postcascade active\n\
if {$tkPriv(postedMb) != \"\"} {\n\
grab -global $tkPriv(postedMb)\n\
} else {\n\
while {([$menu cget -type] == \"normal\") \n\
&& ([winfo class [winfo parent $menu]] == \"Menu\")\n\
&& [winfo ismapped [winfo parent $menu]]} {\n\
set menu [winfo parent $menu]\n\
}\n\
\n\
if {$tkPriv(menuBar) == {}} {\n\
set tkPriv(menuBar) $menu\n\
set tkPriv(cursor) [$menu cget -cursor]\n\
$menu configure -cursor arrow\n\
}\n\
\n\
\n\
if {$menu != [grab current $menu]} {\n\
tkSaveGrabInfo $menu\n\
}\n\
\n\
\n\
if {$tcl_platform(platform) == \"unix\"} {\n\
grab -global $menu\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkMenuLeave {menu rootx rooty state} {\n\
global tkPriv\n\
set tkPriv(window) {}\n\
if {[$menu index active] == \"none\"} {\n\
return\n\
}\n\
if {([$menu type active] == \"cascade\")\n\
&& ([winfo containing $rootx $rooty]\n\
== [$menu entrycget active -menu])} {\n\
return\n\
}\n\
$menu activate none\n\
tkGenerateMenuSelect $menu\n\
}\n\
\n\
\n\
proc tkMenuInvoke {w buttonRelease} {\n\
global tkPriv\n\
\n\
if {$buttonRelease && ($tkPriv(window) == \"\")} {\n\
\n\
$w postcascade none\n\
$w activate none\n\
event generate $w <<MenuSelect>>\n\
tkMenuUnpost $w\n\
return\n\
}\n\
if {[$w type active] == \"cascade\"} {\n\
$w postcascade active\n\
set menu [$w entrycget active -menu]\n\
tkMenuFirstEntry $menu\n\
} elseif {[$w type active] == \"tearoff\"} {\n\
tkMenuUnpost $w\n\
tkTearOffMenu $w\n\
} elseif {[$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\
\n\
\n\
proc tkMenuEscape menu {\n\
set parent [winfo parent $menu]\n\
if {([winfo class $parent] != \"Menu\")} {\n\
tkMenuUnpost $menu\n\
} elseif {([$parent cget -type] == \"menubar\")} {\n\
tkMenuUnpost $menu\n\
tkRestoreOldGrab\n\
} else {\n\
tkMenuNextMenu $menu left\n\
}\n\
}\n\
\n\
\n\
proc tkMenuUpArrow {menu} {\n\
if {[$menu cget -type] == \"menubar\"} {\n\
tkMenuNextMenu $menu left\n\
} else {\n\
tkMenuNextEntry $menu -1\n\
}\n\
}\n\
\n\
proc tkMenuDownArrow {menu} {\n\
if {[$menu cget -type] == \"menubar\"} {\n\
tkMenuNextMenu $menu right\n\
} else {\n\
tkMenuNextEntry $menu 1\n\
}\n\
}\n\
\n\
proc tkMenuLeftArrow {menu} {\n\
if {[$menu cget -type] == \"menubar\"} {\n\
tkMenuNextEntry $menu -1\n\
} else {\n\
tkMenuNextMenu $menu left\n\
}\n\
}\n\
\n\
proc tkMenuRightArrow {menu} {\n\
if {[$menu cget -type] == \"menubar\"} {\n\
tkMenuNextEntry $menu 1\n\
} else {\n\
tkMenuNextMenu $menu right\n\
}\n\
}\n\
\n\
\n\
proc tkMenuNextMenu {menu direction} {\n\
global tkPriv\n\
\n\
\n\
if {$direction == \"right\"} {\n\
set count 1\n\
set parent [winfo parent $menu]\n\
set class [winfo class $parent]\n\
if {[$menu type active] == \"cascade\"} {\n\
$menu postcascade active\n\
set m2 [$menu entrycget active -menu]\n\
if {$m2 != \"\"} {\n\
tkMenuFirstEntry $m2\n\
}\n\
return\n\
} else {\n\
set parent [winfo parent $menu]\n\
while {($parent != \".\")} {\n\
if {([winfo class $parent] == \"Menu\")\n\
&& ([$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 {[winfo class $m2] == \"Menu\"} {\n\
if {[$m2 cget -type] != \"menubar\"} {\n\
$menu activate none\n\
tkGenerateMenuSelect $menu\n\
tk_menuSetFocus $m2\n\
\n\
\n\
set tmp [$m2 index active]\n\
$m2 activate none\n\
$m2 activate $tmp\n\
return\n\
}\n\
}\n\
}\n\
\n\
\n\
set m2 [winfo parent $menu]\n\
if {[winfo class $m2] == \"Menu\"} {\n\
if {[$m2 cget -type] == \"menubar\"} {\n\
tk_menuSetFocus $m2\n\
tkMenuNextEntry $m2 -1\n\
return\n\
}\n\
}\n\
\n\
set w $tkPriv(postedMb)\n\
if {$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 {([winfo class $mb] == \"Menubutton\")\n\
&& ([$mb cget -state] != \"disabled\")\n\
&& ([$mb cget -menu] != \"\")\n\
&& ([[$mb cget -menu] index last] != \"none\")} {\n\
break\n\
}\n\
if {$mb == $w} {\n\
return\n\
}\n\
incr i $count\n\
}\n\
tkMbPost $mb\n\
tkMenuFirstEntry [$mb cget -menu]\n\
}\n\
\n\
\n\
proc tkMenuNextEntry {menu count} {\n\
global tkPriv\n\
\n\
if {[$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 {$active == \"none\"} {\n\
set i 0\n\
} else {\n\
set i [expr $active + $count]\n\
}\n\
while 1 {\n\
if {$quitAfter <= 0} {\n\
\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 {[$menu type $i] == \"cascade\"} {\n\
set cascade [$menu entrycget $i -menu]\n\
if {[string compare $cascade \"\"] != 0} {\n\
$menu postcascade $i\n\
tkMenuFirstEntry $cascade\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkMenuFind {w char} {\n\
global tkPriv\n\
set char [string tolower $char]\n\
set windowlist [winfo child $w]\n\
\n\
foreach child $windowlist {\n\
switch [winfo class $child] {\n\
Menu {\n\
if {[$child cget -type] == \"menubar\"} {\n\
if {$char == \"\"} {\n\
return $child\n\
}\n\
set last [$child index last]\n\
for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {\n\
if {[$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\
== 0) || ($char == \"\")} {\n\
if {[$child entrycget $i -state] != \"disabled\"} {\n\
return $child\n\
}\n\
}\n\
}\n\
}\n\
}\n\
}\n\
}\n\
\n\
foreach child $windowlist {\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]] == 0)\n\
|| ($char == \"\")} {\n\
if {[$child cget -state] != \"disabled\"} {\n\
return $child\n\
}\n\
}\n\
}\n\
\n\
default {\n\
set match [tkMenuFind $child $char]\n\
if {$match != \"\"} {\n\
return $match\n\
}\n\
}\n\
}\n\
}\n\
return {}\n\
}\n\
\n\
\n\
proc tkTraverseToMenu {w char} {\n\
global tkPriv\n\
if {$char == \"\"} {\n\
return\n\
}\n\
while {[winfo class $w] == \"Menu\"} {\n\
if {([$w cget -type] != \"menubar\") && ($tkPriv(postedMb) == \"\")} {\n\
return\n\
}\n\
if {[$w cget -type] == \"menubar\"} {\n\
break\n\
}\n\
set w [winfo parent $w]\n\
}\n\
set w [tkMenuFind [winfo toplevel $w] $char]\n\
if {$w != \"\"} {\n\
if {[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\
\n\
\n\
proc tkFirstMenu w {\n\
set w [tkMenuFind [winfo toplevel $w] \"\"]\n\
if {$w != \"\"} {\n\
if {[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\
\n\
\n\
proc tkTraverseWithinMenu {w char} {\n\
if {$char == \"\"} {\n\
return\n\
}\n\
set char [string tolower $char]\n\
set last [$w index last]\n\
if {$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]] == 0} {\n\
if {[$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 {$m2 != \"\"} {\n\
tkMenuFirstEntry $m2\n\
}\n\
} else {\n\
tkMenuUnpost $w\n\
uplevel #0 [list $w invoke $i]\n\
}\n\
return\n\
}\n\
}\n\
}\n\
\n\
\n\
proc tkMenuFirstEntry menu {\n\
if {$menu == \"\"} {\n\
return\n\
}\n\
tk_menuSetFocus $menu\n\
if {[$menu index active] != \"none\"} {\n\
return\n\
}\n\
set last [$menu index last]\n\
if {$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\
&& ($state != \"disabled\") && ([$menu type $i] != \"tearoff\")} {\n\
$menu activate $i\n\
tkGenerateMenuSelect $menu\n\
if {[$menu type $i] == \"cascade\"} {\n\
set cascade [$menu entrycget $i -menu]\n\
if {[string compare $cascade \"\"] != 0} {\n\
$menu postcascade $i\n\
tkMenuFirstEntry $cascade\n\
}\n\
}\n\
return\n\
}\n\
}\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 {$last == \"none\"} {\n\
return\n\
}\n\
for {set i 0} {$i <= $last} {incr i} {\n\
if ![catch {$menu entrycget $i -label} label] {\n\
if {$label == $s} {\n\
return $i\n\
}\n\
}\n\
}\n\
return \"\"\n\
}\n\
\n\
\n\
proc tkPostOverPoint {menu x y {entry {}}}  {\n\
global tcl_platform\n\
\n\
if {$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 {($entry != {}) && ([$menu entrycget $entry -state] != \"disabled\")} {\n\
$menu activate $entry\n\
tkGenerateMenuSelect $menu\n\
}\n\
}\n\
\n\
\n\
proc tkSaveGrabInfo w {\n\
global tkPriv\n\
set tkPriv(oldGrab) [grab current $w]\n\
if {$tkPriv(oldGrab) != \"\"} {\n\
set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]\n\
}\n\
}\n\
\n\
\n\
proc tkRestoreOldGrab {} {\n\
global tkPriv\n\
\n\
if {$tkPriv(oldGrab) != \"\"} {\n\
\n\
\n\
catch {\n\
if {$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\
\n\
proc tk_menuSetFocus {menu} {\n\
global tkPriv\n\
if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} {\n\
set tkPriv(focus) [focus]\n\
}\n\
focus $menu\n\
}\n\
\n\
proc tkGenerateMenuSelect {menu} {\n\
global tkPriv\n\
\n\
if {([string compare $tkPriv(activeMenu) $menu] == 0) \\\n\
&& ([string compare $tkPriv(activeItem) [$menu index active]] \\\n\
== 0)} {\n\
return\n\
}\n\
\n\
set tkPriv(activeMenu) $menu\n\
set tkPriv(activeItem) [$menu index active]\n\
event generate $menu <<MenuSelect>>\n\
}\n\
\n\
\n\
proc tk_popup {menu x y {entry {}}} {\n\
global tkPriv\n\
global tcl_platform\n\
if {($tkPriv(popup) != \"\") || ($tkPriv(postedMb) != \"\")} {\n\
tkMenuUnpost {}\n\
}\n\
tkPostOverPoint $menu $x $y $entry\n\
if {$tcl_platform(platform) == \"unix\"} {\n\
tkSaveGrabInfo $menu\n\
grab -global $menu\n\
set tkPriv(popup) $menu\n\
tk_menuSetFocus $menu\n\
}\n\
}\n\
\n\
\n\
proc tk_setPalette {args} {\n\
global tkPalette\n\
\n\
\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\
\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\
\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\
\n\
\n\
eval [tkRecolorTree . new]\n\
\n\
catch {destroy .___tk_set_palette}\n\
\n\
\n\
foreach option [array names new] {\n\
option add *$option $new($option) widgetDefault\n\
}\n\
\n\
\n\
array set tkPalette [array get new]\n\
}\n\
\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\
\n\
\n\
proc tkDarken {color percent} {\n\
set l [winfo rgb . $color]\n\
set red [expr [lindex $l 0]/256]\n\
set green [expr [lindex $l 1]/256]\n\
set blue [expr [lindex $l 2]/256]\n\
set red [expr ($red*$percent)/100]\n\
if {$red > 255} {\n\
set red 255\n\
}\n\
set green [expr ($green*$percent)/100]\n\
if {$green > 255} {\n\
set green 255\n\
}\n\
set blue [expr ($blue*$percent)/100]\n\
if {$blue > 255} {\n\
set blue 255\n\
}\n\
format #%02x%02x%02x $red $green $blue\n\
}\n\
\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\
\n\
\n\
\n\
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 {[%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\
\n\
\n\
proc tkScaleActivate {w x y} {\n\
global tkPriv\n\
if {[$w cget -state] == \"disabled\"} {\n\
return;\n\
}\n\
if {[$w identify $x $y] == \"slider\"} {\n\
$w configure -state active\n\
} else {\n\
$w configure -state normal\n\
}\n\
}\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 {$el == \"trough1\"} {\n\
tkScaleIncrement $w up little initial\n\
} elseif {$el == \"trough2\"} {\n\
tkScaleIncrement $w down little initial\n\
} elseif {$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\
\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\
\n\
\n\
proc tkScaleEndDrag {w} {\n\
global tkPriv\n\
set tkPriv(dragging) 0\n\
$w configure -sliderrelief raised\n\
}\n\
\n\
\n\
proc tkScaleIncrement {w dir big repeat} {\n\
global tkPriv\n\
if {![winfo exists $w]} return\n\
if {$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]) ^ ($dir == \"up\")} {\n\
set inc [expr -$inc]\n\
}\n\
$w set [expr [$w get] + $inc]\n\
\n\
if {$repeat == \"again\"} {\n\
set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n\
tkScaleIncrement $w $dir $big again]\n\
} elseif {$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\
\n\
\n\
proc tkScaleControlPress {w x y} {\n\
set el [$w identify $x $y]\n\
if {$el == \"trough1\"} {\n\
$w set [$w cget -from]\n\
} elseif {$el == \"trough2\"} {\n\
$w set [$w cget -to]\n\
}\n\
}\n\
\n\
\n\
proc tkScaleButton2Down {w x y} {\n\
global tkPriv\n\
\n\
if {[$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\
\n\
\n\
proc tkTearOffMenu {w {x 0} {y 0}} {\n\
\n\
if {$x == 0} {\n\
set x [winfo rootx $w]\n\
}\n\
if {$y == 0} {\n\
set y [winfo rooty $w]\n\
}\n\
\n\
set parent [winfo parent $w]\n\
while {([winfo toplevel $parent] != $parent)\n\
|| ([winfo class $parent] == \"Menu\")} {\n\
set parent [winfo parent $parent]\n\
}\n\
if {$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\
\n\
$w clone $menu tearoff\n\
\n\
\n\
set parent [winfo parent $w]\n\
if {[$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\
\n\
$menu post $x $y\n\
\n\
if {[winfo exists $menu] == 0} {\n\
return \"\"\n\
}\n\
\n\
\n\
bind $menu <Enter> {\n\
set tkPriv(focus) %W\n\
}\n\
\n\
\n\
set cmd [$w cget -tearoffcommand]\n\
if {$cmd != \"\"} {\n\
uplevel #0 $cmd $w $menu\n\
}\n\
return $menu\n\
}\n\
\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 {$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\
\n\
\n\
regsub -all . $src {\\\\&} quotedSrc\n\
regsub -all . $dst {\\\\&} quotedDst\n\
regsub -all $quotedSrc [bindtags $src] $dst x\n\
bindtags $dst $x\n\
foreach event [bind $src] {\n\
regsub -all $quotedSrc [bind $src $event] $dst x\n\
bind $dst $event $x\n\
}\n\
}\n\
\n\
\n\
\n\
\n\
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>	{\n\
set tkPriv(selectMode) word\n\
tkTextSelectTo %W %x %y\n\
}\n\
bind Text <Triple-Shift-1>	{\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 <ButtonRelease-2> {\n\
if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n\
tkTextPaste %W %x %y\n\
}\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\
\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\
\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 {[%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 {[%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\
\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 <Insert> {\n\
catch {tkTextInsert %W [selection get -displayof %W]}\n\
}\n\
bind Text <KeyPress> {\n\
tkTextInsert %W %A\n\
}\n\
\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 {$tcl_platform(platform) == \"macintosh\"} {\n\
bind Text <Command-KeyPress> {# nothing}\n\
}\n\
\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\
\n\
if {$tcl_platform(platform) != \"windows\"} {\n\
bind Text <Control-v> {\n\
if !$tk_strictMotif {\n\
tkTextScrollPages %W 1\n\
}\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\
\n\
\n\
if {$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\
}\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\
\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\
\n\
\n\
proc tkTextButton1 {w x y} {\n\
global tkPriv\n\
\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 {[$w cget -state] == \"normal\"} {focus $w}\n\
}\n\
\n\
\n\
proc tkTextSelectTo {w x y} {\n\
global tkPriv tcl_platform\n\
\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) || ($tkPriv(selectMode) != \"char\")} {\n\
if {$tcl_platform(platform) != \"unix\" && [$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\
\n\
\n\
proc tkTextKeyExtend {w index} {\n\
global tkPriv\n\
\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\
\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 {[$w cget -state] == \"normal\"} {focus $w}\n\
}\n\
\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\
\n\
\n\
proc tkTextSetCursor {w pos} {\n\
global tkPriv\n\
\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\
\n\
\n\
proc tkTextKeySelect {w new} {\n\
global tkPriv\n\
\n\
if {[$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\
\n\
\n\
proc tkTextResetAnchor {w index} {\n\
global tkPriv\n\
\n\
if {[$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\
\n\
\n\
proc tkTextInsert {w s} {\n\
if {($s == \"\") || ([$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\
\n\
\n\
proc tkTextUpDownLine {w n} {\n\
global tkPriv\n\
\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\
\n\
\n\
proc tkTextPrevPara {w pos} {\n\
set pos [$w index \"$pos linestart\"]\n\
while 1 {\n\
if {(([$w get \"$pos - 1 line\"] == \"\\n\") && ([$w get $pos] != \"\\n\"))\n\
|| ($pos == \"1.0\")} {\n\
if [regexp -indices {^[ 	]+(.)} [$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] || ($pos == \"1.0\")} {\n\
return $pos\n\
}\n\
}\n\
set pos [$w index \"$pos - 1 line\"]\n\
}\n\
}\n\
\n\
\n\
proc tkTextNextPara {w start} {\n\
set pos [$w index \"$start linestart + 1 line\"]\n\
while {[$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 {[$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 {^[ 	]+(.)} [$w get $pos \"$pos lineend\"] \\\n\
dummy index] {\n\
return [$w index \"$pos + [lindex $index 0] chars\"]\n\
}\n\
return $pos\n\
}\n\
\n\
\n\
proc tkTextScrollPages {w count} {\n\
set bbox [$w bbox insert]\n\
$w yview scroll $count pages\n\
if {$bbox == \"\"} {\n\
return [$w index @[expr [winfo height $w]/2],0]\n\
}\n\
return [$w index @[lindex $bbox 0],[lindex $bbox 1]]\n\
}\n\
\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\
\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\
\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\
\n\
\n\
proc tk_textPaste w {\n\
global tcl_platform\n\
catch {\n\
if {\"$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\
\n\
\n\
if {$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\
\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\
\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\
\n\
\n\
\n\
proc tk_optionMenu {w varName firstValue args} {\n\
upvar #0 $varName var\n\
\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\
\n\
\n\
if {($tcl_platform(platform) != \"windows\") &&\n\
($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\
\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\
\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\
\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 {$element == \"slider\"} {\n\
tkScrollStartDrag $w $x $y\n\
} else {\n\
tkScrollSelect $w $element initial\n\
}\n\
}\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\
\n\
\n\
proc tkScrollSelect {w element repeat} {\n\
global tkPriv\n\
if {![winfo exists $w]} return\n\
if {$element == \"arrow1\"} {\n\
tkScrollByUnits $w hv -1\n\
} elseif {$element == \"trough1\"} {\n\
tkScrollByPages $w hv -1\n\
} elseif {$element == \"trough2\"} {\n\
tkScrollByPages $w hv 1\n\
} elseif {$element == \"arrow2\"} {\n\
tkScrollByUnits $w hv 1\n\
} else {\n\
return\n\
}\n\
if {$repeat == \"again\"} {\n\
set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n\
tkScrollSelect $w $element again]\n\
} elseif {$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\
\n\
\n\
proc tkScrollStartDrag {w x y} {\n\
global tkPriv\n\
\n\
if {[$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\
\n\
\n\
proc tkScrollDrag {w x y} {\n\
global tkPriv\n\
\n\
if {$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\
\n\
\n\
proc tkScrollEndDrag {w x y} {\n\
global tkPriv\n\
\n\
if {$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\
\n\
\n\
proc tkScrollByUnits {w orient amount} {\n\
set cmd [$w cget -command]\n\
if {($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\
\n\
\n\
proc tkScrollByPages {w orient amount} {\n\
set cmd [$w cget -command]\n\
if {($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\
\n\
\n\
proc tkScrollToPos {w pos} {\n\
set cmd [$w cget -command]\n\
if {($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\
\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\
\n\
\n\
set tkPriv(relief) [$w cget -activerelief]\n\
}\n\
\n\
\n\
proc tkScrollButton2Down {w x y} {\n\
global tkPriv\n\
set element [$w identify $x $y]\n\
if {($element == \"arrow1\") || ($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\
\n\
\n\
update idletasks\n\
$w configure -activerelief sunken\n\
$w activate slider\n\
tkScrollStartDrag $w $x $y\n\
}\n\
";
#include "tclcl.h"
EmbeddedTcl et_tk(code);