/* This code is automatically generated by "mktclapp" version 3.11 */ /* DO NOT EDIT */ #include #define INTERFACE 1 #if INTERFACE #define ET_TCLARGS ClientData clientData,Tcl_Interp*interp,int argc,char**argv #define ET_OBJARGS ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj*CONST objv[] #endif #define ET_ENABLE_OBJ 0 #define ET_ENABLE_TK 1 #define ET_AUTO_FORK 0 #define ET_STANDALONE 0 #define ET_N_BUILTIN_SCRIPT 39 #define ET_VERSION "3.11" #define ET_HAVE_APPINIT 1 #define ET_HAVE_PREINIT 0 #define ET_HAVE_MAIN 1 #define ET_HAVE_CUSTOM_MAINLOOP 0 #define ET_TCL_LIBRARY "/usr/lib/tcl8.4" #define ET_TK_LIBRARY "/usr/lib/tk8.4" #define ET_MAIN_SCRIPT "tkmerc.tcl" #define ET_EXTENSION 0 #define ET_SHROUD_KEY 0 #define ET_READ_STDIN 0 #define ET_CONSOLE 0 #define ET_TKCONSOLE 0 static struct { char *zName; int (*xProc)(ET_TCLARGS); } Et_CmdSet[] = { {0, 0}}; static unsigned char Et_zFile0[] = "proc auto_reset {} {\n" "global auto_execs auto_index auto_oldpath\n" "foreach p [info procs] {\n" "if {[info exists auto_index($p)] && ![string match auto_* $p]\n" "&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup\n" "tcl_findLibrary pkg_compareExtension\n" "tclPkgUnknown tcl::MacOSXPkgUnknown\n" "tcl::MacPkgUnknown} $p] < 0)} {\n" "rename $p {}\n" "}\n" "}\n" "unset -nocomplain auto_execs auto_index auto_oldpath\n" "}\n" "proc tcl_findLibrary {basename version patch initScript enVarName varName} {\n" "upvar #0 $varName the_library\n" "global env errorInfo\n" "set dirs {}\n" "set errors {}\n" "if {[info exists the_library] && $the_library ne \"\"} {\n" "lappend dirs $the_library\n" "} else {\n" "if {[info exists env($enVarName)]} {\n" "lappend dirs $env($enVarName)\n" "}\n" "foreach d $::auto_path {\n" "lappend dirs [file join $d $basename$version]\n" "if {$::tcl_platform(platform) eq \"unix\"\n" "&& $::tcl_platform(os) eq \"Darwin\"} {\n" "lappend dirs [file join $d $basename$version Resources Scripts]\n" "}\n" "}\n" "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n" "set grandParentDir [file dirname $parentDir]\n" "lappend dirs [file join $parentDir lib $basename$version]\n" "lappend dirs [file join $grandParentDir lib $basename$version]\n" "lappend dirs [file join $parentDir library]\n" "if {1} {\n" "lappend dirs [file join $grandParentDir library]\n" "lappend dirs [file join $grandParentDir $basename$patch library]\n" "lappend dirs [file join [file dirname $grandParentDir] \\\n" "\011\011\011 $basename$patch library]\n" "}\n" "}\n" "array set seen {}\n" "foreach i $dirs {\n" "if {1 || [interp issafe]} {\n" "set norm $i\n" "} else {\n" "set norm [file normalize $i]\n" "}\n" "if {[info exists seen($norm)]} { continue }\n" "set seen($norm) \"\"\n" "lappend uniqdirs $i\n" "}\n" "set dirs $uniqdirs\n" "foreach i $dirs {\n" "set the_library $i\n" "set file [file join $i $initScript]\n" "if {[interp issafe] || [file exists $file]} {\n" "if {![catch {uplevel #0 [list source $file]} msg]} {\n" "return\n" "} else {\n" "append errors \"$file: $msg\\n$errorInfo\\n\"\n" "}\n" "}\n" "}\n" "unset -nocomplain the_library\n" "set msg \"Can't find a usable $initScript in the following directories: \\n\"\n" "append msg \" $dirs\\n\\n\"\n" "append msg \"$errors\\n\\n\"\n" "append msg \"This probably means that $basename wasn't installed properly.\\n\"\n" "error $msg\n" "}\n" "if {[interp issafe]} {\n" "return\011;# Stop sourcing the file here\n" "}\n" "proc auto_mkindex {dir args} {\n" "global errorCode errorInfo\n" "if {[interp issafe]} {\n" "error \"can't generate index within safe interpreter\"\n" "}\n" "set oldDir [pwd]\n" "cd $dir\n" "set dir [pwd]\n" "append index \"# Tcl autoload index file, version 2.0\\n\"\n" "append index \"# This file is generated by the \\\"auto_mkindex\\\" command\\n\"\n" "append index \"# and sourced to set up indexing information for one or\\n\"\n" "append index \"# more commands. Typically each line is a command that\\n\"\n" "append index \"# sets an element in the auto_index array, where the\\n\"\n" "append index \"# element name is the name of a command and the value is\\n\"\n" "append index \"# a script that loads the command.\\n\\n\"\n" "if {[llength $args] == 0} {\n" "set args *.tcl\n" "}\n" "auto_mkindex_parser::init\n" "foreach file [eval [linsert $args 0 glob --]] {\n" "if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {\n" "append index $msg\n" "} else {\n" "set code $errorCode\n" "set info $errorInfo\n" "cd $oldDir\n" "error $msg $info $code\n" "}\n" "}\n" "auto_mkindex_parser::cleanup\n" "set fid [open \"tclIndex\" w]\n" "puts -nonewline $fid $index\n" "close $fid\n" "cd $oldDir\n" "}\n" "proc auto_mkindex_old {dir args} {\n" "global errorCode errorInfo\n" "set oldDir [pwd]\n" "cd $dir\n" "set dir [pwd]\n" "append index \"# Tcl autoload index file, version 2.0\\n\"\n" "append index \"# This file is generated by the \\\"auto_mkindex\\\" command\\n\"\n" "append index \"# and sourced to set up indexing information for one or\\n\"\n" "append index \"# more commands. Typically each line is a command that\\n\"\n" "append index \"# sets an element in the auto_index array, where the\\n\"\n" "append index \"# element name is the name of a command and the value is\\n\"\n" "append index \"# a script that loads the command.\\n\\n\"\n" "if {[llength $args] == 0} {\n" "set args *.tcl\n" "}\n" "foreach file [eval [linsert $args 0 glob --]] {\n" "set f \"\"\n" "set error [catch {\n" "set f [open $file]\n" "while {[gets $f line] >= 0} {\n" "if {[regexp {^proc[ \011]+([^ \011]*)} $line match procName]} {\n" "set procName [lindex [auto_qualify $procName \"::\"] 0]\n" "append index \"set [list auto_index($procName)]\"\n" "append index \" \\[list source \\[file join \\$dir [list $file]\\]\\]\\n\"\n" "}\n" "}\n" "close $f\n" "} msg]\n" "if {$error} {\n" "set code $errorCode\n" "set info $errorInfo\n" "catch {close $f}\n" "cd $oldDir\n" "error $msg $info $code\n" "}\n" "}\n" "set f \"\"\n" "set error [catch {\n" "set f [open tclIndex w]\n" "puts -nonewline $f $index\n" "close $f\n" "cd $oldDir\n" "} msg]\n" "if {$error} {\n" "set code $errorCode\n" "set info $errorInfo\n" "catch {close $f}\n" "cd $oldDir\n" "error $msg $info $code\n" "}\n" "}\n" "namespace eval auto_mkindex_parser {\n" "variable parser \"\" ;# parser used to build index\n" "variable index \"\" ;# maintains index as it is built\n" "variable scriptFile \"\" ;# name of file being processed\n" "variable contextStack \"\" ;# stack of namespace scopes\n" "variable imports \"\" ;# keeps track of all imported cmds\n" "variable initCommands \"\" ;# list of commands that create aliases\n" "proc init {} {\n" "variable parser\n" "variable initCommands\n" "if {![interp issafe]} {\n" "set parser [interp create -safe]\n" "$parser hide info\n" "$parser hide rename\n" "$parser hide proc\n" "$parser hide namespace\n" "$parser hide eval\n" "$parser hide puts\n" "$parser invokehidden namespace delete ::\n" "$parser invokehidden proc unknown {args} {}\n" "$parser expose namespace\n" "$parser invokehidden rename namespace _%@namespace\n" "$parser expose eval\n" "$parser invokehidden rename eval _%@eval\n" "foreach cmd $initCommands {\n" "eval $cmd\n" "}\n" "}\n" "}\n" "proc cleanup {} {\n" "variable parser\n" "interp delete $parser\n" "unset parser\n" "}\n" "}\n" "proc auto_mkindex_parser::mkindex {file} {\n" "variable parser\n" "variable index\n" "variable scriptFile\n" "variable contextStack\n" "variable imports\n" "set scriptFile $file\n" "set fid [open $file]\n" "set contents [read $fid]\n" "close $fid\n" "set contents [string map \"$ \\u0000\" $contents]\n" "set index \"\"\n" "set contextStack \"\"\n" "set imports \"\"\n" "$parser eval $contents\n" "foreach name $imports {\n" "catch {$parser eval [list _%@namespace forget $name]}\n" "}\n" "return $index\n" "}\n" "proc auto_mkindex_parser::hook {cmd} {\n" "variable initCommands\n" "lappend initCommands $cmd\n" "}\n" "proc auto_mkindex_parser::slavehook {cmd} {\n" "variable initCommands\n" "lappend initCommands \"\\$parser eval [list $cmd]\"\n" "}\n" "proc auto_mkindex_parser::command {name arglist body} {\n" "hook [list auto_mkindex_parser::commandInit $name $arglist $body]\n" "}\n" "proc auto_mkindex_parser::commandInit {name arglist body} {\n" "variable parser\n" "set ns [namespace qualifiers $name]\n" "set tail [namespace tail $name]\n" "if {$ns eq \"\"} {\n" "set fakeName [namespace current]::_%@fake_$tail\n" "} else {\n" "set fakeName [namespace current]::[string map {:: _} _%@fake_$name]\n" "}\n" "proc $fakeName $arglist $body\n" "if {[string match *::* $name]} {\n" "set exportCmd [list _%@namespace export [namespace tail $name]]\n" "$parser eval [list _%@namespace eval $ns $exportCmd]\n" "set alias [namespace tail $fakeName]\n" "$parser invokehidden proc $name {args} \"_%@eval {$alias} \\$args\"\n" "$parser alias $alias $fakeName\n" "} else {\n" "$parser alias $name $fakeName\n" "}\n" "return\n" "}\n" "proc auto_mkindex_parser::fullname {name} {\n" "variable contextStack\n" "if {![string match ::* $name]} {\n" "foreach ns $contextStack {\n" "set name \"${ns}::$name\"\n" "if {[string match ::* $name]} {\n" "break\n" "}\n" "}\n" "}\n" "if {[namespace qualifiers $name] eq \"\"} {\n" "set name [namespace tail $name]\n" "} elseif {![string match ::* $name]} {\n" "set name \"::$name\"\n" "}\n" "return [string map \"\\u0000 $\" $name]\n" "}\n" "auto_mkindex_parser::command proc {name args} {\n" "variable index\n" "variable scriptFile\n" "append index [list set auto_index([fullname $name])] \\\n" "\011 [format { [list source [file join $dir %s]]} \\\n" "\011 [file split $scriptFile]] \"\\n\"\n" "}\n" "auto_mkindex_parser::hook {\n" "if {![catch {package require tbcload}]} {\n" "if {[namespace which -command tbcload::bcproc] eq \"\"} {\n" "auto_load tbcload::bcproc\n" "}\n" "load {} tbcload $auto_mkindex_parser::parser\n" "auto_mkindex_parser::commandInit tbcload::bcproc {name args} {\n" "variable index\n" "variable scriptFile\n" "append index [list set auto_index([fullname $name])] \\\n" "\011\011 [format { [list source [file join $dir %s]]} \\\n" "\011\011 [file split $scriptFile]] \"\\n\"\n" "}\n" "}\n" "}\n" "auto_mkindex_parser::command namespace {op args} {\n" "switch -- $op {\n" "eval {\n" "variable parser\n" "variable contextStack\n" "set name [lindex $args 0]\n" "set args [lrange $args 1 end]\n" "set contextStack [linsert $contextStack 0 $name]\n" "$parser eval [list _%@namespace eval $name] $args\n" "set contextStack [lrange $contextStack 1 end]\n" "}\n" "import {\n" "variable parser\n" "variable imports\n" "foreach pattern $args {\n" "if {$pattern ne \"-force\"} {\n" "lappend imports $pattern\n" "}\n" "}\n" "catch {$parser eval \"_%@namespace import $args\"}\n" "}\n" "}\n" "}\n" "return\n" ; static unsigned char Et_zFile1[] = "namespace eval tcl {\n" "variable history\n" "if {![info exists history]} {\n" "array set history {\n" "nextid\0110\n" "keep\01120\n" "oldest\011-20\n" "}\n" "}\n" "}\n" "proc history {args} {\n" "set len [llength $args]\n" "if {$len == 0} {\n" "return [tcl::HistInfo]\n" "}\n" "set key [lindex $args 0]\n" "set options \"add, change, clear, event, info, keep, nextid, or redo\"\n" "switch -glob -- $key {\n" "a* { # history add\n" "if {$len > 3} {\n" "return -code error \"wrong # args: should be \\\"history add event ?exec?\\\"\"\n" "}\n" "if {![string match $key* add]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "if {$len == 3} {\n" "set arg [lindex $args 2]\n" "if {! ([string match e* $arg] && [string match $arg* exec])} {\n" "return -code error \"bad argument \\\"$arg\\\": should be \\\"exec\\\"\"\n" "}\n" "}\n" "return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]\n" "}\n" "ch* { # history change\n" "if {($len > 3) || ($len < 2)} {\n" "return -code error \"wrong # args: should be \\\"history change newValue ?event?\\\"\"\n" "}\n" "if {![string match $key* change]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "if {$len == 2} {\n" "set event 0\n" "} else {\n" "set event [lindex $args 2]\n" "}\n" "return [tcl::HistChange [lindex $args 1] $event]\n" "}\n" "cl* { # history clear\n" "if {($len > 1)} {\n" "return -code error \"wrong # args: should be \\\"history clear\\\"\"\n" "}\n" "if {![string match $key* clear]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "return [tcl::HistClear]\n" "}\n" "e* { # history event\n" "if {$len > 2} {\n" "return -code error \"wrong # args: should be \\\"history event ?event?\\\"\"\n" "}\n" "if {![string match $key* event]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "if {$len == 1} {\n" "set event -1\n" "} else {\n" "set event [lindex $args 1]\n" "}\n" "return [tcl::HistEvent $event]\n" "}\n" "i* { # history info\n" "if {$len > 2} {\n" "return -code error \"wrong # args: should be \\\"history info ?count?\\\"\"\n" "}\n" "if {![string match $key* info]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "return [tcl::HistInfo [lindex $args 1]]\n" "}\n" "k* { # history keep\n" "if {$len > 2} {\n" "return -code error \"wrong # args: should be \\\"history keep ?count?\\\"\"\n" "}\n" "if {$len == 1} {\n" "return [tcl::HistKeep]\n" "} else {\n" "set limit [lindex $args 1]\n" "if {[catch {expr {~$limit}}] || ($limit < 0)} {\n" "return -code error \"illegal keep count \\\"$limit\\\"\"\n" "}\n" "return [tcl::HistKeep $limit]\n" "}\n" "}\n" "n* { # history nextid\n" "if {$len > 1} {\n" "return -code error \"wrong # args: should be \\\"history nextid\\\"\"\n" "}\n" "if {![string match $key* nextid]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "return [expr {$tcl::history(nextid) + 1}]\n" "}\n" "r* { # history redo\n" "if {$len > 2} {\n" "return -code error \"wrong # args: should be \\\"history redo ?event?\\\"\"\n" "}\n" "if {![string match $key* redo]} {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "return [tcl::HistRedo [lindex $args 1]]\n" "}\n" "default {\n" "return -code error \"bad option \\\"$key\\\": must be $options\"\n" "}\n" "}\n" "}\n" "proc tcl::HistAdd {command {exec {}}} {\n" "variable history\n" "if {[string trim $command] eq \"\"} {\n" "return \"\"\n" "}\n" "set i [incr history(nextid)]\n" "set history($i) $command\n" "set j [incr history(oldest)]\n" "unset -nocomplain history($j)\n" "if {[string match e* $exec]} {\n" "return [uplevel #0 $command]\n" "} else {\n" "return {}\n" "}\n" "}\n" "proc tcl::HistKeep {{limit {}}} {\n" "variable history\n" "if {$limit eq \"\"} {\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" "unset -nocomplain history($oldold)\n" "}\n" "set history(keep) $limit\n" "}\n" "}\n" "proc tcl::HistClear {} {\n" "variable history\n" "set keep $history(keep)\n" "unset history\n" "array set history [list \\\n" "\011nextid\0110\011\\\n" "\011keep\011$keep\011\\\n" "\011oldest\011-$keep\011\\\n" " ]\n" "}\n" "proc tcl::HistInfo {{num {}}} {\n" "variable history\n" "if {$num eq \"\"} {\n" "set num [expr {$history(keep) + 1}]\n" "}\n" "set result {}\n" "set newline \"\"\n" "for {set i [expr {$history(nextid) - $num + 1}]} \\\n" "\011 {$i <= $history(nextid)} {incr i} {\n" "if {![info exists history($i)]} {\n" "continue\n" "}\n" "set cmd [string map [list \\n \\n\\t] [string trimright $history($i) \\ \\n]]\n" "append result $newline[format \"%6d %s\" $i $cmd]\n" "set newline \\n\n" "}\n" "return $result\n" "}\n" "proc tcl::HistRedo {{event -1}} {\n" "variable history\n" "if {$event eq \"\"} {\n" "set event -1\n" "}\n" "set i [HistIndex $event]\n" "if {$i == $history(nextid)} {\n" "return -code error \"cannot redo the current event\"\n" "}\n" "set cmd $history($i)\n" "HistChange $cmd 0\n" "uplevel #0 $cmd\n" "}\n" "proc tcl::HistIndex {event} {\n" "variable history\n" "if {[catch {expr {~$event}}]} {\n" "for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \\\n" "\011\011{incr i -1} {\n" "if {[string match $event* $history($i)]} {\n" "return $i;\n" "}\n" "if {[string match $event $history($i)]} {\n" "return $i;\n" "}\n" "}\n" "return -code error \"no event matches \\\"$event\\\"\"\n" "} elseif {$event <= 0} {\n" "set i [expr {$history(nextid) + $event}]\n" "} else {\n" "set i $event\n" "}\n" "if {$i <= $history(oldest)} {\n" "return -code error \"event \\\"$event\\\" is too far in the past\"\n" "}\n" "if {$i > $history(nextid)} {\n" "return -code error \"event \\\"$event\\\" hasn't occured yet\"\n" "}\n" "return $i\n" "}\n" "proc tcl::HistEvent {event} {\n" "variable history\n" "set i [HistIndex $event]\n" "if {[info exists history($i)]} {\n" "return [string trimright $history($i) \\ \\n]\n" "} else {\n" "return \"\";\n" "}\n" "}\n" "proc tcl::HistChange {cmd {event 0}} {\n" "variable history\n" "set i [HistIndex $event]\n" "set history($i) $cmd\n" "}\n" ; static unsigned char Et_zFile2[] = "if {[info commands package] == \"\"} {\n" "error \"version mismatch: library\\nscripts expect Tcl version 7.5b1 or later but the loaded version is\\nonly [info patchlevel]\"\n" "}\n" "package require -exact Tcl 8.4\n" "if {![info exists auto_path]} {\n" "if {[info exists env(TCLLIBPATH)]} {\n" "set auto_path $env(TCLLIBPATH)\n" "} else {\n" "set auto_path \"\"\n" "}\n" "}\n" "namespace eval tcl {\n" "variable Dir\n" "if {[info library] ne \"\"} {\n" "foreach Dir [list [info library] [file dirname [info library]]] {\n" "if {[lsearch -exact $::auto_path $Dir] < 0} {\n" "lappend ::auto_path $Dir\n" "}\n" "}\n" "}\n" "set Dir [file join [file dirname [file dirname \\\n" "\011 [info nameofexecutable]]] lib]\n" "if {[lsearch -exact $::auto_path $Dir] < 0} {\n" "lappend ::auto_path $Dir\n" "}\n" "if {[info exists ::tcl_pkgPath]} {\n" "foreach Dir $::tcl_pkgPath {\n" "if {[lsearch -exact $::auto_path $Dir] < 0} {\n" "lappend ::auto_path $Dir\n" "}\n" "}\n" "}\n" "}\n" "if {(![interp issafe]) && $tcl_platform(platform) eq \"windows\"} {\n" "namespace eval tcl {\n" "proc EnvTraceProc {lo n1 n2 op} {\n" "set x $::env($n2)\n" "set ::env($lo) $x\n" "set ::env([string toupper $lo]) $x\n" "}\n" "proc InitWinEnv {} {\n" "global env tcl_platform\n" "foreach p [array names env] {\n" "set u [string toupper $p]\n" "if {$u ne $p} {\n" "switch -- $u {\n" "COMSPEC -\n" "PATH {\n" "if {![info exists env($u)]} {\n" "set env($u) $env($p)\n" "}\n" "trace add variable env($p) write \\\n" "\011\011\011\011 [namespace code [list EnvTraceProc $p]]\n" "trace add variable env($u) write \\\n" "\011\011\011\011 [namespace code [list EnvTraceProc $p]]\n" "}\n" "}\n" "}\n" "}\n" "if {![info exists env(COMSPEC)]} {\n" "if {$tcl_platform(os) eq \"Windows NT\"} {\n" "set env(COMSPEC) cmd.exe\n" "} else {\n" "set env(COMSPEC) command.com\n" "}\n" "}\n" "}\n" "InitWinEnv\n" "}\n" "}\n" "package unknown tclPkgUnknown\n" "if {![interp issafe]} {\n" "if {$::tcl_platform(platform) eq \"unix\"\n" "&& $::tcl_platform(os) eq \"Darwin\"} {\n" "package unknown [list tcl::MacOSXPkgUnknown [package unknown]]\n" "}\n" "if {$::tcl_platform(platform) eq \"macintosh\"} {\n" "package unknown [list tcl::MacPkgUnknown [package unknown]]\n" "}\n" "}\n" "if {[namespace which -command exec] eq \"\"} {\n" "set auto_noexec 1\n" "}\n" "set errorCode \"\"\n" "set errorInfo \"\"\n" "if {[namespace which -command tclLog] eq \"\"} {\n" "proc tclLog {string} {\n" "catch {puts stderr $string}\n" "}\n" "}\n" "proc unknown args {\n" "global auto_noexec auto_noload env unknown_pending tcl_interactive\n" "global errorCode errorInfo\n" "set cmd [lindex $args 0]\n" "if {[regexp \"^:*namespace\\[ \\t\\n\\]+inscope\" $cmd] && [llength $cmd] == 4} {\n" "set arglist [lrange $args 1 end]\n" "set ret [catch {uplevel 1 ::$cmd $arglist} result]\n" "if {$ret == 0} {\n" "return $result\n" "} else {\n" "return -code $ret -errorcode $errorCode $result\n" "}\n" "}\n" "if {![info exists errorCode]} {\n" "set errorCode \"\"\n" "}\n" "if {![info exists errorInfo]} {\n" "set errorInfo \"\"\n" "}\n" "set savedErrorCode $errorCode\n" "set savedErrorInfo $errorInfo\n" "set name $cmd\n" "if {![info exists auto_noload]} {\n" "if {[info exists unknown_pending($name)]} {\n" "return -code error \"self-referential recursion in \\\"unknown\\\" for command \\\"$name\\\"\";\n" "}\n" "set unknown_pending($name) pending;\n" "set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]\n" "unset unknown_pending($name);\n" "if {$ret != 0} {\n" "append errorInfo \"\\n (autoloading \\\"$name\\\")\"\n" "return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg\n" "}\n" "if {![array size unknown_pending]} {\n" "unset unknown_pending\n" "}\n" "if {$msg} {\n" "set errorCode $savedErrorCode\n" "set errorInfo $savedErrorInfo\n" "set code [catch {uplevel 1 $args} msg]\n" "if {$code == 1} {\n" "set cinfo $args\n" "set ellipsis \"\"\n" "while {[string bytelength $cinfo] > 150} {\n" "set cinfo [string range $cinfo 0 end-1]\n" "set ellipsis \"...\"\n" "}\n" "append cinfo $ellipsis \"\\\"\\n (\\\"uplevel\\\" body line 1)\"\n" "append cinfo \"\\n invoked from within\"\n" "append cinfo \"\\n\\\"uplevel 1 \\$args\\\"\"\n" "set expect \"$msg\\n while executing\\n\\\"$cinfo\"\n" "if {$errorInfo eq $expect} {\n" "return -code error -errorcode $errorCode $msg\n" "}\n" "set expect \"\\n invoked from within\\n\\\"$cinfo\"\n" "set exlen [string length $expect]\n" "set eilen [string length $errorInfo]\n" "set i [expr {$eilen - $exlen - 1}]\n" "set einfo [string range $errorInfo 0 $i]\n" "if {$errorInfo ne \"$einfo$expect\"} {\n" "error \"Tcl bug: unexpected stack trace in \\\"unknown\\\"\" {} \\\n" "\011\011\011[list CORE UNKNOWN BADTRACE $expect $errorInfo]\n" "}\n" "return -code error -errorcode $errorCode \\\n" "\011\011\011-errorinfo $einfo $msg\n" "} else {\n" "return -code $code $msg\n" "}\n" "}\n" "}\n" "if {([info level] == 1) && [info script] eq \"\" \\\n" "\011 && [info exists tcl_interactive] && $tcl_interactive} {\n" "if {![info exists auto_noexec]} {\n" "set new [auto_execok $name]\n" "if {$new ne \"\"} {\n" "set errorCode $savedErrorCode\n" "set errorInfo $savedErrorInfo\n" "set redir \"\"\n" "if {[namespace which -command console] eq \"\"} {\n" "set redir \">&@stdout <@stdin\"\n" "}\n" "return [uplevel 1 exec $redir $new [lrange $args 1 end]]\n" "}\n" "}\n" "set errorCode $savedErrorCode\n" "set errorInfo $savedErrorInfo\n" "if {$name eq \"!!\"} {\n" "set newcmd [history event]\n" "} elseif {[regexp {^!(.+)$} $name -> event]} {\n" "set newcmd [history event $event]\n" "} elseif {[regexp {^\\^([^^]*)\\^([^^]*)\\^?$} $name -> 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 1 $newcmd]\n" "}\n" "set ret [catch {set candidates [info commands $name*]} msg]\n" "if {$name eq \"::\"} {\n" "set name \"\"\n" "}\n" "if {$ret != 0} {\n" "return -code $ret -errorcode $errorCode \\\n" "\011\011\"error in unknown while checking if \\\"$name\\\" is\\\n" "\011\011a unique command abbreviation:\\n$msg\"\n" "}\n" "if {$name eq \"\"} {\n" "if {[llength $candidates] != 1} {\n" "return -code error \"empty command name \\\"\\\"\"\n" "}\n" "return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]]\n" "}\n" "set cmds [list]\n" "foreach x $candidates {\n" "if {[string first $name $x] == 0} {\n" "lappend cmds $x\n" "}\n" "}\n" "if {[llength $cmds] == 1} {\n" "return [uplevel 1 [lreplace $args 0 0 [lindex $cmds 0]]]\n" "}\n" "if {[llength $cmds]} {\n" "return -code error \"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n" "}\n" "}\n" "return -code error \"invalid command name \\\"$name\\\"\"\n" "}\n" "proc auto_load {cmd {namespace {}}} {\n" "global auto_index auto_oldpath auto_path\n" "if {$namespace eq \"\"} {\n" "set namespace [uplevel 1 [list ::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" "namespace eval :: $auto_index($name)\n" "if {[namespace which -command $name] ne \"\"} {\n" "return 1\n" "}\n" "}\n" "}\n" "if {![info exists auto_path]} {\n" "return 0\n" "}\n" "if {![auto_load_index]} {\n" "return 0\n" "}\n" "foreach name $nameList {\n" "if {[info exists auto_index($name)]} {\n" "namespace eval :: $auto_index($name)\n" "if {[namespace which -command $name] ne \"\"} {\n" "return 1\n" "}\n" "}\n" "}\n" "return 0\n" "}\n" "proc auto_load_index {} {\n" "global auto_index auto_oldpath auto_path errorInfo errorCode\n" "if {[info exists auto_oldpath] && $auto_oldpath eq $auto_path} {\n" "return 0\n" "}\n" "set auto_oldpath $auto_path\n" "set issafe [interp issafe]\n" "for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {\n" "set dir [lindex $auto_path $i]\n" "set f \"\"\n" "if {$issafe} {\n" "catch {source [file join $dir tclIndex]}\n" "} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {\n" "continue\n" "} else {\n" "set error [catch {\n" "set id [gets $f]\n" "if {$id eq \"# Tcl autoload index file, version 2.0\"} {\n" "eval [read $f]\n" "} elseif {$id eq \"# Tcl autoload index file: each line identifies a Tcl\"} {\n" "while {[gets $f line] >= 0} {\n" "if {[string index $line 0] eq \"#\" \n" "|| ([llength $line] != 2)} {\n" "continue\n" "}\n" "set name [lindex $line 0]\n" "set auto_index($name) \\\n" "\011\011\011\011\"source [file join $dir [lindex $line 1]]\"\n" "}\n" "} else {\n" "error \"[file join $dir tclIndex] isn't a proper Tcl index file\"\n" "}\n" "} msg]\n" "if {$f ne \"\"} {\n" "close $f\n" "}\n" "if {$error} {\n" "error $msg $errorInfo $errorCode\n" "}\n" "}\n" "}\n" "return 1\n" "}\n" "proc auto_qualify {cmd namespace} {\n" "set n [regsub -all {::+} $cmd :: cmd]\n" "if {[string match ::* $cmd]} {\n" "if {$n > 1} {\n" "return [list $cmd]\n" "} else {\n" "return [list [string range $cmd 2 end]]\n" "}\n" "}\n" "if {$n == 0} {\n" "if {$namespace eq \"::\"} {\n" "return [list $cmd]\n" "} else {\n" "return [list ${namespace}::$cmd $cmd]\n" "}\n" "} elseif {$namespace eq \"::\"} {\n" "return [list ::$cmd]\n" "} else {\n" "return [list ${namespace}::$cmd ::$cmd]\n" "}\n" "}\n" "proc auto_import {pattern} {\n" "global auto_index\n" "if {![string match *::* $pattern]} {\n" "return\n" "}\n" "set ns [uplevel 1 [list ::namespace current]]\n" "set patternList [auto_qualify $pattern $ns]\n" "auto_load_index\n" "foreach pattern $patternList {\n" "foreach name [array names auto_index $pattern] {\n" "if {([namespace which -command $name] eq \"\")\n" "&& ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {\n" "namespace eval :: $auto_index($name)\n" "}\n" "}\n" "}\n" "}\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "proc auto_execok name {\n" "global auto_execs env tcl_platform\n" "if {[info exists auto_execs($name)]} {\n" "return $auto_execs($name)\n" "}\n" "set auto_execs($name) \"\"\n" "set shellBuiltins [list cls copy date del erase dir echo mkdir \\\n" "\011 md rename ren rmdir rd time type ver vol]\n" "if {$tcl_platform(os) eq \"Windows NT\"} {\n" "lappend shellBuiltins \"start\"\n" "}\n" "if {[info exists env(PATHEXT)]} {\n" "set execExtensions [split \";$env(PATHEXT)\" \";\"]\n" "} else {\n" "set execExtensions [list {} .com .exe .bat]\n" "}\n" "if {[lsearch -exact $shellBuiltins $name] != -1} {\n" "set cmd $env(COMSPEC)\n" "if {[file exists $cmd]} {\n" "set cmd [file attributes $cmd -shortname]\n" "}\n" "return [set auto_execs($name) [list $cmd /c $name]]\n" "}\n" "if {[llength [file split $name]] != 1} {\n" "foreach ext $execExtensions {\n" "set file ${name}${ext}\n" "if {[file exists $file] && ![file isdirectory $file]} {\n" "return [set auto_execs($name) [list $file]]\n" "}\n" "}\n" "return \"\"\n" "}\n" "set path \"[file dirname [info nameof]];.;\"\n" "if {[info exists env(WINDIR)]} {\n" "set windir $env(WINDIR) \n" "}\n" "if {[info exists windir]} {\n" "if {$tcl_platform(os) eq \"Windows NT\"} {\n" "append path \"$windir/system32;\"\n" "}\n" "append path \"$windir/system;$windir;\"\n" "}\n" "foreach var {PATH Path path} {\n" "if {[info exists env($var)]} {\n" "append path \";$env($var)\"\n" "}\n" "}\n" "foreach dir [split $path {;}] {\n" "if {[info exists checked($dir)] || $dir eq {}} { continue }\n" "set checked($dir) {}\n" "foreach ext $execExtensions {\n" "set file [file join $dir ${name}${ext}]\n" "if {[file exists $file] && ![file isdirectory $file]} {\n" "return [set auto_execs($name) [list $file]]\n" "}\n" "}\n" "}\n" "return \"\"\n" "}\n" "} else {\n" "proc auto_execok name {\n" "global auto_execs env\n" "if {[info exists auto_execs($name)]} {\n" "return $auto_execs($name)\n" "}\n" "set auto_execs($name) \"\"\n" "if {[llength [file split $name]] != 1} {\n" "if {[file executable $name] && ![file isdirectory $name]} {\n" "set auto_execs($name) [list $name]\n" "}\n" "return $auto_execs($name)\n" "}\n" "foreach dir [split $env(PATH) :] {\n" "if {$dir eq \"\"} {\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" "proc tcl::CopyDirectory {action src dest} {\n" "set nsrc [file normalize $src]\n" "set ndest [file normalize $dest]\n" "if {$action eq \"renaming\"} {\n" "if {[lsearch -exact [file volumes] $nsrc] != -1} {\n" "return -code error \"error $action \\\"$src\\\" to\\\n" "\011 \\\"$dest\\\": trying to rename a volume or move a directory\\\n" "\011 into itself\"\n" "}\n" "}\n" "if {[file exists $dest]} {\n" "if {$nsrc eq $ndest} {\n" "return -code error \"error $action \\\"$src\\\" to\\\n" "\011 \\\"$dest\\\": trying to rename a volume or move a directory\\\n" "\011 into itself\"\n" "}\n" "if {$action eq \"copying\"} {\n" "return -code error \"error $action \\\"$src\\\" to\\\n" "\011 \\\"$dest\\\": file already exists\"\n" "} else {\n" "set existing [glob -nocomplain -directory $dest * .*]\n" "eval [linsert \\\n" "\011\011 [glob -nocomplain -directory $dest -type hidden * .*] 0 \\\n" "\011\011 lappend existing]\n" "foreach s $existing {\n" "if {([file tail $s] ne \".\") && ([file tail $s] ne \"..\")} {\n" "return -code error \"error $action \\\"$src\\\" to\\\n" "\011\011 \\\"$dest\\\": file already exists\"\n" "}\n" "}\n" "}\n" "} else {\n" "if {[string first $nsrc $ndest] != -1} {\n" "set srclen [expr {[llength [file split $nsrc]] -1}]\n" "set ndest [lindex [file split $ndest] $srclen]\n" "if {$ndest eq [file tail $nsrc]} {\n" "return -code error \"error $action \\\"$src\\\" to\\\n" "\011\011 \\\"$dest\\\": trying to rename a volume or move a directory\\\n" "\011\011 into itself\"\n" "}\n" "}\n" "file mkdir $dest\n" "}\n" "set filelist [concat [glob -nocomplain -directory $src *] \\\n" " [glob -nocomplain -directory $src -types hidden *]]\n" "foreach s [lsort -unique $filelist] {\n" "if {([file tail $s] ne \".\") && ([file tail $s] ne \"..\")} {\n" "file copy $s [file join $dest [file tail $s]]\n" "}\n" "}\n" "return\n" "}\n" ; static unsigned char Et_zFile3[] = "proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {\n" "global env\n" "global argv\n" "if {[string equal $cc \"\"]} {\n" "set cc $env(CC)\n" "}\n" "if {[string equal $shlib_suffix \"\"]} {\n" "set shlib_cflags $env(SHLIB_CFLAGS)\n" "} elseif {[string equal $shlib_cflags \"none\"]} {\n" "set shlib_cflags $shlib_suffix\n" "}\n" "set seenDotO 0\n" "set minusO 0\n" "set head {}\n" "set tail {}\n" "set nmCommand {|nm -g}\n" "set entryProtos {}\n" "set entryPoints {}\n" "set libraries {}\n" "set libdirs {}\n" "foreach a $argv {\n" "if {!$minusO && [regexp {\\.[ao]$} $a]} {\n" "set seenDotO 1\n" "lappend nmCommand $a\n" "}\n" "if {$minusO} {\n" "set outputFile $a\n" "set minusO 0\n" "} elseif {![string compare $a -o]} {\n" "set minusO 1\n" "}\n" "if {[regexp {^-[lL]} $a]} {\n" "lappend libraries $a\n" "if {[regexp {^-L} $a]} {\n" "lappend libdirs [string range $a 2 end]\n" "}\n" "} elseif {$seenDotO} {\n" "lappend tail $a\n" "} else {\n" "lappend head $a\n" "}\n" "}\n" "lappend libdirs /lib /usr/lib\n" "set libs {}\n" "foreach lib $libraries {\n" "if {[regexp {^-l} $lib]} {\n" "set lname [string range $lib 2 end]\n" "foreach dir $libdirs {\n" "if {[file exists [file join $dir lib${lname}_G0.a]]} {\n" "set lname ${lname}_G0\n" "break\n" "}\n" "}\n" "lappend libs -l$lname\n" "} else {\n" "lappend libs $lib\n" "}\n" "}\n" "set libraries $libs\n" "if {![info exists outputFile]} {\n" "error \"-o option must be supplied to link a Tcl load module\"\n" "}\n" "set m [file tail $outputFile]\n" "if {[regexp {\\.a$} $outputFile]} {\n" "set shlib_suffix .a\n" "} else {\n" "set shlib_suffix \"\"\n" "}\n" "if {[regexp {\\..*$} $outputFile match]} {\n" "set l [expr {[string length $m] - [string length $match]}]\n" "} else {\n" "error \"Output file does not appear to have a suffix\"\n" "}\n" "set modName [string tolower $m 0 [expr {$l-1}]]\n" "if {[regexp {^lib} $modName]} {\n" "set modName [string range $modName 3 end]\n" "}\n" "if {[regexp {[0-9\\.]*(_g0)?$} $modName match]} {\n" "set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]\n" "}\n" "set modName [string totitle $modName]\n" "set f [open $nmCommand r]\n" "while {[gets $f l] >= 0} {\n" "if {[regexp {T[ \011]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {\n" "if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {\n" "set s $symbol\n" "}\n" "append entryProtos {extern int } $symbol { (); } \\n\n" "append entryPoints { } \\{ { \"} $s {\", } $symbol { } \\} , \\n\n" "}\n" "}\n" "close $f\n" "if {[string equal $entryPoints \"\"]} {\n" "error \"No entry point found in objects\"\n" "}\n" "set C {#include }\n" "append C \\n\n" "append C {char TclLoadLibraries_} $modName { [] =} \\n\n" "append C { \"@LIBS: } $libraries {\";} \\n\n" "append C $entryProtos\n" "append C {static struct } \\{ \\n\n" "append C { char * name;} \\n\n" "append C { int (*value)();} \\n\n" "append C \\} {dictionary [] = } \\{ \\n\n" "append C $entryPoints\n" "append C { 0, 0 } \\n \\} \\; \\n\n" "append C {typedef struct Tcl_Interp Tcl_Interp;} \\n\n" "append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \\n\n" "append C {Tcl_PackageInitProc *} \\n\n" "append C TclLoadDictionary_ $modName { (symbol)} \\n\n" "append C { CONST char * symbol;} \\n\n" "append C {\n" "{\n" "int i;\n" "for (i = 0; dictionary [i] . name != 0; ++i) {\n" "if (!strcmp (symbol, dictionary [i] . name)) {\n" "return dictionary [i].value;\n" "}\n" "}\n" "return 0;\n" "}\n" "}\n" "append C \\n\n" "set cFile tcl$modName.c\n" "set f [open $cFile w]\n" "puts -nonewline $f $C\n" "close $f\n" "set ccCommand \"$cc -c $shlib_cflags $cFile\"\n" "puts stderr $ccCommand\n" "eval exec $ccCommand\n" "if {[string equal $shlib_suffix \".a\"]} {\n" "set ldCommand \"ar cr $outputFile\"\n" "regsub { -o} $tail {} tail\n" "} else {\n" "set ldCommand ld\n" "foreach item $head {\n" "lappend ldCommand $item\n" "}\n" "}\n" "lappend ldCommand tcl$modName.o\n" "foreach item $tail {\n" "lappend ldCommand $item\n" "}\n" "puts stderr $ldCommand\n" "eval exec $ldCommand\n" "if {[string equal $shlib_suffix \".a\"]} {\n" "exec ranlib $outputFile\n" "}\n" "exec /bin/rm $cFile [file rootname $cFile].o\n" "}\n" ; static unsigned char Et_zFile4[] = "namespace eval ::pkg {\n" "}\n" "proc pkg_compareExtension { fileName {ext {}} } {\n" "global tcl_platform\n" "if {$ext eq \"\"} {set ext [info sharedlibextension]}\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "return [string equal -nocase [file extension $fileName] $ext]\n" "} else {\n" "set root $fileName\n" "while {1} {\n" "set currExt [file extension $root]\n" "if {$currExt eq $ext} {\n" "return 1\n" "} \n" "if { ![string is integer -strict [string range $currExt 1 end]] } {\n" "return 0\n" "}\n" "set root [file rootname $root]\n" "}\n" "}\n" "}\n" "proc pkg_mkIndex {args} {\n" "global errorCode errorInfo\n" "set usage {\"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?\"};\n" "set argCount [llength $args]\n" "if {$argCount < 1} {\n" "return -code error \"wrong # args: should be\\n$usage\"\n" "}\n" "set more \"\"\n" "set direct 1\n" "set doVerbose 0\n" "set loadPat \"\"\n" "for {set idx 0} {$idx < $argCount} {incr idx} {\n" "set flag [lindex $args $idx]\n" "switch -glob -- $flag {\n" "-- {\n" "incr idx\n" "break\n" "}\n" "-verbose {\n" "set doVerbose 1\n" "}\n" "-lazy {\n" "set direct 0\n" "append more \" -lazy\"\n" "}\n" "-direct {\n" "append more \" -direct\"\n" "}\n" "-load {\n" "incr idx\n" "set loadPat [lindex $args $idx]\n" "append more \" -load $loadPat\"\n" "}\n" "-* {\n" "return -code error \"unknown flag $flag: should be\\n$usage\"\n" "}\n" "default {\n" "break\n" "}\n" "}\n" "}\n" "set dir [lindex $args $idx]\n" "set patternList [lrange $args [expr {$idx + 1}] end]\n" "if {[llength $patternList] == 0} {\n" "set patternList [list \"*.tcl\" \"*[info sharedlibextension]\"]\n" "}\n" "set oldDir [pwd]\n" "cd $dir\n" "if {[catch {eval [linsert $patternList 0 glob --]} fileList]} {\n" "global errorCode errorInfo\n" "cd $oldDir\n" "return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList\n" "}\n" "foreach file $fileList {\n" "if {$file eq \"pkgIndex.tcl\"} {\n" "continue\n" "}\n" "cd $oldDir\n" "set c [interp create]\n" "if {$loadPat ne \"\"} {\n" "if {$doVerbose} {\n" "tclLog \"currently loaded packages: '[info loaded]'\"\n" "tclLog \"trying to load all packages matching $loadPat\"\n" "}\n" "if {![llength [info loaded]]} {\n" "tclLog \"warning: no packages are currently loaded, nothing\"\n" "tclLog \"can possibly match '$loadPat'\"\n" "}\n" "}\n" "foreach pkg [info loaded] {\n" "if {! [string match -nocase $loadPat [lindex $pkg 1]]} {\n" "continue\n" "}\n" "if {$doVerbose} {\n" "tclLog \"package [lindex $pkg 1] matches '$loadPat'\"\n" "}\n" "if {[catch {\n" "load [lindex $pkg 0] [lindex $pkg 1] $c\n" "} err]} {\n" "if {$doVerbose} {\n" "tclLog \"warning: load [lindex $pkg 0] [lindex $pkg 1]\\nfailed with: $err\"\n" "}\n" "} elseif {$doVerbose} {\n" "tclLog \"loaded [lindex $pkg 0] [lindex $pkg 1]\"\n" "}\n" "if {[lindex $pkg 1] eq \"Tk\"} {\n" "$c eval [list wm withdraw .]\n" "}\n" "}\n" "cd $dir\n" "$c eval {\n" "rename package __package_orig\n" "proc package {what args} {\n" "switch -- $what {\n" "require { return ; # ignore transitive requires }\n" "default { uplevel 1 [linsert $args 0 __package_orig $what] }\n" "}\n" "}\n" "proc tclPkgUnknown args {}\n" "package unknown tclPkgUnknown\n" "proc unknown {args} {}\n" "proc auto_import {args} {}\n" "namespace eval ::tcl {\n" "variable file\011\011;# Current file being processed\n" "variable direct\011\011;# -direct flag value\n" "variable x\011\011;# Loop variable\n" "variable debug\011\011;# For debugging\n" "variable type\011\011;# \"load\" or \"source\", for -direct\n" "variable namespaces\011;# Existing namespaces (e.g., ::tcl)\n" "variable packages\011;# Existing packages (e.g., Tcl)\n" "variable origCmds\011;# Existing commands\n" "variable newCmds\011;# Newly created commands\n" "variable newPkgs {}\011;# Newly created packages\n" "}\n" "}\n" "$c eval [list set ::tcl::file $file]\n" "$c eval [list set ::tcl::direct $direct]\n" "foreach p {pkg_compareExtension} {\n" "$c eval [list proc $p [info args $p] [info body $p]]\n" "}\n" "if {[catch {\n" "$c eval {\n" "set ::tcl::debug \"loading or sourcing\"\n" "proc ::tcl::GetAllNamespaces {{root ::}} {\n" "set list $root\n" "foreach ns [namespace children $root] {\n" "eval [linsert [::tcl::GetAllNamespaces $ns] 0 \\\n" "\011\011\011\011lappend list]\n" "}\n" "return $list\n" "}\n" "foreach ::tcl::x [::tcl::GetAllNamespaces] {\n" "set ::tcl::namespaces($::tcl::x) 1\n" "}\n" "foreach ::tcl::x [package names] {\n" "if {[package provide $::tcl::x] ne \"\"} {\n" "set ::tcl::packages($::tcl::x) 1\n" "}\n" "}\n" "set ::tcl::origCmds [info commands]\n" "if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {\n" "set ::tcl::debug loading\n" "load [file join . $::tcl::file]\n" "set ::tcl::type load\n" "} else {\n" "set ::tcl::debug sourcing\n" "source $::tcl::file\n" "set ::tcl::type source\n" "}\n" "if { !$::tcl::direct } {\n" "foreach ::tcl::x [::tcl::GetAllNamespaces] {\n" "if {! [info exists ::tcl::namespaces($::tcl::x)]} {\n" "namespace import -force ${::tcl::x}::*\n" "}\n" "foreach ::tcl::x [info commands] {\n" "set ::tcl::newCmds($::tcl::x) 1\n" "}\n" "foreach ::tcl::x $::tcl::origCmds {\n" "unset -nocomplain ::tcl::newCmds($::tcl::x)\n" "}\n" "foreach ::tcl::x [array names ::tcl::newCmds] {\n" "set ::tcl::abs [namespace origin $::tcl::x]\n" "set ::tcl::abs \\\n" "\011\011\011\011 [lindex [auto_qualify $::tcl::abs ::] 0]\n" "if {$::tcl::x ne $::tcl::abs} {\n" "set ::tcl::newCmds($::tcl::abs) 1\n" "unset ::tcl::newCmds($::tcl::x)\n" "}\n" "}\n" "}\n" "}\n" "foreach ::tcl::x [package names] {\n" "if {[package provide $::tcl::x] ne \"\"\n" "&& ![info exists ::tcl::packages($::tcl::x)]} {\n" "lappend ::tcl::newPkgs \\\n" "\011\011\011 [list $::tcl::x [package provide $::tcl::x]]\n" "}\n" "}\n" "}\n" "} msg] == 1} {\n" "set what [$c eval set ::tcl::debug]\n" "if {$doVerbose} {\n" "tclLog \"warning: error while $what $file: $msg\"\n" "}\n" "} else {\n" "set what [$c eval set ::tcl::debug]\n" "if {$doVerbose} {\n" "tclLog \"successful $what of $file\"\n" "}\n" "set type [$c eval set ::tcl::type]\n" "set cmds [lsort [$c eval array names ::tcl::newCmds]]\n" "set pkgs [$c eval set ::tcl::newPkgs]\n" "if {$doVerbose} {\n" "if { !$direct } {\n" "tclLog \"commands provided were $cmds\"\n" "}\n" "tclLog \"packages provided were $pkgs\"\n" "}\n" "if {[llength $pkgs] > 1} {\n" "tclLog \"warning: \\\"$file\\\" provides more than one package ($pkgs)\"\n" "}\n" "foreach pkg $pkgs {\n" "lappend files($pkg) [list $file $type $cmds]\n" "}\n" "if {$doVerbose} {\n" "tclLog \"processed $file\"\n" "}\n" "}\n" "interp delete $c\n" "}\n" "append index \"# Tcl package index file, version 1.1\\n\"\n" "append index \"# This file is generated by the \\\"pkg_mkIndex$more\\\" command\\n\"\n" "append index \"# and sourced either when an application starts up or\\n\"\n" "append index \"# by a \\\"package unknown\\\" script. It invokes the\\n\"\n" "append index \"# \\\"package ifneeded\\\" command to set up package-related\\n\"\n" "append index \"# information so that packages will be loaded automatically\\n\"\n" "append index \"# in response to \\\"package require\\\" commands. When this\\n\"\n" "append index \"# script is sourced, the variable \\$dir must contain the\\n\"\n" "append index \"# full path name of this file's directory.\\n\"\n" "foreach pkg [lsort [array names files]] {\n" "set cmd {}\n" "foreach {name version} $pkg {\n" "break\n" "}\n" "lappend cmd ::pkg::create -name $name -version $version\n" "foreach spec $files($pkg) {\n" "foreach {file type procs} $spec {\n" "if { $direct } {\n" "set procs {}\n" "}\n" "lappend cmd \"-$type\" [list $file $procs]\n" "}\n" "}\n" "append index \"\\n[eval $cmd]\"\n" "}\n" "set f [open pkgIndex.tcl w]\n" "puts $f $index\n" "close $f\n" "cd $oldDir\n" "}\n" "proc tclPkgSetup {dir pkg version files} {\n" "global auto_index\n" "package provide $pkg $version\n" "foreach fileInfo $files {\n" "set f [lindex $fileInfo 0]\n" "set type [lindex $fileInfo 1]\n" "foreach cmd [lindex $fileInfo 2] {\n" "if {$type eq \"load\"} {\n" "set auto_index($cmd) [list load [file join $dir $f] $pkg]\n" "} else {\n" "set auto_index($cmd) [list source [file join $dir $f]]\n" "} \n" "}\n" "}\n" "}\n" "proc tclPkgUnknown {name version {exact {}}} {\n" "global auto_path env\n" "if {![info exists auto_path]} {\n" "return\n" "}\n" "set old_path [set use_path $auto_path]\n" "while {[llength $use_path]} {\n" "set dir [lindex $use_path end]\n" "if {[info exists tclSeenPath($dir)]} {\n" "set use_path [lrange $use_path 0 end-1]\n" "continue\n" "}\n" "set tclSeenPath($dir) 1\n" "catch {\n" "foreach file [glob -directory $dir -join -nocomplain \\\n" "\011\011 * pkgIndex.tcl] {\n" "set dir [file dirname $file]\n" "if {![info exists procdDirs($dir)] && [file readable $file]} {\n" "if {[catch {source $file} msg]} {\n" "tclLog \"error reading package index file $file: $msg\"\n" "} else {\n" "set procdDirs($dir) 1\n" "}\n" "}\n" "}\n" "}\n" "set dir [lindex $use_path end]\n" "if {![info exists procdDirs($dir)]} {\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" "} else {\n" "set procdDirs($dir) 1\n" "}\n" "}\n" "}\n" "set use_path [lrange $use_path 0 end-1]\n" "set index 0\n" "if {[llength $old_path] == [llength $auto_path]} {\n" "foreach dir $auto_path old $old_path {\n" "if {$dir ne $old} {\n" "break\n" "}\n" "incr index\n" "}\n" "}\n" "foreach dir [lrange $auto_path $index end] {\n" "if {![info exists tclSeenPath($dir)] \n" "&& ([lsearch -exact $use_path $dir] == -1) } {\n" "lappend use_path $dir\n" "}\n" "}\n" "set old_path $auto_path\n" "}\n" "}\n" "proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {\n" "uplevel 1 $original [list $name $version $exact]\n" "global auto_path\n" "if {![info exists auto_path]} {\n" "return\n" "}\n" "set old_path [set use_path $auto_path]\n" "while {[llength $use_path]} {\n" "set dir [lindex $use_path end]\n" "foreach file [glob -directory $dir -join -nocomplain \\\n" "\011\011* Resources Scripts pkgIndex.tcl] {\n" "set dir [file dirname $file]\n" "if {[file readable $file] && ![info exists procdDirs($dir)]} {\n" "if {[catch {source $file} msg]} {\n" "tclLog \"error reading package index file $file: $msg\"\n" "} else {\n" "set procdDirs($dir) 1\n" "}\n" "}\n" "}\n" "set use_path [lrange $use_path 0 end-1]\n" "if {$old_path ne $auto_path} {\n" "foreach dir $auto_path {\n" "lappend use_path $dir\n" "}\n" "set old_path $auto_path\n" "}\n" "}\n" "}\n" "proc tcl::MacPkgUnknown {original name version {exact {}}} {\n" "uplevel 1 $original [list $name $version $exact]\n" "global auto_path\n" "if {![info exists auto_path]} {\n" "return\n" "}\n" "set old_path [set use_path $auto_path]\n" "while {[llength $use_path]} {\n" "set dir [lindex $use_path end]\n" "foreach x [concat [list $dir] [glob -directory $dir -nocomplain *] ] {\n" "if {[file isdirectory $x] && ![info exists procdDirs($x)]} {\n" "set dir $x\n" "foreach x [glob -directory $dir -nocomplain *.shlb] {\n" "if {[file isfile $x]} {\n" "set res [resource open $x]\n" "foreach y [resource list TEXT $res] {\n" "if {$y eq \"pkgIndex\"} {source -rsrc pkgIndex}\n" "}\n" "catch {resource close $res}\n" "}\n" "}\n" "set procdDirs($dir) 1\n" "}\n" "}\n" "set use_path [lrange $use_path 0 end-1]\n" "if {$old_path ne $auto_path} {\n" "foreach dir $auto_path {\n" "lappend use_path $dir\n" "}\n" "set old_path $auto_path\n" "}\n" "}\n" "}\n" "proc ::pkg::create {args} {\n" "append err(usage) \"[lindex [info level 0] 0] \"\n" "append err(usage) \"-name packageName -version packageVersion\"\n" "append err(usage) \"?-load {filename ?{procs}?}? ... \"\n" "append err(usage) \"?-source {filename ?{procs}?}? ...\"\n" "set err(wrongNumArgs) \"wrong # args: should be \\\"$err(usage)\\\"\"\n" "set err(valueMissing) \"value for \\\"%s\\\" missing: should be \\\"$err(usage)\\\"\"\n" "set err(unknownOpt) \"unknown option \\\"%s\\\": should be \\\"$err(usage)\\\"\"\n" "set err(noLoadOrSource) \"at least one of -load and -source must be given\"\n" "set len [llength $args]\n" "if { $len < 6 } {\n" "error $err(wrongNumArgs)\n" "}\n" "set opts(-name)\011\011{}\n" "set opts(-version)\011\011{}\n" "set opts(-source)\011\011{}\n" "set opts(-load)\011\011{}\n" "for {set i 0} {$i < $len} {incr i} {\n" "set flag [lindex $args $i]\n" "incr i\n" "switch -glob -- $flag {\n" "\"-name\"\011\011-\n" "\"-version\"\011\011{\n" "if { $i >= $len } {\n" "error [format $err(valueMissing) $flag]\n" "}\n" "set opts($flag) [lindex $args $i]\n" "}\n" "\"-source\"\011\011-\n" "\"-load\"\011\011{\n" "if { $i >= $len } {\n" "error [format $err(valueMissing) $flag]\n" "}\n" "lappend opts($flag) [lindex $args $i]\n" "}\n" "default {\n" "error [format $err(unknownOpt) [lindex $args $i]]\n" "}\n" "}\n" "}\n" "if { [llength $opts(-name)] == 0 } {\n" "error [format $err(valueMissing) \"-name\"]\n" "}\n" "if { [llength $opts(-version)] == 0 } {\n" "error [format $err(valueMissing) \"-version\"]\n" "}\n" "if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {\n" "error $err(noLoadOrSource)\n" "}\n" "set cmdline \"package ifneeded $opts(-name) $opts(-version) \"\n" "set cmdList {}\n" "set lazyFileList {}\n" "foreach key {load source} {\n" "foreach filespec $opts(-$key) {\n" "foreach {filename proclist} {{} {}} {\n" "break\n" "}\n" "foreach {filename proclist} $filespec {\n" "break\n" "}\n" "if { [llength $proclist] == 0 } {\n" "set cmd \"\\[list $key \\[file join \\$dir [list $filename]\\]\\]\"\n" "lappend cmdList $cmd\n" "} else {\n" "lappend lazyFileList [list $filename $key $proclist]\n" "}\n" "}\n" "}\n" "if { [llength $lazyFileList] > 0 } {\n" "lappend cmdList \"\\[list tclPkgSetup \\$dir $opts(-name)\\\n" "\011\011$opts(-version) [list $lazyFileList]\\]\"\n" "}\n" "append cmdline [join $cmdList \"\\\\n\"]\n" "return $cmdline\n" "}\n" ; static unsigned char Et_zFile5[] = "proc parray {a {pattern *}} {\n" "upvar 1 $a array\n" "if {![array exists array]} {\n" "error \"\\\"$a\\\" isn't an array\"\n" "}\n" "set maxl 0\n" "foreach name [lsort [array names array $pattern]] {\n" "if {[string length $name] > $maxl} {\n" "set maxl [string length $name]\n" "}\n" "}\n" "set maxl [expr {$maxl + [string length $a] + 2}]\n" "foreach name [lsort [array names array $pattern]] {\n" "set nameString [format %s(%s) $a $name]\n" "puts stdout [format \"%-*s = %s\" $maxl $nameString $array($name)]\n" "}\n" "}\n" ; static unsigned char Et_zFile6[] = "package require opt 0.4.1;\n" "namespace eval ::safe {\n" "namespace export interpCreate interpInit interpConfigure interpDelete \\\n" "\011 interpAddToAccessPath interpFindInAccessPath setLogCmd\n" "variable temp\n" "set temp [::tcl::OptKeyRegister {\n" "{-accessPath -list {} \"access path for the slave\"}\n" "{-noStatics \"prevent loading of statically linked pkgs\"}\n" "{-statics true \"loading of statically linked pkgs\"}\n" "{-nestedLoadOk \"allow nested loading\"}\n" "{-nested false \"nested loading\"}\n" "{-deleteHook -script {} \"delete hook\"}\n" "}]\n" "::tcl::OptKeyRegister {\n" "{?slave? -name {} \"name of the slave (optional)\"}\n" "} ::safe::interpCreate\n" "lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)\n" "::tcl::OptKeyRegister {\n" "{slave -name {} \"name of the slave\"}\n" "} ::safe::interpIC\n" "lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)\n" "::tcl::OptKeyDelete $temp\n" "proc InterpStatics {} {\n" "foreach v {Args statics noStatics} {\n" "upvar $v $v\n" "}\n" "set flag [::tcl::OptProcArgGiven -noStatics];\n" "if {$flag && (!$noStatics == !$statics) \n" "&& ([::tcl::OptProcArgGiven -statics])} {\n" "return -code error\\\n" "\011\011 \"conflicting values given for -statics and -noStatics\"\n" "}\n" "if {$flag} {\n" "return [expr {!$noStatics}]\n" "} else {\n" "return $statics\n" "}\n" "}\n" "proc InterpNested {} {\n" "foreach v {Args nested nestedLoadOk} {\n" "upvar $v $v\n" "}\n" "set flag [::tcl::OptProcArgGiven -nestedLoadOk];\n" "if {$flag && (!$nestedLoadOk != !$nested) \n" "&& ([::tcl::OptProcArgGiven -nested])} {\n" "return -code error\\\n" "\011\011 \"conflicting values given for -nested and -nestedLoadOk\"\n" "}\n" "if {$flag} {\n" "return $nestedLoadOk\n" "} else {\n" "return $nested\n" "}\n" "}\n" "proc interpCreate {args} {\n" "set Args [::tcl::OptKeyParse ::safe::interpCreate $args]\n" "InterpCreate $slave $accessPath \\\n" "\011\011[InterpStatics] [InterpNested] $deleteHook\n" "}\n" "proc interpInit {args} {\n" "set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n" "if {![::interp exists $slave]} {\n" "return -code error \"\\\"$slave\\\" is not an interpreter\"\n" "}\n" "InterpInit $slave $accessPath \\\n" "\011\011[InterpStatics] [InterpNested] $deleteHook;\n" "}\n" "proc CheckInterp {slave} {\n" "if {![IsInterp $slave]} {\n" "return -code error \\\n" "\011\011 \"\\\"$slave\\\" is not an interpreter managed by ::safe::\"\n" "}\n" "}\n" "proc interpConfigure {args} {\n" "switch [llength $args] {\n" "1 {\n" "set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n" "CheckInterp $slave\n" "set res {}\n" "lappend res [list -accessPath [Set [PathListName $slave]]]\n" "lappend res [list -statics [Set [StaticsOkName $slave]]]\n" "lappend res [list -nested [Set [NestedOkName $slave]]]\n" "lappend res [list -deleteHook [Set [DeleteHookName $slave]]]\n" "join $res\n" "}\n" "2 {\n" "::tcl::Lassign $args slave arg\n" "set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]\n" "set hits [::tcl::OptHits desc $arg]\n" "if {$hits > 1} {\n" "return -code error [::tcl::OptAmbigous $desc $arg]\n" "} elseif {$hits == 0} {\n" "return -code error [::tcl::OptFlagUsage $desc $arg]\n" "}\n" "CheckInterp $slave\n" "set item [::tcl::OptCurDesc $desc]\n" "set name [::tcl::OptName $item]\n" "switch -exact -- $name {\n" "-accessPath {\n" "return [list -accessPath [Set [PathListName $slave]]]\n" "}\n" "-statics {\n" "return [list -statics [Set [StaticsOkName $slave]]]\n" "}\n" "-nested {\n" "return [list -nested [Set [NestedOkName $slave]]]\n" "}\n" "-deleteHook {\n" "return [list -deleteHook [Set [DeleteHookName $slave]]]\n" "}\n" "-noStatics {\n" "return -code error\\\n" "\011\011\011\011\"ambigous query (get or set -noStatics ?)\\\n" "\011\011\011\011use -statics instead\"\n" "}\n" "-nestedLoadOk {\n" "return -code error\\\n" "\011\011\011\011\"ambigous query (get or set -nestedLoadOk ?)\\\n" "\011\011\011\011use -nested instead\"\n" "}\n" "default {\n" "return -code error \"unknown flag $name (bug)\"\n" "}\n" "}\n" "}\n" "default {\n" "set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n" "CheckInterp $slave\n" "if {![::tcl::OptProcArgGiven -accessPath]} {\n" "set doreset 1\n" "set accessPath [Set [PathListName $slave]]\n" "} else {\n" "set doreset 0\n" "}\n" "if {(![::tcl::OptProcArgGiven -statics]) \\\n" "\011\011\011&& (![::tcl::OptProcArgGiven -noStatics]) } {\n" "set statics [Set [StaticsOkName $slave]]\n" "} else {\n" "set statics [InterpStatics]\n" "}\n" "if {([::tcl::OptProcArgGiven -nested]) \\\n" "\011\011\011|| ([::tcl::OptProcArgGiven -nestedLoadOk]) } {\n" "set nested [InterpNested]\n" "} else {\n" "set nested [Set [NestedOkName $slave]]\n" "}\n" "if {![::tcl::OptProcArgGiven -deleteHook]} {\n" "set deleteHook [Set [DeleteHookName $slave]]\n" "}\n" "InterpSetConfig $slave $accessPath $statics $nested $deleteHook\n" "if {$doreset} {\n" "if {[catch {::interp eval $slave {auto_reset}} msg]} {\n" "Log $slave \"auto_reset failed: $msg\"\n" "} else {\n" "Log $slave \"successful auto_reset\" NOTICE\n" "}\n" "}\n" "}\n" "}\n" "}\n" "proc ::safe::InterpCreate {\n" "slave \n" "access_path\n" "staticsok\n" "nestedok\n" "deletehook\n" "} {\n" "if {$slave ne \"\"} {\n" "::interp create -safe $slave\n" "} else {\n" "set slave [::interp create -safe]\n" "}\n" "Log $slave \"Created\" NOTICE\n" "InterpInit $slave $access_path $staticsok $nestedok $deletehook\n" "}\n" "proc ::safe::InterpSetConfig {slave access_path staticsok\\\n" "\011 nestedok deletehook} {\n" "if {$access_path eq \"\"} {\n" "set access_path [uplevel \\#0 set auto_path]\n" "set where [lsearch -exact $access_path [info library]]\n" "if {$where == -1} {\n" "set access_path [concat [list [info library]] $access_path]\n" "Log $slave \"tcl_library was not in auto_path,\\\n" "\011\011\011added it to slave's access_path\" NOTICE\n" "} elseif {$where != 0} {\n" "set access_path [concat [list [info library]]\\\n" "\011\011\011[lreplace $access_path $where $where]]\n" "Log $slave \"tcl_libray was not in first in auto_path,\\\n" "\011\011\011moved it to front of slave's access_path\" NOTICE\n" "}\n" "set access_path [AddSubDirs $access_path]\n" "}\n" "Log $slave \"Setting accessPath=($access_path) staticsok=$staticsok\\\n" "\011\011nestedok=$nestedok deletehook=($deletehook)\" NOTICE\n" "set nname [PathNumberName $slave]\n" "if {[Exists $nname]} {\n" "set n [Set $nname]\n" "for {set i 0} {$i<$n} {incr i} {\n" "Unset [PathToken $i $slave]\n" "}\n" "}\n" "set slave_auto_path {}\n" "set i 0\n" "foreach dir $access_path {\n" "Set [PathToken $i $slave] $dir\n" "lappend slave_auto_path \"\\$[PathToken $i]\"\n" "incr i\n" "}\n" "Set $nname $i\n" "Set [PathListName $slave] $access_path\n" "Set [VirtualPathListName $slave] $slave_auto_path\n" "Set [StaticsOkName $slave] $staticsok\n" "Set [NestedOkName $slave] $nestedok\n" "Set [DeleteHookName $slave] $deletehook\n" "SyncAccessPath $slave\n" "}\n" "proc ::safe::interpFindInAccessPath {slave path} {\n" "set access_path [GetAccessPath $slave]\n" "set where [lsearch -exact $access_path $path]\n" "if {$where == -1} {\n" "return -code error \"$path not found in access path $access_path\"\n" "}\n" "return \"\\$[PathToken $where]\"\n" "}\n" "proc ::safe::interpAddToAccessPath {slave path} {\n" "if {![catch {interpFindInAccessPath $slave $path} res]} {\n" "return $res\n" "}\n" "set nname [PathNumberName $slave]\n" "set n [Set $nname]\n" "Set [PathToken $n $slave] $path\n" "set token \"\\$[PathToken $n]\"\n" "Lappend [VirtualPathListName $slave] $token\n" "Lappend [PathListName $slave] $path\n" "Set $nname [expr {$n+1}]\n" "SyncAccessPath $slave\n" "return $token\n" "}\n" "proc ::safe::InterpInit {\n" "slave \n" "access_path\n" "staticsok\n" "nestedok\n" "deletehook\n" "} {\n" "InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook\n" "::interp alias $slave source {} [namespace current]::AliasSource $slave\n" "::interp alias $slave load {} [namespace current]::AliasLoad $slave\n" "::interp alias $slave encoding {} [namespace current]::AliasEncoding \\\n" "\011\011$slave\n" "AliasSubset $slave file file dir.* join root.* ext.* tail \\\n" "\011\011path.* split\n" "::interp alias $slave exit {} [namespace current]::interpDelete $slave\n" "if {[catch {::interp eval $slave\\\n" "\011\011{source [file join $tcl_library init.tcl]}} msg]} {\n" "Log $slave \"can't source init.tcl ($msg)\"\n" "error \"can't source init.tcl into slave $slave ($msg)\"\n" "}\n" "return $slave\n" "}\n" "proc AddSubDirs {pathList} {\n" "set res {}\n" "foreach dir $pathList {\n" "if {[file isdirectory $dir]} {\n" "if {[lsearch -exact $res $dir]<0} {\n" "lappend res $dir\n" "}\n" "foreach sub [glob -directory $dir -nocomplain *] {\n" "if {([file isdirectory $sub]) \\\n" "\011\011\011 && ([lsearch -exact $res $sub]<0) } {\n" "lappend res $sub\n" "}\n" "}\n" "}\n" "}\n" "return $res\n" "}\n" "proc ::safe::interpDelete {slave} {\n" "Log $slave \"About to delete\" NOTICE\n" "set hookname [DeleteHookName $slave]\n" "if {[Exists $hookname]} {\n" "set hook [Set $hookname]\n" "if {![::tcl::Lempty $hook]} {\n" "Unset $hookname\n" "if {[catch {eval $hook [list $slave]} err]} {\n" "Log $slave \"Delete hook error ($err)\"\n" "}\n" "}\n" "}\n" "set statename [InterpStateName $slave]\n" "if {[Exists $statename]} {\n" "Unset $statename\n" "}\n" "if {[::interp exists $slave]} {\n" "::interp delete $slave\n" "Log $slave \"Deleted\" NOTICE\n" "}\n" "return\n" "}\n" "proc ::safe::setLogCmd {args} {\n" "variable Log\n" "if {[llength $args] == 0} {\n" "return $Log\n" "} else {\n" "if {[llength $args] == 1} {\n" "set Log [lindex $args 0]\n" "} else {\n" "set Log $args\n" "}\n" "}\n" "}\n" "variable Log {}\n" "proc SyncAccessPath {slave} {\n" "set slave_auto_path [Set [VirtualPathListName $slave]]\n" "::interp eval $slave [list set auto_path $slave_auto_path]\n" "Log $slave \"auto_path in $slave has been set to $slave_auto_path\"\\\n" "\011\011NOTICE\n" "::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]]\n" "}\n" "proc InterpStateName {slave} {\n" "return \"S$slave\"\n" "}\n" "proc IsInterp {slave} {\n" "expr {[Exists [InterpStateName $slave]] && [::interp exists $slave]}\n" "}\n" "proc PathToken {n {slave \"\"}} {\n" "if {$slave ne \"\"} {\n" "return \"[InterpStateName $slave](access_path,$n)\"\n" "} else {\n" "return \"p(:$n:)\"\n" "}\n" "}\n" "proc PathListName {slave} {\n" "return \"[InterpStateName $slave](access_path)\"\n" "}\n" "proc VirtualPathListName {slave} {\n" "return \"[InterpStateName $slave](access_path_slave)\"\n" "}\n" "proc PathNumberName {slave} {\n" "return \"[InterpStateName $slave](access_path,n)\"\n" "}\n" "proc StaticsOkName {slave} {\n" "return \"[InterpStateName $slave](staticsok)\"\n" "}\n" "proc NestedOkName {slave} {\n" "return \"[InterpStateName $slave](nestedok)\"\n" "}\n" "proc Toplevel {args} {\n" "namespace eval [namespace current] $args\n" "}\n" "proc Set {args} {\n" "eval [linsert $args 0 Toplevel set]\n" "}\n" "proc Lappend {args} {\n" "eval [linsert $args 0 Toplevel lappend]\n" "}\n" "proc Unset {args} {\n" "eval [linsert $args 0 Toplevel unset]\n" "}\n" "proc Exists {varname} {\n" "Toplevel info exists $varname\n" "}\n" "proc GetAccessPath {slave} {\n" "Set [PathListName $slave]\n" "}\n" "proc StaticsOk {slave} {\n" "Set [StaticsOkName $slave]\n" "}\n" "proc NestedOk {slave} {\n" "Set [NestedOkName $slave]\n" "}\n" "proc DeleteHookName {slave} {\n" "return [InterpStateName $slave](cleanupHook)\n" "}\n" "proc TranslatePath {slave path} {\n" "if {[regexp {(::)|(\\.\\.)} $path]} {\n" "error \"invalid characters in path $path\"\n" "}\n" "set n [expr {[Set [PathNumberName $slave]]-1}]\n" "for {} {$n>=0} {incr n -1} {\n" "set [PathToken $n] [Set [PathToken $n $slave]]\n" "}\n" "subst -nobackslashes -nocommands $path\n" "}\n" "proc Log {slave msg {type ERROR}} {\n" "variable Log\n" "if {[info exists Log] && [llength $Log]} {\n" "eval $Log [list \"$type for slave $slave : $msg\"]\n" "}\n" "}\n" "proc CheckFileName {slave file} {\n" "if {![file exists $file]} {\n" "error \"no such file or directory\"\n" "}\n" "if {![file readable $file]} {\n" "error \"not readable\"\n" "}\n" "}\n" "proc AliasSource {slave args} {\n" "set argc [llength $args]\n" "if {$argc != 1} {\n" "set msg \"wrong # args: should be \\\"source fileName\\\"\"\n" "Log $slave \"$msg ($args)\"\n" "return -code error $msg\n" "}\n" "set file [lindex $args 0]\n" "if {[catch {set file [TranslatePath $slave $file]} msg]} {\n" "Log $slave $msg\n" "return -code error \"permission denied\"\n" "}\n" "if {[catch {FileInAccessPath $slave $file} msg]} {\n" "Log $slave $msg\n" "return -code error \"permission denied\"\n" "}\n" "if {[catch {CheckFileName $slave $file} msg]} {\n" "Log $slave \"$file:$msg\"\n" "return -code error $msg\n" "}\n" "if {[catch {::interp invokehidden $slave source $file} msg]} {\n" "Log $slave $msg\n" "return -code error \"script error\"\n" "}\n" "return $msg\n" "}\n" "proc AliasLoad {slave file args} {\n" "set argc [llength $args]\n" "if {$argc > 2} {\n" "set msg \"load error: too many arguments\"\n" "Log $slave \"$msg ($argc) {$file $args}\"\n" "return -code error $msg\n" "}\n" "set package [lindex $args 0]\n" "set target [lindex $args 1]\n" "if {$target ne \"\"} {\n" "if {![NestedOk $slave]} {\n" "Log $slave \"loading to a sub interp (nestedok)\\\n" "\011\011\011disabled (trying to load $package to $target)\"\n" "return -code error \"permission denied (nested load)\"\n" "}\n" "}\n" "if {$file eq \"\"} {\n" "if {$package eq \"\"} {\n" "set msg \"load error: empty filename and no package name\"\n" "Log $slave $msg\n" "return -code error $msg\n" "}\n" "if {![StaticsOk $slave]} {\n" "Log $slave \"static packages loading disabled\\\n" "\011\011\011(trying to load $package to $target)\"\n" "return -code error \"permission denied (static package)\"\n" "}\n" "} else {\n" "if {[catch {set file [TranslatePath $slave $file]} msg]} {\n" "Log $slave $msg\n" "return -code error \"permission denied\"\n" "}\n" "if {[catch {FileInAccessPath $slave $file} msg]} {\n" "Log $slave $msg\n" "return -code error \"permission denied (path)\"\n" "}\n" "}\n" "if {[catch {::interp invokehidden\\\n" "\011\011$slave load $file $package $target} msg]} {\n" "Log $slave $msg\n" "return -code error $msg\n" "}\n" "return $msg\n" "}\n" "proc FileInAccessPath {slave file} {\n" "set access_path [GetAccessPath $slave]\n" "if {[file isdirectory $file]} {\n" "error \"\\\"$file\\\": is a directory\"\n" "}\n" "set parent [file dirname $file]\n" "set norm_parent [file normalize $parent]\n" "foreach path $access_path {\n" "lappend norm_access_path [file normalize $path]\n" "}\n" "if {[lsearch -exact $norm_access_path $norm_parent] == -1} {\n" "error \"\\\"$file\\\": not in access_path\"\n" "}\n" "}\n" "proc Subset {slave command okpat args} {\n" "set subcommand [lindex $args 0]\n" "if {[regexp $okpat $subcommand]} {\n" "return [eval [linsert $args 0 $command]]\n" "}\n" "set msg \"not allowed to invoke subcommand $subcommand of $command\"\n" "Log $slave $msg\n" "error $msg\n" "}\n" "proc AliasSubset {slave alias target args} {\n" "set pat ^(; set sep \"\"\n" "foreach sub $args {\n" "append pat $sep$sub\n" "set sep |\n" "}\n" "append pat )\\$\n" "::interp alias $slave $alias {}\\\n" "\011\011[namespace current]::Subset $slave $target $pat\n" "}\n" "proc AliasEncoding {slave args} {\n" "set argc [llength $args]\n" "set okpat \"^(name.*|convert.*)\\$\"\n" "set subcommand [lindex $args 0]\n" "if {[regexp $okpat $subcommand]} {\n" "return [eval [linsert $args 0 \\\n" "\011\011 ::interp invokehidden $slave encoding]]\n" "}\n" "if {[string first $subcommand system] == 0} {\n" "if {$argc == 1} {\n" "if {[catch {::interp invokehidden \\\n" "\011\011\011$slave encoding system} msg]} {\n" "Log $slave $msg\n" "return -code error \"script error\"\n" "}\n" "} else {\n" "set msg \"wrong # args: should be \\\"encoding system\\\"\"\n" "Log $slave $msg\n" "error $msg\n" "}\n" "} else {\n" "set msg \"wrong # args: should be \\\"encoding option ?arg ...?\\\"\"\n" "Log $slave $msg\n" "error $msg\n" "}\n" "return $msg\n" "}\n" "}\n" ; static unsigned char Et_zFile7[] = "# Tcl autoload index file, version 2.0\n" "# This file is generated by the \"auto_mkindex\" command\n" "# and sourced to set up indexing information for one or\n" "# more commands. Typically each line is a command that\n" "# sets an element in the auto_index array, where the\n" "# element name is the name of a command and the value is\n" "# a script that loads the command.\n" "\n" "set auto_index(auto_reset) [list source [file join $dir auto.tcl]]\n" "set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]\n" "set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]\n" "set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]\n" "set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]\n" "set auto_index(history) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]\n" "set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]\n" "set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]\n" "set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]]\n" "set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]\n" "set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]\n" "set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]\n" "set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]]\n" "set auto_index(::tcl::MacPkgUnknown) [list source [file join $dir package.tcl]]\n" "set auto_index(::pkg::create) [list source [file join $dir package.tcl]]\n" "set auto_index(parray) [list source [file join $dir parray.tcl]]\n" "set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]\n" "set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]\n" "set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]\n" "set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]\n" "set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]\n" "set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]\n" "set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]\n" ; static unsigned char Et_zFile8[] = "if {$::tcl_platform(platform) eq \"windows\"} {\n" "set tcl_wordchars \"\\\\S\"\n" "set tcl_nonwordchars \"\\\\s\"\n" "} else {\n" "set tcl_wordchars \"\\\\w\"\n" "set tcl_nonwordchars \"\\\\W\"\n" "}\n" "proc tcl_wordBreakAfter {str start} {\n" "global tcl_nonwordchars tcl_wordchars\n" "set str [string range $str $start end]\n" "if {[regexp -indices \"$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars\" $str result]} {\n" "return [expr {[lindex $result 1] + $start}]\n" "}\n" "return -1\n" "}\n" "proc tcl_wordBreakBefore {str start} {\n" "global tcl_nonwordchars tcl_wordchars\n" "if {$start eq \"end\"} {\n" "set start [string length $str]\n" "}\n" "if {[regexp -indices \"^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)\" [string range $str 0 $start] result]} {\n" "return [lindex $result 1]\n" "}\n" "return -1\n" "}\n" "proc tcl_endOfWord {str start} {\n" "global tcl_nonwordchars tcl_wordchars\n" "if {[regexp -indices \"$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars\" \\\n" "\011 [string range $str $start end] result]} {\n" "return [expr {[lindex $result 1] + $start}]\n" "}\n" "return -1\n" "}\n" "proc tcl_startOfNextWord {str start} {\n" "global tcl_nonwordchars tcl_wordchars\n" "if {[regexp -indices \"$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars\" \\\n" "\011 [string range $str $start end] result]} {\n" "return [expr {[lindex $result 1] + $start}]\n" "}\n" "return -1\n" "}\n" "proc tcl_startOfPreviousWord {str start} {\n" "global tcl_nonwordchars tcl_wordchars\n" "if {$start eq \"end\"} {\n" "set start [string length $str]\n" "}\n" "if {[regexp -indices \\\n" "\011 \"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\\$\" \\\n" "\011 [string range $str 0 [expr {$start - 1}]] result word]} {\n" "return [lindex $word 0]\n" "}\n" "return -1\n" "}\n" ; static unsigned char Et_zFile9[] = "namespace eval ::tk::dialog::error {\n" "namespace import -force ::tk::msgcat::*\n" "namespace export bgerror\n" "option add *ErrorDialog.function.text [mc \"Save To Log\"] \\\n" "\011widgetDefault\n" "option add *ErrorDialog.function.command [namespace code SaveToLog]\n" "}\n" "proc ::tk::dialog::error::Return {} {\n" "variable button\n" ".bgerrorDialog.ok configure -state active -relief sunken\n" "update idletasks\n" "after 100\n" "set button 0\n" "}\n" "proc ::tk::dialog::error::Details {} {\n" "set w .bgerrorDialog\n" "set caption [option get $w.function text {}]\n" "set command [option get $w.function command {}]\n" "if { ($caption eq \"\") || ($command eq \"\") } {\n" "grid forget $w.function\n" "}\n" "lappend command [.bgerrorDialog.top.info.text get 1.0 end-1c]\n" "$w.function configure -text $caption -command $command\n" "grid $w.top.info - -sticky nsew -padx 3m -pady 3m\n" "}\n" "proc ::tk::dialog::error::SaveToLog {text} {\n" "if { $::tcl_platform(platform) eq \"windows\" } {\n" "set allFiles *.*\n" "} else {\n" "set allFiles *\n" "}\n" "set types [list\011\\\n" "\011 [list [mc \"Log Files\"] .log]\011\\\n" "\011 [list [mc \"Text Files\"] .txt]\011\\\n" "\011 [list [mc \"All Files\"] $allFiles] \\\n" "\011 ]\n" "set filename [tk_getSaveFile -title [mc \"Select Log File\"] \\\n" "\011 -filetypes $types -defaultextension .log -parent .bgerrorDialog]\n" "if {![string length $filename]} {\n" "return\n" "}\n" "set f [open $filename w]\n" "puts -nonewline $f $text\n" "close $f\n" "}\n" "proc ::tk::dialog::error::Destroy {w} {\n" "if {$w eq \".bgerrorDialog\"} {\n" "variable button\n" "set button -1\n" "}\n" "}\n" "proc ::tk::dialog::error::bgerror err {\n" "global errorInfo tcl_platform\n" "variable button\n" "set info $errorInfo\n" "set ret [catch {::tkerror $err} msg];\n" "if {$ret != 1} {return -code $ret $msg}\n" "set windowingsystem [tk windowingsystem]\n" "if {($tcl_platform(platform) eq \"macintosh\")\n" "|| ($windowingsystem eq \"aqua\")} {\n" "set ok\011\011[mc Ok]\n" "set messageFont\011system\n" "set textRelief\011flat\n" "set textHilight\0110\n" "} else {\n" "set ok\011\011[mc OK]\n" "set messageFont\011{Times -18}\n" "set textRelief\011sunken\n" "set textHilight\0111\n" "}\n" "set displayedErr \"\"\n" "set lines 0\n" "foreach line [split $err \\n] {\n" "if { [string length $line] > 30 } {\n" "append displayedErr \"[string range $line 0 29]...\"\n" "break\n" "}\n" "if { $lines > 4 } {\n" "append displayedErr \"...\"\n" "break\n" "} else {\n" "append displayedErr \"${line}\\n\"\n" "}\n" "incr lines\n" "}\n" "set w .bgerrorDialog\n" "set title [mc \"Application Error\"]\n" "set text [mc {Error: %1$s} $displayedErr]\n" "set buttons [list ok $ok dismiss [mc \"Skip Messages\"] \\\n" "\011 function [mc \"Details >>\"]]\n" "destroy .bgerrorDialog\n" "toplevel .bgerrorDialog -class ErrorDialog\n" "wm withdraw .bgerrorDialog\n" "wm title .bgerrorDialog $title\n" "wm iconname .bgerrorDialog ErrorDialog\n" "wm protocol .bgerrorDialog WM_DELETE_WINDOW { }\n" "if {($tcl_platform(platform) eq \"macintosh\")\n" "|| ($windowingsystem eq \"aqua\")} {\n" "::tk::unsupported::MacWindowStyle style .bgerrorDialog zoomDocProc\n" "}\n" "frame .bgerrorDialog.bot\n" "frame .bgerrorDialog.top\n" "if {$windowingsystem eq \"x11\"} {\n" ".bgerrorDialog.bot configure -relief raised -bd 1\n" ".bgerrorDialog.top configure -relief raised -bd 1\n" "}\n" "pack .bgerrorDialog.bot -side bottom -fill both\n" "pack .bgerrorDialog.top -side top -fill both -expand 1\n" "set W [frame $w.top.info]\n" "text $W.text\011\011\011\011\\\n" "\011 -bd 2\011\011\011\011\\\n" "\011 -yscrollcommand [list $W.scroll set]\\\n" "\011 -setgrid true\011\011\011\\\n" "\011 -width 40\011\011\011\011\\\n" "\011 -height 10\011\011\011\011\\\n" "\011 -state normal\011\011\011\\\n" "\011 -relief $textRelief\011\011\011\\\n" "\011 -highlightthickness $textHilight\011\\\n" "\011 -wrap char\n" "scrollbar $W.scroll -relief sunken -command [list $W.text yview]\n" "pack $W.scroll -side right -fill y\n" "pack $W.text -side left -expand yes -fill both\n" "$W.text insert 0.0 \"$err\\n$info\"\n" "$W.text mark set insert 0.0\n" "bind $W.text { focus %W }\n" "$W.text configure -state disabled\n" "set wrapwidth [winfo screenwidth .bgerrorDialog]\n" "set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]\n" "label .bgerrorDialog.msg -justify left -text $text -font $messageFont \\\n" "\011 -wraplength $wrapwidth\n" "if {($tcl_platform(platform) eq \"macintosh\")\n" "|| ($windowingsystem eq \"aqua\")} {\n" "label .bgerrorDialog.bitmap -bitmap stop\n" "} else {\n" "canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0\n" ".bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black\n" ".bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4\n" ".bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4\n" "}\n" "grid .bgerrorDialog.bitmap .bgerrorDialog.msg \\\n" "\011 -in .bgerrorDialog.top\011\\\n" "\011 -row 0\011\011\011\\\n" "\011 -padx 3m\011\011\011\\\n" "\011 -pady 3m\n" "grid configure\011 .bgerrorDialog.msg -sticky nsw -padx {0 3m}\n" "grid rowconfigure\011 .bgerrorDialog.top 1 -weight 1\n" "grid columnconfigure .bgerrorDialog.top 1 -weight 1\n" "set i 0\n" "foreach {name caption} $buttons {\n" "button .bgerrorDialog.$name\011\\\n" "\011\011-text $caption\011\011\\\n" "\011\011-default normal\011\011\\\n" "\011\011-command [namespace code [list set button $i]]\n" "grid .bgerrorDialog.$name\011\\\n" "\011\011-in .bgerrorDialog.bot\011\\\n" "\011\011-column $i\011\011\\\n" "\011\011-row 0\011\011\011\\\n" "\011\011-sticky ew\011\011\\\n" "\011\011-padx 10\n" "grid columnconfigure .bgerrorDialog.bot $i -weight 1\n" "if {($tcl_platform(platform) eq \"macintosh\")\n" "|| ($windowingsystem eq \"aqua\")} {\n" "if {($name eq \"ok\") || ($name eq \"dismiss\")} {\n" "grid columnconfigure .bgerrorDialog.bot $i -minsize 79\n" "}\n" "}\n" "incr i\n" "}\n" ".bgerrorDialog.ok configure -default active\n" "bind .bgerrorDialog \011[namespace code Return]\n" "bind .bgerrorDialog \011[namespace code [list Destroy %W]]\n" ".bgerrorDialog.function configure -command [namespace code Details]\n" "::tk::PlaceWindow .bgerrorDialog\n" "raise .bgerrorDialog\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "if {[lindex [wm stackorder .] end] ne \".bgerrorDialog\"} {\n" "wm attributes .bgerrorDialog -topmost 1\n" "}\n" "}\n" "::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.ok\n" "vwait [namespace which -variable button]\n" "set copy $button; # Save a copy...\n" "::tk::RestoreFocusGrab .bgerrorDialog .bgerrorDialog.ok destroy\n" "if {$copy == 1} {\n" "return -code break\n" "}\n" "}\n" "namespace eval :: {\n" "proc bgerror err {}\n" "rename bgerror {}\n" "namespace import ::tk::dialog::error::bgerror\n" "}\n" ; static unsigned char Et_zFile10[] = "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Radiobutton {\n" "tk::ButtonEnter %W\n" "}\n" "bind Radiobutton <1> {\n" "tk::ButtonDown %W\n" "}\n" "bind Radiobutton {\n" "tk::ButtonUp %W\n" "}\n" "bind Checkbutton {\n" "tk::ButtonEnter %W\n" "}\n" "bind Checkbutton <1> {\n" "tk::ButtonDown %W\n" "}\n" "bind Checkbutton {\n" "tk::ButtonUp %W\n" "}\n" "}\n" "if {\"windows\" eq $tcl_platform(platform)} {\n" "bind Checkbutton {\n" "tk::CheckRadioInvoke %W select\n" "}\n" "bind Checkbutton {\n" "tk::CheckRadioInvoke %W select\n" "}\n" "bind Checkbutton {\n" "tk::CheckRadioInvoke %W deselect\n" "}\n" "bind Checkbutton <1> {\n" "tk::CheckRadioDown %W\n" "}\n" "bind Checkbutton {\n" "tk::ButtonUp %W\n" "}\n" "bind Checkbutton {\n" "tk::CheckRadioEnter %W\n" "}\n" "bind Radiobutton <1> {\n" "tk::CheckRadioDown %W\n" "}\n" "bind Radiobutton {\n" "tk::ButtonUp %W\n" "}\n" "bind Radiobutton {\n" "tk::CheckRadioEnter %W\n" "}\n" "}\n" "if {\"x11\" eq [tk windowingsystem]} {\n" "bind Checkbutton {\n" "if {!$tk_strictMotif} {\n" "tk::CheckRadioInvoke %W\n" "}\n" "}\n" "bind Radiobutton {\n" "if {!$tk_strictMotif} {\n" "tk::CheckRadioInvoke %W\n" "}\n" "}\n" "bind Checkbutton <1> {\n" "tk::CheckRadioInvoke %W\n" "}\n" "bind Radiobutton <1> {\n" "tk::CheckRadioInvoke %W\n" "}\n" "bind Checkbutton {\n" "tk::ButtonEnter %W\n" "}\n" "bind Radiobutton {\n" "tk::ButtonEnter %W\n" "}\n" "}\n" "bind Button {\n" "tk::ButtonInvoke %W\n" "}\n" "bind Checkbutton {\n" "tk::CheckRadioInvoke %W\n" "}\n" "bind Radiobutton {\n" "tk::CheckRadioInvoke %W\n" "}\n" "bind Button {}\n" "bind Button {\n" "tk::ButtonEnter %W\n" "}\n" "bind Button {\n" "tk::ButtonLeave %W\n" "}\n" "bind Button <1> {\n" "tk::ButtonDown %W\n" "}\n" "bind Button {\n" "tk::ButtonUp %W\n" "}\n" "bind Checkbutton {}\n" "bind Checkbutton {\n" "tk::ButtonLeave %W\n" "}\n" "bind Radiobutton {}\n" "bind Radiobutton {\n" "tk::ButtonLeave %W\n" "}\n" "if {\"windows\" eq $tcl_platform(platform)} {\n" "proc ::tk::ButtonEnter w {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "set Priv($w,relief) [$w cget -relief]\n" "if {$Priv(buttonWindow) eq $w} {\n" "$w configure -relief sunken -state active\n" "set Priv($w,prelief) sunken\n" "} elseif {[set over [$w cget -overrelief]] ne \"\"} {\n" "$w configure -relief $over\n" "set Priv($w,prelief) $over\n" "}\n" "}\n" "set Priv(window) $w\n" "}\n" "proc ::tk::ButtonLeave w {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "$w configure -state normal\n" "}\n" "if {[info exists Priv($w,relief)]} {\n" "if {[info exists Priv($w,prelief)] && \\\n" "\011\011$Priv($w,prelief) eq [$w cget -relief]} {\n" "$w configure -relief $Priv($w,relief)\n" "}\n" "unset -nocomplain Priv($w,relief) Priv($w,prelief)\n" "}\n" "set Priv(window) \"\"\n" "}\n" "proc ::tk::ButtonDown w {\n" "variable ::tk::Priv\n" "if {![info exists Priv($w,relief)]} {\n" "set Priv($w,relief) [$w cget -relief]\n" "}\n" "if {[$w cget -state] ne \"disabled\"} {\n" "set Priv(buttonWindow) $w\n" "$w configure -relief sunken -state active\n" "set Priv($w,prelief) sunken\n" "after cancel $Priv(afterId)\n" "set delay [$w cget -repeatdelay]\n" "set Priv(repeated) 0\n" "if {$delay > 0} {\n" "set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]\n" "}\n" "}\n" "}\n" "proc ::tk::ButtonUp w {\n" "variable ::tk::Priv\n" "if {$Priv(buttonWindow) eq $w} {\n" "set Priv(buttonWindow) \"\"\n" "if {[info exists Priv($w,relief)]} {\n" "if {[info exists Priv($w,prelief)] && \\\n" "\011\011 $Priv($w,prelief) eq [$w cget -relief]} {\n" "$w configure -relief $Priv($w,relief)\n" "}\n" "unset -nocomplain Priv($w,relief) Priv($w,prelief)\n" "}\n" "after cancel $Priv(afterId)\n" "if {$Priv(window) eq $w && [$w cget -state] ne \"disabled\"} {\n" "$w configure -state normal\n" "if { $Priv(repeated) == 0 } {\n" "uplevel #0 [list $w invoke]\n" "}\n" "}\n" "}\n" "}\n" "proc ::tk::CheckRadioEnter w {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "if {$Priv(buttonWindow) eq $w} {\n" "$w configure -state active\n" "}\n" "if {[set over [$w cget -overrelief]] ne \"\"} {\n" "set Priv($w,relief) [$w cget -relief]\n" "set Priv($w,prelief) $over\n" "$w configure -relief $over\n" "}\n" "}\n" "set Priv(window) $w\n" "}\n" "proc ::tk::CheckRadioDown w {\n" "variable ::tk::Priv\n" "if {![info exists Priv($w,relief)]} {\n" "set Priv($w,relief) [$w cget -relief]\n" "}\n" "if {[$w cget -state] ne \"disabled\"} {\n" "set Priv(buttonWindow) $w\n" "set Priv(repeated) 0\n" "$w configure -state active\n" "}\n" "}\n" "}\n" "if {\"x11\" eq [tk windowingsystem]} {\n" "proc ::tk::ButtonEnter {w} {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "$w configure -state active\n" "set Priv($w,relief) [$w cget -relief]\n" "if {$Priv(buttonWindow) eq $w} {\n" "$w configure -relief sunken\n" "set Priv($w,prelief) sunken\n" "} elseif {[set over [$w cget -overrelief]] ne \"\"} {\n" "$w configure -relief $over\n" "set Priv($w,prelief) $over\n" "}\n" "}\n" "set Priv(window) $w\n" "}\n" "proc ::tk::ButtonLeave w {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "$w configure -state normal\n" "}\n" "if {[info exists Priv($w,relief)]} {\n" "if {[info exists Priv($w,prelief)] && \\\n" "\011\011$Priv($w,prelief) eq [$w cget -relief]} {\n" "$w configure -relief $Priv($w,relief)\n" "}\n" "unset -nocomplain Priv($w,relief) Priv($w,prelief)\n" "}\n" "set Priv(window) \"\"\n" "}\n" "proc ::tk::ButtonDown w {\n" "variable ::tk::Priv\n" "if {![info exists Priv($w,relief)]} {\n" "set Priv($w,relief) [$w cget -relief]\n" "}\n" "if {[$w cget -state] ne \"disabled\"} {\n" "set Priv(buttonWindow) $w\n" "$w configure -relief sunken\n" "set Priv($w,prelief) sunken\n" "after cancel $Priv(afterId)\n" "set delay [$w cget -repeatdelay]\n" "set Priv(repeated) 0\n" "if {$delay > 0} {\n" "set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]\n" "}\n" "}\n" "}\n" "proc ::tk::ButtonUp w {\n" "variable ::tk::Priv\n" "if {$w eq $Priv(buttonWindow)} {\n" "set Priv(buttonWindow) \"\"\n" "if {[info exists Priv($w,relief)]} {\n" "if {[info exists Priv($w,prelief)] && \\\n" "\011\011 $Priv($w,prelief) eq [$w cget -relief]} {\n" "$w configure -relief $Priv($w,relief)\n" "}\n" "unset -nocomplain Priv($w,relief) Priv($w,prelief)\n" "}\n" "after cancel $Priv(afterId)\n" "if {$Priv(window) eq $w && [$w cget -state] ne \"disabled\"} {\n" "if { $Priv(repeated) == 0 } {\n" "uplevel #0 [list $w invoke]\n" "}\n" "}\n" "}\n" "}\n" "}\n" "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "proc ::tk::ButtonEnter {w} {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "if {$Priv(buttonWindow) eq $w} {\n" "$w configure -state active\n" "} elseif {[set over [$w cget -overrelief]] ne \"\"} {\n" "set Priv($w,relief) [$w cget -relief]\n" "set Priv($w,prelief) $over\n" "$w configure -relief $over\n" "}\n" "}\n" "set Priv(window) $w\n" "}\n" "proc ::tk::ButtonLeave w {\n" "variable ::tk::Priv\n" "if {$w eq $Priv(buttonWindow)} {\n" "$w configure -state normal\n" "}\n" "if {[info exists Priv($w,relief)]} {\n" "if {[info exists Priv($w,prelief)] && \\\n" "\011\011$Priv($w,prelief) eq [$w cget -relief]} {\n" "$w configure -relief $Priv($w,relief)\n" "}\n" "unset -nocomplain Priv($w,relief) Priv($w,prelief)\n" "}\n" "set Priv(window) \"\"\n" "}\n" "proc ::tk::ButtonDown w {\n" "variable ::tk::Priv\n" "if {[$w cget -state] ne \"disabled\"} {\n" "set Priv(buttonWindow) $w\n" "$w configure -state active\n" "after cancel $Priv(afterId)\n" "set Priv(repeated) 0\n" "if { ![catch {$w cget -repeatdelay} delay] } {\n" "if {$delay > 0} {\n" "set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]\n" "}\n" "}\n" "}\n" "}\n" "proc ::tk::ButtonUp w {\n" "variable ::tk::Priv\n" "if {$Priv(buttonWindow) eq $w} {\n" "set Priv(buttonWindow) \"\"\n" "$w configure -state normal\n" "if {[info exists Priv($w,relief)]} {\n" "if {[info exists Priv($w,prelief)] && \\\n" "\011\011 $Priv($w,prelief) eq [$w cget -relief]} {\n" "$w configure -relief $Priv($w,relief)\n" "}\n" "unset -nocomplain Priv($w,relief) Priv($w,prelief)\n" "}\n" "after cancel $Priv(afterId)\n" "if {$Priv(window) eq $w && [$w cget -state] ne \"disabled\"} {\n" "if { $Priv(repeated) == 0 } {\n" "uplevel #0 [list $w invoke]\n" "}\n" "}\n" "}\n" "}\n" "}\n" "proc ::tk::ButtonInvoke w {\n" "if {[$w cget -state] ne \"disabled\"} {\n" "set oldRelief [$w cget -relief]\n" "set oldState [$w cget -state]\n" "$w configure -state active -relief sunken\n" "update idletasks\n" "after 100\n" "$w configure -state $oldState -relief $oldRelief\n" "uplevel #0 [list $w invoke]\n" "}\n" "}\n" "proc ::tk::ButtonAutoInvoke {w} {\n" "variable ::tk::Priv\n" "after cancel $Priv(afterId)\n" "set delay [$w cget -repeatinterval]\n" "if {$Priv(window) eq $w} {\n" "incr Priv(repeated)\n" "uplevel #0 [list $w invoke]\n" "}\n" "if {$delay > 0} {\n" "set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]\n" "}\n" "}\n" "proc ::tk::CheckRadioInvoke {w {cmd invoke}} {\n" "if {[$w cget -state] ne \"disabled\"} {\n" "uplevel #0 [list $w $cmd]\n" "}\n" "}\n" ; static unsigned char Et_zFile11[] = "namespace eval ::tk::dialog {}\n" "namespace eval ::tk::dialog::file {}\n" "namespace eval ::tk::dialog::file::chooseDir {\n" "namespace import -force ::tk::msgcat::*\n" "}\n" "proc ::tk::dialog::file::chooseDir:: {args} {\n" "variable ::tk::Priv\n" "set dataName __tk_choosedir\n" "upvar ::tk::dialog::file::$dataName data\n" "::tk::dialog::file::chooseDir::Config $dataName $args\n" "if {$data(-parent) eq \".\"} {\n" "set w .$dataName\n" "} else {\n" "set w $data(-parent).$dataName\n" "}\n" "if {![winfo exists $w]} {\n" "::tk::dialog::file::Create $w TkChooseDir\n" "} elseif {[winfo class $w] ne \"TkChooseDir\"} {\n" "destroy $w\n" "::tk::dialog::file::Create $w TkChooseDir\n" "} else {\n" "set data(dirMenuBtn) $w.f1.menu\n" "set data(dirMenu) $w.f1.menu.menu\n" "set data(upBtn) $w.f1.up\n" "set data(icons) $w.icons\n" "set data(ent) $w.f2.ent\n" "set data(okBtn) $w.f2.ok\n" "set data(cancelBtn) $w.f2.cancel\n" "set data(hiddenBtn) $w.f2.hidden\n" "}\n" "if {$::tk::dialog::file::showHiddenBtn} {\n" "$data(hiddenBtn) configure -state normal\n" "grid $data(hiddenBtn)\n" "} else {\n" "$data(hiddenBtn) configure -state disabled\n" "grid remove $data(hiddenBtn)\n" "}\n" "if {[winfo viewable [winfo toplevel $data(-parent)]] } {\n" "wm transient $w $data(-parent)\n" "}\n" "trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]\n" "$data(dirMenuBtn) configure \\\n" "\011 -textvariable ::tk::dialog::file::${dataName}(selectPath)\n" "set data(filter) \"*\"\n" "set data(previousEntryText) \"\"\n" "::tk::dialog::file::UpdateWhenIdle $w\n" "::tk::PlaceWindow $w widget $data(-parent)\n" "wm title $w $data(-title)\n" "::tk::SetFocusGrab $w $data(ent)\n" "$data(ent) delete 0 end\n" "$data(ent) insert 0 $data(selectPath)\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "vwait ::tk::Priv(selectFilePath)\n" "::tk::RestoreFocusGrab $w $data(ent) withdraw\n" "foreach trace [trace info variable data(selectPath)] {\n" "trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]\n" "}\n" "$data(dirMenuBtn) configure -textvariable {}\n" "return $Priv(selectFilePath)\n" "}\n" "proc ::tk::dialog::file::chooseDir::Config {dataName argList} {\n" "upvar ::tk::dialog::file::$dataName data\n" "foreach trace [trace info variable data(selectPath)] {\n" "trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]\n" "}\n" "set specs {\n" "{-mustexist \"\" \"\" 0}\n" "{-initialdir \"\" \"\" \"\"}\n" "{-parent \"\" \"\" \".\"}\n" "{-title \"\" \"\" \"\"}\n" "}\n" "if {![info exists data(selectPath)]} {\n" "set data(selectPath) [pwd]\n" "}\n" "tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n" "if {$data(-title) eq \"\"} {\n" "set data(-title) \"[mc \"Choose Directory\"]\"\n" "}\n" "set data(-multiple) 0\n" "if {$data(-initialdir) ne \"\"} {\n" "if {[file isdirectory $data(-initialdir)]} {\n" "set old [pwd]\n" "cd $data(-initialdir)\n" "set data(selectPath) [pwd]\n" "cd $old\n" "} else {\n" "set data(selectPath) [pwd]\n" "}\n" "}\n" "if {![winfo exists $data(-parent)]} {\n" "error \"bad window path name \\\"$data(-parent)\\\"\"\n" "}\n" "}\n" "proc ::tk::dialog::file::chooseDir::OkCmd {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set selection [tk::IconList_Curselection $data(icons)]\n" "if { [llength $selection] != 0 } {\n" "set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]]\n" "set iconText [file join $data(selectPath) $iconText]\n" "::tk::dialog::file::chooseDir::Done $w $iconText\n" "} else {\n" "set text [$data(ent) get]\n" "if { $text eq \"\" } {\n" "return\n" "}\n" "set text [eval file join [file split [string trim $text]]]\n" "if { ![file exists $text] || ![file isdirectory $text] } {\n" "if { $text eq $data(previousEntryText) } {\n" "set data(previousEntryText) \"\"\n" "::tk::dialog::file::chooseDir::Done $w $text\n" "} else {\n" "set data(previousEntryText) $text\n" "}\n" "} else {\n" "if { $text eq $data(selectPath) } {\n" "::tk::dialog::file::chooseDir::Done $w $text\n" "} else {\n" "set data(selectPath) $text\n" "}\n" "}\n" "}\n" "return\n" "}\n" "proc ::tk::dialog::file::chooseDir::DblClick {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set selection [tk::IconList_Curselection $data(icons)]\n" "if { [llength $selection] != 0 } {\n" "set filenameFragment \\\n" "\011\011[tk::IconList_Get $data(icons) [lindex $selection 0]]\n" "set file $data(selectPath)\n" "if {[file isdirectory $file]} {\n" "::tk::dialog::file::ListInvoke $w [list $filenameFragment]\n" "return\n" "}\n" "}\n" "} \n" "proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {$text eq \"\"} {\n" "return\n" "}\n" "set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n" "$data(ent) delete 0 end\n" "$data(ent) insert 0 $file\n" "}\n" "proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath \"\"}} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "variable ::tk::Priv\n" "if {$selectFilePath eq \"\"} {\n" "set selectFilePath $data(selectPath)\n" "}\n" "if { $data(-mustexist) } {\n" "if { ![file exists $selectFilePath] || \\\n" "\011\011![file isdir $selectFilePath] } {\n" "return\n" "}\n" "}\n" "set Priv(selectFilePath) $selectFilePath\n" "}\n" ; static unsigned char Et_zFile12[] = "namespace eval ::tk {}\n" "namespace eval ::tk::dialog {}\n" "namespace eval ::tk::dialog::color {\n" "namespace import ::tk::msgcat::*\n" "}\n" "proc ::tk::dialog::color:: {args} {\n" "variable ::tk::Priv\n" "set dataName __tk__color\n" "upvar ::tk::dialog::color::$dataName data\n" "set w .$dataName\n" "set data(lines,red,start) 0\n" "set data(lines,red,last) -1\n" "set data(lines,green,start) 0\n" "set data(lines,green,last) -1\n" "set data(lines,blue,start) 0\n" "set data(lines,blue,last) -1\n" "set data(NUM_COLORBARS) 16\n" "set data(BARS_WIDTH) 160\n" "set data(PLGN_HEIGHT) 10\n" "set data(PLGN_WIDTH) 10\n" "Config $dataName $args\n" "InitValues $dataName\n" "set sc [winfo screen $data(-parent)]\n" "set winExists [winfo exists $w]\n" "if {!$winExists || $sc ne [winfo screen $w]} {\n" "if {$winExists} {\n" "destroy $w\n" "}\n" "toplevel $w -class TkColorDialog -screen $sc\n" "BuildDialog $w\n" "}\n" "if {[winfo viewable [winfo toplevel $data(-parent)]] } {\n" "wm transient $w $data(-parent)\n" "}\n" "::tk::PlaceWindow $w widget $data(-parent)\n" "wm title $w $data(-title)\n" "::tk::SetFocusGrab $w $data(okBtn)\n" "vwait ::tk::Priv(selectColor)\n" "::tk::RestoreFocusGrab $w $data(okBtn)\n" "unset data\n" "return $Priv(selectColor)\n" "}\n" "proc ::tk::dialog::color::InitValues {dataName} {\n" "upvar ::tk::dialog::color::$dataName data\n" "set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]\n" "set data(colorbarWidth) \\\n" "\011 [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]\n" "set data(indent) [expr {$data(PLGN_WIDTH) / 2}]\n" "set data(colorPad) 2\n" "set data(selPad) [expr {$data(PLGN_WIDTH) / 2}]\n" "set data(minX) $data(indent)\n" "set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]\n" "set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]\n" "set data(selection) $data(-initialcolor)\n" "set data(finalColor) $data(-initialcolor)\n" "set rgb [winfo rgb . $data(selection)]\n" "set data(red,intensity) [expr {[lindex $rgb 0]/0x100}]\n" "set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]\n" "set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}]\n" "}\n" "proc ::tk::dialog::color::Config {dataName argList} {\n" "variable ::tk::Priv\n" "upvar ::tk::dialog::color::$dataName data\n" "if {[info exists Priv(selectColor)] && $Priv(selectColor) ne \"\"} {\n" "set defaultColor $Priv(selectColor)\n" "} else {\n" "set defaultColor [. cget -background]\n" "}\n" "set specs [list \\\n" "\011 [list -initialcolor \"\" \"\" $defaultColor] \\\n" "\011 [list -parent \"\" \"\" \".\"] \\\n" "\011 [list -title \"\" \"\" [mc \"Color\"]] \\\n" "\011 ]\n" "tclParseConfigSpec ::tk::dialog::color::$dataName $specs \"\" $argList\n" "if {$data(-title) eq \"\"} {\n" "set data(-title) \" \"\n" "}\n" "if {[catch {winfo rgb . $data(-initialcolor)} err]} {\n" "error $err\n" "}\n" "if {![winfo exists $data(-parent)]} {\n" "error \"bad window path name \\\"$data(-parent)\\\"\"\n" "}\n" "}\n" "proc ::tk::dialog::color::BuildDialog {w} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set topFrame [frame $w.top -relief raised -bd 1]\n" "set stripsFrame [frame $topFrame.colorStrip]\n" "set maxWidth [::tk::mcmaxamp &Red &Green &Blue]\n" "set maxWidth [expr {$maxWidth<6?6:$maxWidth}]\n" "set colorList [list \\\n" "\011 red\011\011[mc \"&Red\"]\011\\\n" "\011 green\011[mc \"&Green\"]\011\\\n" "\011 blue\011[mc \"&Blue\"]\011\\\n" "\011 ]\n" "foreach {color l} $colorList {\n" "set f [frame $stripsFrame.$color]\n" "set box [frame $f.box]\n" "bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \\\n" "\011 -anchor ne] <> [list focus $box.entry]\n" "entry $box.entry -textvariable \\\n" "\011\011::tk::dialog::color::[winfo name $w]($color,intensity) \\\n" "\011\011-width 4\n" "pack $box.label -side left -fill y -padx 2 -pady 3\n" "pack $box.entry -side left -anchor n -pady 0\n" "pack $box -side left -fill both\n" "set height [expr \\\n" "\011 {[winfo reqheight $box.entry] - \\\n" "\011 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]\n" "canvas $f.color -height $height\\\n" "\011 -width $data(BARS_WIDTH) -relief sunken -bd 2\n" "canvas $f.sel -height $data(PLGN_HEIGHT) \\\n" "\011 -width $data(canvasWidth) -highlightthickness 0\n" "pack $f.color -expand yes -fill both\n" "pack $f.sel -expand yes -fill both\n" "pack $f -side top -fill x -padx 0 -pady 2\n" "set data($color,entry) $box.entry\n" "set data($color,col) $f.color\n" "set data($color,sel) $f.sel\n" "bind $data($color,col) \\\n" "\011 [list tk::dialog::color::DrawColorScale $w $color 1]\n" "bind $data($color,col) \\\n" "\011 [list tk::dialog::color::EnterColorBar $w $color]\n" "bind $data($color,col) \\\n" "\011 [list tk::dialog::color::LeaveColorBar $w $color]\n" "bind $data($color,sel) \\\n" "\011 [list tk::dialog::color::EnterColorBar $w $color]\n" "bind $data($color,sel) \\\n" "\011 [list tk::dialog::color::LeaveColorBar $w $color]\n" "bind $box.entry [list tk::dialog::color::HandleRGBEntry $w]\n" "}\n" "pack $stripsFrame -side left -fill both -padx 4 -pady 10\n" "set selFrame [frame $topFrame.sel]\n" "set lab [::tk::AmpWidget label $selFrame.lab -text [mc \"&Selection:\"] \\\n" "\011 -anchor sw]\n" "set ent [entry $selFrame.ent \\\n" "\011-textvariable ::tk::dialog::color::[winfo name $w](selection) \\\n" "\011-width 16]\n" "set f1 [frame $selFrame.f1 -relief sunken -bd 2]\n" "set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]\n" "pack $lab $ent -side top -fill x -padx 4 -pady 2\n" "pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10\n" "pack $data(finalCanvas) -expand yes -fill both\n" "bind $ent [list tk::dialog::color::HandleSelEntry $w]\n" "pack $selFrame -side left -fill none -anchor nw\n" "pack $topFrame -side top -expand yes -fill both -anchor nw\n" "set botFrame [frame $w.bot -relief raised -bd 1]\n" "::tk::AmpWidget button $botFrame.ok -text [mc \"&OK\"]\011\011\\\n" "\011 -command [list tk::dialog::color::OkCmd $w]\n" "::tk::AmpWidget button $botFrame.cancel -text [mc \"&Cancel\"]\011\\\n" "\011 -command [list tk::dialog::color::CancelCmd $w]\n" "set data(okBtn) $botFrame.ok\n" "set data(cancelBtn) $botFrame.cancel\n" "grid x $botFrame.ok x $botFrame.cancel x -sticky ew\n" "grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10\n" "grid columnconfigure $botFrame {0 4} -weight 1 -uniform space\n" "grid columnconfigure $botFrame {1 3} -weight 1 -uniform button\n" "grid columnconfigure $botFrame 2 -weight 2 -uniform space\n" "pack $botFrame -side bottom -fill x\n" "bind $lab <> [list focus $ent]\n" "bind $w [list tk::ButtonInvoke $data(cancelBtn)]\n" "bind $w [list tk::AltKeyInDialog $w %A]\n" "wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]\n" "}\n" "proc ::tk::dialog::color::SetRGBValue {w color} {\n" "upvar ::tk::dialog::color::[winfo name $w] data \n" "set data(red,intensity) [lindex $color 0]\n" "set data(green,intensity) [lindex $color 1]\n" "set data(blue,intensity) [lindex $color 2]\n" "RedrawColorBars $w all\n" "foreach color [list red green blue ] {\n" "set x [RgbToX $w $data($color,intensity)]\n" "MoveSelector $w $data($color,sel) $color $x 0\n" "}\n" "}\n" "proc ::tk::dialog::color::XToRgb {w x} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]\n" "if {$x > 255} { set x 255 }\n" "return $x\n" "}\n" "proc ::tk::dialog::color::RgbToX {w color} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]\n" "}\n" "proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set col $data($c,col)\n" "set sel $data($c,sel)\n" "if {$create} {\n" "if { $data(lines,$c,last) > $data(lines,$c,start)} {\n" "for {set i $data(lines,$c,start)} \\\n" "\011\011{$i <= $data(lines,$c,last)} { incr i} {\n" "$sel delete $i\n" "}\n" "}\n" "if {[info exists data($c,index)]} {\n" "$sel delete $data($c,index)\n" "}\n" "CreateSelector $w $sel $c\n" "$sel bind $data($c,index) \\\n" "\011\011[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]\n" "$sel bind $data($c,index) \\\n" "\011\011[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]\n" "$sel bind $data($c,index) \\\n" "\011\011[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]\n" "set height [winfo height $col]\n" "set data($c,clickRegion) [$sel create rectangle 0 0 \\\n" "\011\011$data(canvasWidth) $height -fill {} -outline {}]\n" "bind $col \\\n" "\011\011[list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]\n" "bind $col \\\n" "\011\011[list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]\n" "bind $col \\\n" "\011\011[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]\n" "$sel bind $data($c,clickRegion) \\\n" "\011\011[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]\n" "$sel bind $data($c,clickRegion) \\\n" "\011\011[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]\n" "$sel bind $data($c,clickRegion) \\\n" "\011\011[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]\n" "} else {\n" "set l $data(lines,$c,start)\n" "}\n" "set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]\n" "for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {\n" "set intensity [expr {$i * $data(intensityIncr)}]\n" "set startx [expr {$i * $data(colorbarWidth) + $highlightW}]\n" "if {$c eq \"red\"} {\n" "set color [format \"#%02x%02x%02x\" \\\n" "\011\011\011 $intensity \\\n" "\011\011\011 $data(green,intensity) \\\n" "\011\011\011 $data(blue,intensity)]\n" "} elseif {$c eq \"green\"} {\n" "set color [format \"#%02x%02x%02x\" \\\n" "\011\011\011 $data(red,intensity) \\\n" "\011\011\011 $intensity \\\n" "\011\011\011 $data(blue,intensity)]\n" "} else {\n" "set color [format \"#%02x%02x%02x\" \\\n" "\011\011\011 $data(red,intensity) \\\n" "\011\011\011 $data(green,intensity) \\\n" "\011\011\011 $intensity]\n" "}\n" "if {$create} {\n" "set index [$col create rect $startx $highlightW \\\n" "\011\011 [expr {$startx +$data(colorbarWidth)}] \\\n" "\011\011 [expr {[winfo height $col] + $highlightW}]\\\n" "\011 -fill $color -outline $color]\n" "} else {\n" "$col itemconfigure $l -fill $color -outline $color\n" "incr l\n" "}\n" "}\n" "$sel raise $data($c,index)\n" "if {$create} {\n" "set data(lines,$c,last) $index\n" "set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]\n" "}\n" "RedrawFinalColor $w\n" "}\n" "proc ::tk::dialog::color::CreateSelector {w sel c } {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set data($c,index) [$sel create polygon \\\n" "\0110 $data(PLGN_HEIGHT) \\\n" "\011$data(PLGN_WIDTH) $data(PLGN_HEIGHT) \\\n" "\011$data(indent) 0]\n" "set data($c,x) [RgbToX $w $data($c,intensity)]\n" "$sel move $data($c,index) $data($c,x) 0\n" "}\n" "proc ::tk::dialog::color::RedrawFinalColor {w} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set color [format \"#%02x%02x%02x\" $data(red,intensity) \\\n" "\011$data(green,intensity) $data(blue,intensity)]\n" "$data(finalCanvas) configure -bg $color\n" "set data(finalColor) $color\n" "set data(selection) $color\n" "set data(finalRGB) [list \\\n" "\011 $data(red,intensity) \\\n" "\011 $data(green,intensity) \\\n" "\011 $data(blue,intensity)]\n" "}\n" "proc ::tk::dialog::color::RedrawColorBars {w colorChanged} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "switch $colorChanged {\n" "red { \n" "DrawColorScale $w green\n" "DrawColorScale $w blue\n" "}\n" "green {\n" "DrawColorScale $w red\n" "DrawColorScale $w blue\n" "}\n" "blue {\n" "DrawColorScale $w red\n" "DrawColorScale $w green\n" "}\n" "default {\n" "DrawColorScale $w red\n" "DrawColorScale $w green\n" "DrawColorScale $w blue\n" "}\n" "}\n" "RedrawFinalColor $w\n" "}\n" "proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "if {!$dontMove} {\n" "MoveSelector $w $sel $color $x $delta\n" "}\n" "}\n" "proc ::tk::dialog::color::MoveSelector {w sel color x delta} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "incr x -$delta\n" "if { $x < 0 } {\n" "set x 0\n" "} elseif { $x > $data(BARS_WIDTH)} {\n" "set x $data(BARS_WIDTH)\n" "}\n" "set diff [expr {$x - $data($color,x)}]\n" "$sel move $data($color,index) $diff 0\n" "set data($color,x) [expr {$data($color,x) + $diff}]\n" "return $x\n" "}\n" "proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} {\n" "upvar ::tk::dialog::color::[winfo name $w] data \n" "set x [MoveSelector $w $sel $color $x $delta]\n" "set data($color,intensity) [XToRgb $w $x]\n" "RedrawColorBars $w $color\n" "}\n" "proc ::tk::dialog::color::ResizeColorBars {w} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || \n" "(($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {\n" "set data(BARS_WIDTH) $data(NUM_COLORBARS)\n" "}\n" "InitValues [winfo name $w]\n" "foreach color [list red green blue ] {\n" "$data($color,col) configure -width $data(canvasWidth)\n" "DrawColorScale $w $color 1\n" "}\n" "}\n" "proc ::tk::dialog::color::HandleSelEntry {w} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set text [string trim $data(selection)]\n" "if {[catch {set color [winfo rgb . $text]} ]} {\n" "set data(selection) $data(finalColor)\n" "return\n" "}\n" "set R [expr {[lindex $color 0]/0x100}]\n" "set G [expr {[lindex $color 1]/0x100}]\n" "set B [expr {[lindex $color 2]/0x100}]\n" "SetRGBValue $w \"$R $G $B\"\n" "set data(selection) $text\n" "}\n" "proc ::tk::dialog::color::HandleRGBEntry {w} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "foreach c [list red green blue] {\n" "if {[catch {\n" "set data($c,intensity) [expr {int($data($c,intensity))}]\n" "}]} {\n" "set data($c,intensity) 0\n" "}\n" "if {$data($c,intensity) < 0} {\n" "set data($c,intensity) 0\n" "}\n" "if {$data($c,intensity) > 255} {\n" "set data($c,intensity) 255\n" "}\n" "}\n" "SetRGBValue $w \"$data(red,intensity) \\\n" "\011$data(green,intensity) $data(blue,intensity)\"\n" "} \n" "proc ::tk::dialog::color::EnterColorBar {w color} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "$data($color,sel) itemconfigure $data($color,index) -fill red\n" "}\n" "proc ::tk::dialog::color::LeaveColorBar {w color} {\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "$data($color,sel) itemconfigure $data($color,index) -fill black\n" "}\n" "proc ::tk::dialog::color::OkCmd {w} {\n" "variable ::tk::Priv\n" "upvar ::tk::dialog::color::[winfo name $w] data\n" "set Priv(selectColor) $data(finalColor)\n" "}\n" "proc ::tk::dialog::color::CancelCmd {w} {\n" "variable ::tk::Priv\n" "set Priv(selectColor) \"\"\n" "}\n" ; static unsigned char Et_zFile13[] = "proc tclParseConfigSpec {w specs flags argList} {\n" "upvar #0 $w data\n" "foreach spec $specs {\n" "if {[llength $spec] < 4} {\n" "error \"\\\"spec\\\" should contain 5 or 4 elements\"\n" "}\n" "set cmdsw [lindex $spec 0]\n" "set cmd($cmdsw) \"\"\n" "set rname($cmdsw) [lindex $spec 1]\n" "set rclass($cmdsw) [lindex $spec 2]\n" "set def($cmdsw) [lindex $spec 3]\n" "set verproc($cmdsw) [lindex $spec 4]\n" "}\n" "if {[llength $argList] & 1} {\n" "set cmdsw [lindex $argList end]\n" "if {![info exists cmd($cmdsw)]} {\n" "error \"bad option \\\"$cmdsw\\\": must be [tclListValidFlags cmd]\"\n" "}\n" "error \"value for \\\"$cmdsw\\\" missing\"\n" "}\n" "foreach cmdsw [array names cmd] {\n" "set data($cmdsw) $def($cmdsw)\n" "}\n" "foreach {cmdsw value} $argList {\n" "if {![info exists cmd($cmdsw)]} {\n" "error \"bad option \\\"$cmdsw\\\": must be [tclListValidFlags cmd]\"\n" "}\n" "set data($cmdsw) $value\n" "}\n" "}\n" "proc tclListValidFlags {v} {\n" "upvar $v cmd\n" "set len [llength [array names cmd]]\n" "set i 1\n" "set separator \"\"\n" "set errormsg \"\"\n" "foreach cmdsw [lsort [array names cmd]] {\n" "append errormsg \"$separator$cmdsw\"\n" "incr i\n" "if {$i == $len} {\n" "set separator \", or \"\n" "} else {\n" "set separator \", \"\n" "}\n" "}\n" "return $errormsg\n" "}\n" "proc ::tk::FocusGroup_Create {t} {\n" "variable ::tk::Priv\n" "if {[winfo toplevel $t] ne $t} {\n" "error \"$t is not a toplevel window\"\n" "}\n" "if {![info exists Priv(fg,$t)]} {\n" "set Priv(fg,$t) 1\n" "set Priv(focus,$t) \"\"\n" "bind $t [list tk::FocusGroup_In $t %W %d]\n" "bind $t [list tk::FocusGroup_Out $t %W %d]\n" "bind $t [list tk::FocusGroup_Destroy $t %W]\n" "}\n" "}\n" "proc ::tk::FocusGroup_BindIn {t w cmd} {\n" "variable FocusIn\n" "variable ::tk::Priv\n" "if {![info exists Priv(fg,$t)]} {\n" "error \"focus group \\\"$t\\\" doesn't exist\"\n" "}\n" "set FocusIn($t,$w) $cmd\n" "}\n" "proc ::tk::FocusGroup_BindOut {t w cmd} {\n" "variable FocusOut\n" "variable ::tk::Priv\n" "if {![info exists Priv(fg,$t)]} {\n" "error \"focus group \\\"$t\\\" doesn't exist\"\n" "}\n" "set FocusOut($t,$w) $cmd\n" "}\n" "proc ::tk::FocusGroup_Destroy {t w} {\n" "variable FocusIn\n" "variable FocusOut\n" "variable ::tk::Priv\n" "if {$t eq $w} {\n" "unset Priv(fg,$t)\n" "unset Priv(focus,$t) \n" "foreach name [array names FocusIn $t,*] {\n" "unset FocusIn($name)\n" "}\n" "foreach name [array names FocusOut $t,*] {\n" "unset FocusOut($name)\n" "}\n" "} else {\n" "if {[info exists Priv(focus,$t)] && $Priv(focus,$t) eq $w} {\n" "set Priv(focus,$t) \"\"\n" "}\n" "unset -nocomplain FocusIn($t,$w) FocusOut($t,$w)\n" "}\n" "}\n" "proc ::tk::FocusGroup_In {t w detail} {\n" "variable FocusIn\n" "variable ::tk::Priv\n" "if {$detail ne \"NotifyNonlinear\" && $detail ne \"NotifyNonlinearVirtual\"} {\n" "return\n" "}\n" "if {![info exists FocusIn($t,$w)]} {\n" "set FocusIn($t,$w) \"\"\n" "return\n" "}\n" "if {![info exists Priv(focus,$t)]} {\n" "return\n" "}\n" "if {$Priv(focus,$t) eq $w} {\n" "return\n" "} else {\n" "set Priv(focus,$t) $w\n" "eval $FocusIn($t,$w)\n" "}\n" "}\n" "proc ::tk::FocusGroup_Out {t w detail} {\n" "variable FocusOut\n" "variable ::tk::Priv\n" "if {$detail ne \"NotifyNonlinear\" && $detail ne \"NotifyNonlinearVirtual\"} {\n" "return\n" "}\n" "if {![info exists Priv(focus,$t)]} {\n" "return\n" "}\n" "if {![info exists FocusOut($t,$w)]} {\n" "return\n" "} else {\n" "eval $FocusOut($t,$w)\n" "set Priv(focus,$t) \"\"\n" "}\n" "}\n" "proc ::tk::FDGetFileTypes {string} {\n" "foreach t $string {\n" "if {[llength $t] < 2 || [llength $t] > 3} {\n" "error \"bad file type \\\"$t\\\", should be \\\"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\\\"\"\n" "}\n" "eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1]\n" "}\n" "set types {}\n" "foreach t $string {\n" "set label [lindex $t 0]\n" "set exts {}\n" "if {[info exists hasDoneType($label)]} {\n" "continue\n" "}\n" "set name \"$label \\(\"\n" "set sep \"\"\n" "set doAppend 1\n" "foreach ext $fileTypes($label) {\n" "if {$ext eq \"\"} {\n" "continue\n" "}\n" "regsub {^[.]} $ext \"*.\" ext\n" "if {![info exists hasGotExt($label,$ext)]} {\n" "if {$doAppend} {\n" "if {[string length $sep] && [string length $name]>40} {\n" "set doAppend 0\n" "append name $sep...\n" "} else {\n" "append name $sep$ext\n" "}\n" "}\n" "lappend exts $ext\n" "set hasGotExt($label,$ext) 1\n" "}\n" "set sep \",\"\n" "}\n" "append name \"\\)\"\n" "lappend types [list $name $exts]\n" "set hasDoneType($label) 1\n" "}\n" "return $types\n" "}\n" ; static unsigned char Et_zFile14[] = "namespace eval ::tk::console {\n" "variable blinkTime 500 ; # msecs to blink braced range for\n" "variable blinkRange 1 ; # enable blinking of the entire braced range\n" "variable magicKeys 1 ; # enable brace matching and proc/var recognition\n" "variable maxLines 600 ; # maximum # of lines buffered in console\n" "variable showMatches 1 ; # show multiple expand matches\n" "variable inPlugin [info exists embed_args]\n" "variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used\n" "if {$inPlugin} {\n" "set defaultPrompt {subst {[history nextid] % }}\n" "} else {\n" "set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}\n" "}\n" "}\n" "interp alias {} EvalAttached {} consoleinterp eval\n" "proc ::tk::ConsoleInit {} {\n" "global tcl_platform\n" "if {![consoleinterp eval {set tcl_interactive}]} {\n" "wm withdraw .\n" "}\n" "if {$tcl_platform(platform) eq \"macintosh\"\n" "|| [tk windowingsystem] eq \"aqua\"} {\n" "set mod \"Cmd\"\n" "} else {\n" "set mod \"Ctrl\"\n" "}\n" "if {[catch {menu .menubar} err]} { bgerror \"INIT: $err\" }\n" ".menubar add cascade -label File -menu .menubar.file -underline 0\n" ".menubar add cascade -label Edit -menu .menubar.edit -underline 0\n" "menu .menubar.file -tearoff 0\n" ".menubar.file add command -label [mc \"Source...\"] \\\n" "\011 -underline 0 -command tk::ConsoleSource\n" ".menubar.file add command -label [mc \"Hide Console\"] \\\n" "\011 -underline 0 -command {wm withdraw .}\n" ".menubar.file add command -label [mc \"Clear Console\"] \\\n" "\011 -underline 0 -command {.console delete 1.0 \"promptEnd linestart\"}\n" "if {$tcl_platform(platform) eq \"macintosh\"\n" "|| [tk windowingsystem] eq \"aqua\"} {\n" ".menubar.file add command -label [mc \"Quit\"] \\\n" "\011\011-command exit -accel Cmd-Q\n" "} else {\n" ".menubar.file add command -label [mc \"Exit\"] \\\n" "\011\011-underline 1 -command exit\n" "}\n" "menu .menubar.edit -tearoff 0\n" ".menubar.edit add command -label [mc \"Cut\"] -underline 2 \\\n" "\011 -command { event generate .console <> } -accel \"$mod+X\"\n" ".menubar.edit add command -label [mc \"Copy\"] -underline 0 \\\n" "\011 -command { event generate .console <> } -accel \"$mod+C\"\n" ".menubar.edit add command -label [mc \"Paste\"] -underline 1 \\\n" "\011 -command { event generate .console <> } -accel \"$mod+V\"\n" "if {$tcl_platform(platform) ne \"windows\"} {\n" ".menubar.edit add command -label [mc \"Clear\"] -underline 2 \\\n" "\011\011-command { event generate .console <> }\n" "} else {\n" ".menubar.edit add command -label [mc \"Delete\"] -underline 0 \\\n" "\011\011-command { event generate .console <> } -accel \"Del\"\n" ".menubar add cascade -label Help -menu .menubar.help -underline 0\n" "menu .menubar.help -tearoff 0\n" ".menubar.help add command -label [mc \"About...\"] \\\n" "\011\011-underline 0 -command tk::ConsoleAbout\n" "}\n" ". configure -menu .menubar\n" "set con [text .console -yscrollcommand [list .sb set] -setgrid true]\n" "scrollbar .sb -command [list $con yview]\n" "pack .sb -side right -fill both\n" "pack $con -fill both -expand 1 -side left\n" "switch -exact $tcl_platform(platform) {\n" "\"macintosh\" {\n" "$con configure -font {Monaco 9 normal} -highlightthickness 0\n" "}\n" "\"windows\" {\n" "$con configure -font systemfixed\n" "}\n" "\"unix\" {\n" "if {[tk windowingsystem] eq \"aqua\"} {\n" "$con configure -font {Monaco 9 normal} -highlightthickness 0\n" "}\n" "}\n" "}\n" "ConsoleBind $con\n" "$con tag configure stderr\011-foreground red\n" "$con tag configure stdin\011-foreground blue\n" "$con tag configure prompt\011-foreground \\#8F4433\n" "$con tag configure proc\011-foreground \\#008800\n" "$con tag configure var\011-background \\#FFC0D0\n" "$con tag raise sel\n" "$con tag configure blink\011-background \\#FFFF00\n" "$con tag configure find\011-background \\#FFFF00\n" "focus $con\n" "wm protocol . WM_DELETE_WINDOW { wm withdraw . }\n" "wm title . [mc \"Console\"]\n" "flush stdout\n" "$con mark set output [$con index \"end - 1 char\"]\n" "tk::TextSetCursor $con end\n" "$con mark set promptEnd insert\n" "$con mark gravity promptEnd left\n" "set w $con\n" "set temp [$w index \"end - 1 char\"]\n" "$w mark set output end\n" "if {![consoleinterp eval \"info exists tcl_prompt1\"]} {\n" "set string [EvalAttached $::tk::console::defaultPrompt]\n" "$w insert output $string stdout\n" "}\n" "$w mark set output $temp\n" "::tk::TextSetCursor $w end\n" "$w mark set promptEnd insert\n" "$w mark gravity promptEnd left\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "after idle [subst -nocommand {\n" "if {[$con get 1.0 output] eq \"% \"} { $con delete 1.0 output }\n" "}]\n" "}\n" "}\n" "proc ::tk::ConsoleSource {} {\n" "set filename [tk_getOpenFile -defaultextension .tcl -parent . \\\n" "\011 -title [mc \"Select a file to source\"] \\\n" "\011 -filetypes [list \\\n" "\011 [list [mc \"Tcl Scripts\"] .tcl] \\\n" "\011 [list [mc \"All Files\"] *]]]\n" "if {$filename ne \"\"} {\n" "set cmd [list source $filename]\n" "if {[catch {consoleinterp eval $cmd} result]} {\n" "ConsoleOutput stderr \"$result\\n\"\n" "}\n" "}\n" "}\n" "proc ::tk::ConsoleInvoke {args} {\n" "set ranges [.console tag ranges input]\n" "set cmd \"\"\n" "if {[llength $ranges]} {\n" "set pos 0\n" "while {[lindex $ranges $pos] ne \"\"} {\n" "set start [lindex $ranges $pos]\n" "set end [lindex $ranges [incr pos]]\n" "append cmd [.console get $start $end]\n" "incr pos\n" "}\n" "}\n" "if {$cmd eq \"\"} {\n" "ConsolePrompt\n" "} elseif {[info complete $cmd]} {\n" ".console mark set output end\n" ".console tag delete input\n" "set result [consoleinterp record $cmd]\n" "if {$result ne \"\"} {\n" "puts $result\n" "}\n" "ConsoleHistory reset\n" "ConsolePrompt\n" "} else {\n" "ConsolePrompt partial\n" "}\n" ".console yview -pickplace insert\n" "}\n" "set ::tk::HistNum 1\n" "proc ::tk::ConsoleHistory {cmd} {\n" "variable HistNum\n" "switch $cmd {\n" "prev {\n" "incr HistNum -1\n" "if {$HistNum == 0} {\n" "set cmd {history event [expr {[history nextid] -1}]}\n" "} else {\n" "set cmd \"history event $HistNum\"\n" "}\n" "if {[catch {consoleinterp eval $cmd} cmd]} {\n" "incr HistNum\n" "return\n" "}\n" ".console delete promptEnd end\n" ".console insert promptEnd $cmd {input stdin}\n" "}\n" "next {\n" "incr HistNum\n" "if {$HistNum == 0} {\n" "set cmd {history event [expr {[history nextid] -1}]}\n" "} elseif {$HistNum > 0} {\n" "set cmd \"\"\n" "set HistNum 1\n" "} else {\n" "set cmd \"history event $HistNum\"\n" "}\n" "if {$cmd ne \"\"} {\n" "catch {consoleinterp eval $cmd} cmd\n" "}\n" ".console delete promptEnd end\n" ".console insert promptEnd $cmd {input stdin}\n" "}\n" "reset {\n" "set HistNum 1\n" "}\n" "}\n" "}\n" "proc ::tk::ConsolePrompt {{partial normal}} {\n" "set w .console\n" "if {$partial eq \"normal\"} {\n" "set temp [$w index \"end - 1 char\"]\n" "$w mark set output end\n" "if {[consoleinterp eval \"info exists tcl_prompt1\"]} {\n" "consoleinterp eval \"eval \\[set tcl_prompt1\\]\"\n" "} else {\n" "puts -nonewline [EvalAttached $::tk::console::defaultPrompt]\n" "}\n" "} else {\n" "set temp [$w index output]\n" "$w mark set output end\n" "if {[consoleinterp eval \"info exists tcl_prompt2\"]} {\n" "consoleinterp eval \"eval \\[set tcl_prompt2\\]\"\n" "} else {\n" "puts -nonewline \"> \"\n" "}\n" "}\n" "flush stdout\n" "$w mark set output $temp\n" "::tk::TextSetCursor $w end\n" "$w mark set promptEnd insert\n" "$w mark gravity promptEnd left\n" "::tk::console::ConstrainBuffer $w $::tk::console::maxLines\n" "$w see end\n" "}\n" "proc ::tk::ConsoleBind {w} {\n" "bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]\n" "foreach ev [bind Text] { bind Console $ev [bind Text $ev] }\011\n" "bind Console {}\n" "bind Console {}\n" "bind Console {}\n" "bind Console {# nothing }\n" "bind Console {# nothing}\n" "bind Console {# nothing}\n" "foreach {ev key} {\n" "<>\011\011\n" "<>\011\011\n" "<>\011\n" "<>\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\011\n" "<>\011\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "<>\011\011\n" "} {\n" "event add $ev $key\n" "bind Console $key {}\n" "}\n" "bind Console <> {\n" "if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}\n" "}\n" "bind Console <> {\n" "if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}\n" "}\n" "bind Console <> {\n" "if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}\n" "}\n" "bind Console <> {\n" "if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}\n" "}\n" "bind Console <> {\n" "%W mark set insert {end - 1c}\n" "tk::ConsoleInsert %W \"\\n\"\n" "tk::ConsoleInvoke\n" "break\n" "}\n" "bind Console {\n" "if {[%W tag nextrange sel 1.0 end] ne \"\" && [%W compare sel.first >= promptEnd]} {\n" "%W delete sel.first sel.last\n" "} elseif {[%W compare insert >= promptEnd]} {\n" "%W delete insert\n" "%W see insert\n" "}\n" "}\n" "bind Console {\n" "if {[%W tag nextrange sel 1.0 end] ne \"\" && [%W compare sel.first >= promptEnd]} {\n" "%W delete sel.first sel.last\n" "} elseif {[%W compare insert != 1.0] && \\\n" "\011\011[%W compare insert > promptEnd]} {\n" "%W delete insert-1c\n" "%W see insert\n" "}\n" "}\n" "bind Console [bind Console ]\n" "bind Console {\n" "if {[%W compare insert < promptEnd]} {\n" "tk::TextSetCursor %W {insert linestart}\n" "} else {\n" "tk::TextSetCursor %W promptEnd\n" "}\n" "}\n" "bind Console [bind Console ]\n" "bind Console {\n" "tk::TextSetCursor %W {insert lineend}\n" "}\n" "bind Console [bind Console ]\n" "bind Console {\n" "if {[%W compare insert < promptEnd]} break\n" "%W delete insert\n" "}\n" "bind Console <> {\n" "if {[%W compare insert < promptEnd]} break\n" "if {[%W compare insert == {insert lineend}]} {\n" "%W delete insert\n" "} else {\n" "%W delete insert {insert lineend}\n" "}\n" "}\n" "bind Console <> {\n" "%W delete 1.0 \"promptEnd linestart\"\n" "}\n" "bind Console <> {\n" "%W delete promptEnd end\n" "}\n" "bind Console {\n" "if {[%W compare insert >= promptEnd]} {\n" "%W delete insert {insert wordend}\n" "}\n" "}\n" "bind Console {\n" "if {[%W compare {insert -1c wordstart} >= promptEnd]} {\n" "%W delete {insert -1c wordstart} insert\n" "}\n" "}\n" "bind Console {\n" "if {[%W compare insert >= promptEnd]} {\n" "%W delete insert {insert wordend}\n" "}\n" "}\n" "bind Console {\n" "if {[%W compare {insert -1c wordstart} >= promptEnd]} {\n" "%W delete {insert -1c wordstart} insert\n" "}\n" "}\n" "bind Console {\n" "if {[%W compare insert >= promptEnd]} {\n" "%W delete insert {insert wordend}\n" "}\n" "}\n" "bind Console <> {\n" "tk::ConsoleHistory prev\n" "}\n" "bind Console <> {\n" "tk::ConsoleHistory next\n" "}\n" "bind Console {\n" "catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}\n" "}\n" "bind Console {\n" "tk::ConsoleInsert %W %A\n" "}\n" "bind Console {\n" "eval destroy [winfo child .]\n" "if {$tcl_platform(platform) eq \"macintosh\"} {\n" "if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}\n" "} else {\n" "source [file join $tk_library console.tcl]\n" "}\n" "}\n" "if {$::tcl_platform(platform) eq \"macintosh\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Console {\n" "exit\n" "}\n" "}\n" "bind Console <> {\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" "bind Console <> {\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" "bind Console <> {\n" "catch {\n" "set clip [::tk::GetSelection %W CLIPBOARD]\n" "set list [split $clip \\n\\r]\n" "tk::ConsoleInsert %W [lindex $list 0]\n" "foreach x [lrange $list 1 end] {\n" "%W mark set insert {end - 1c}\n" "tk::ConsoleInsert %W \"\\n\"\n" "tk::ConsoleInvoke\n" "tk::ConsoleInsert %W $x\n" "}\n" "}\n" "}\n" "bind PostConsole {\n" "if {\"\\\\\" ne [%W get insert-2c]} {\n" "::tk::console::MatchPair %W \\( \\) promptEnd\n" "}\n" "}\n" "bind PostConsole {\n" "if {\"\\\\\" ne [%W get insert-2c]} {\n" "::tk::console::MatchPair %W \\[ \\] promptEnd\n" "}\n" "}\n" "bind PostConsole {\n" "if {\"\\\\\" ne [%W get insert-2c]} {\n" "::tk::console::MatchPair %W \\{ \\} promptEnd\n" "}\n" "}\n" "bind PostConsole {\n" "if {\"\\\\\" ne [%W get insert-2c]} {\n" "::tk::console::MatchQuote %W promptEnd\n" "}\n" "}\n" "bind PostConsole {\n" "if {\"%A\" ne \"\"} {\n" "::tk::console::TagProc %W\n" "}\n" "break\n" "}\n" "}\n" "proc ::tk::ConsoleInsert {w s} {\n" "if {$s eq \"\"} {\n" "return\n" "}\n" "catch {\n" "if {[$w compare sel.first <= insert]\n" "&& [$w compare sel.last >= insert]} {\n" "$w tag remove sel sel.first promptEnd\n" "$w delete sel.first sel.last\n" "}\n" "}\n" "if {[$w compare insert < promptEnd]} {\n" "$w mark set insert end\n" "}\n" "$w insert insert $s {input stdin}\n" "$w see insert\n" "}\n" "proc ::tk::ConsoleOutput {dest string} {\n" "set w .console\n" "$w insert output $string $dest\n" "::tk::console::ConstrainBuffer $w $::tk::console::maxLines\n" "$w see insert\n" "}\n" "proc ::tk::ConsoleExit {} {\n" "destroy .\n" "}\n" "proc ::tk::ConsoleAbout {} {\n" "tk_messageBox -type ok -message \"[mc {Tcl for Windows}]\n" "Tcl $::tcl_patchLevel\n" "Tk $::tk_patchLevel\"\n" "}\n" "proc ::tk::console::TagProc w {\n" "if {!$::tk::console::magicKeys} { return }\n" "set exp \"\\[^\\\\\\\\\\]\\[\\[ \\t\\n\\r\\;{}\\\"\\$\\]\"\n" "set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]\n" "if {$i eq \"\"} {set i promptEnd} else {append i +2c}\n" "regsub -all \"\\[\\[\\\\\\\\\\\\?\\\\*\\]\" [$w get $i \"insert-1c wordend\"] {\\\\\\0} c\n" "if {[llength [EvalAttached [list info commands $c]]]} {\n" "$w tag add proc $i \"insert-1c wordend\"\n" "} else {\n" "$w tag remove proc $i \"insert-1c wordend\"\n" "}\n" "if {[llength [EvalAttached [list info vars $c]]]} {\n" "$w tag add var $i \"insert-1c wordend\"\n" "} else {\n" "$w tag remove var $i \"insert-1c wordend\"\n" "}\n" "}\n" "proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {\n" "if {!$::tk::console::magicKeys} { return }\n" "if {[set ix [$w search -back $c1 insert $lim]] ne \"\"} {\n" "while {\n" "[string match {\\\\} [$w get $ix-1c]] &&\n" "[set ix [$w search -back $c1 $ix-1c $lim]] ne \"\"\n" "} {}\n" "set i1 insert-1c\n" "while {$ix ne \"\"} {\n" "set i0 $ix\n" "set j 0\n" "while {[set i0 [$w search $c2 $i0 $i1]] ne \"\"} {\n" "append i0 +1c\n" "if {[string match {\\\\} [$w get $i0-2c]]} continue\n" "incr j\n" "}\n" "if {!$j} break\n" "set i1 $ix\n" "while {$j && [set ix [$w search -back $c1 $ix $lim]] ne \"\"} {\n" "if {[string match {\\\\} [$w get $ix-1c]]} continue\n" "incr j -1\n" "}\n" "}\n" "if {[string match {} $ix]} { set ix [$w index $lim] }\n" "} else { set ix [$w index $lim] }\n" "if {$::tk::console::blinkRange} {\n" "Blink $w $ix [$w index insert]\n" "} else {\n" "Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]\n" "}\n" "}\n" "proc ::tk::console::MatchQuote {w {lim 1.0}} {\n" "if {!$::tk::console::magicKeys} { return }\n" "set i insert-1c\n" "set j 0\n" "while {[set i [$w search -back \\\" $i $lim]] ne \"\"} {\n" "if {[string match {\\\\} [$w get $i-1c]]} continue\n" "if {!$j} {set i0 $i}\n" "incr j\n" "}\n" "if {$j&1} {\n" "if {$::tk::console::blinkRange} {\n" "Blink $w $i0 [$w index insert]\n" "} else {\n" "Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]\n" "}\n" "} else {\n" "Blink $w [$w index insert-1c] [$w index insert]\n" "}\n" "}\n" "proc ::tk::console::Blink {w args} {\n" "eval [list $w tag add blink] $args\n" "after $::tk::console::blinkTime [list $w] tag remove blink $args\n" "}\n" "proc ::tk::console::ConstrainBuffer {w size} {\n" "if {[$w index end] > $size} {\n" "$w delete 1.0 [expr {int([$w index end])-$size}].0\n" "}\n" "}\n" "proc ::tk::console::Expand {w {type \"\"}} {\n" "set exp \"\\[^\\\\\\\\\\]\\[\\[ \\t\\n\\r\\\\\\{\\\"\\\\\\\\\\$\\]\"\n" "set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]\n" "if {$tmp eq \"\"} {set tmp promptEnd} else {append tmp +2c}\n" "if {[$w compare $tmp >= insert]} { return }\n" "set str [$w get $tmp insert]\n" "switch -glob $type {\n" "path* { set res [ExpandPathname $str] }\n" "proc* { set res [ExpandProcname $str] }\n" "var* { set res [ExpandVariable $str] }\n" "default {\n" "set res {}\n" "foreach t {Pathname Procname Variable} {\n" "if {![catch {Expand$t $str} res] && ($res ne \"\")} { break }\n" "}\n" "}\n" "}\n" "set len [llength $res]\n" "if {$len} {\n" "set repl [lindex $res 0]\n" "$w delete $tmp insert\n" "$w insert $tmp $repl {input stdin}\n" "if {($len > 1) && $::tk::console::showMatches && $repl eq $str} {\n" "puts stdout [lsort [lreplace $res 0 0]]\n" "}\n" "} else { bell }\n" "return [incr len -1]\n" "}\n" "proc ::tk::console::ExpandPathname str {\n" "set pwd [EvalAttached pwd]\n" "if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {\n" "return -code error $err\n" "}\n" "set dir [file tail $str]\n" "if {[string match */ $str]} { append dir / }\n" "if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {\n" "set match {}\n" "} else {\n" "if {[llength $m] > 1} {\n" "global tcl_platform\n" "if {[string match windows $tcl_platform(platform)]} {\n" "set tmp [ExpandBestMatch [string tolower $m] \\\n" "\011\011\011[string tolower $dir]]\n" "if {[string length $dir]==[string length $tmp]} {\n" "set tmp $dir\n" "}\n" "} else {\n" "set tmp [ExpandBestMatch $m $dir]\n" "}\n" "if {[string match ?*/* $str]} {\n" "set tmp [file dirname $str]/$tmp\n" "} elseif {[string match /* $str]} {\n" "set tmp /$tmp\n" "}\n" "regsub -all { } $tmp {\\\\ } tmp\n" "set match [linsert $m 0 $tmp]\n" "} else {\n" "eval append match $m\n" "if {[file isdir $match]} {append match /}\n" "if {[string match ?*/* $str]} {\n" "set match [file dirname $str]/$match\n" "} elseif {[string match /* $str]} {\n" "set match /$match\n" "}\n" "regsub -all { } $match {\\\\ } match\n" "set match [list $match]\n" "}\n" "}\n" "EvalAttached [list cd $pwd]\n" "return $match\n" "}\n" "proc ::tk::console::ExpandProcname str {\n" "set match [EvalAttached [list info commands $str*]]\n" "if {[llength $match] == 0} {\n" "set ns [EvalAttached \\\n" "\011\011\"namespace children \\[namespace current\\] [list $str*]\"]\n" "if {[llength $ns]==1} {\n" "set match [EvalAttached [list info commands ${ns}::*]]\n" "} else {\n" "set match $ns\n" "}\n" "}\n" "if {[llength $match] > 1} {\n" "regsub -all { } [ExpandBestMatch $match $str] {\\\\ } str\n" "set match [linsert $match 0 $str]\n" "} else {\n" "regsub -all { } $match {\\\\ } match\n" "}\n" "return $match\n" "}\n" "proc ::tk::console::ExpandVariable str {\n" "if {[regexp {([^\\(]*)\\((.*)} $str junk ary str]} {\n" "set match [EvalAttached [list array names $ary $str*]]\n" "if {[llength $match] > 1} {\n" "set vars $ary\\([ExpandBestMatch $match $str]\n" "foreach var $match {lappend vars $ary\\($var\\)}\n" "return $vars\n" "} elseif {[llength $match] == 1} {\n" "set match $ary\\($match\\)\n" "}\n" "} else {\n" "set match [EvalAttached [list info vars $str*]]\n" "if {[llength $match] > 1} {\n" "regsub -all { } [ExpandBestMatch $match $str] {\\\\ } str\n" "set match [linsert $match 0 $str]\n" "} else {\n" "regsub -all { } $match {\\\\ } match\n" "}\n" "}\n" "return $match\n" "}\n" "proc ::tk::console::ExpandBestMatch {l {e {}}} {\n" "set ec [lindex $l 0]\n" "if {[llength $l]>1} {\n" "set e [string length $e]; incr e -1\n" "set ei [string length $ec]; incr ei -1\n" "foreach l $l {\n" "while {$ei>=$e && [string first $ec $l]} {\n" "set ec [string range $ec 0 [incr ei -1]]\n" "}\n" "}\n" "}\n" "return $ec\n" "}\n" "::tk::ConsoleInit \n" ; static unsigned char Et_zFile15[] = "proc ::tk_dialog {w title text bitmap default args} {\n" "global tcl_platform\n" "variable ::tk::Priv\n" "if {[string is integer -strict $default]} {\n" "if {$default >= [llength $args]} {\n" "return -code error \"default button index greater than number of\\\n" "\011\011 buttons specified for tk_dialog\"\n" "}\n" "} elseif {\"\" eq $default} {\n" "set default -1\n" "} else {\n" "set default [lsearch -exact $args $default]\n" "}\n" "destroy $w\n" "toplevel $w -class Dialog\n" "wm title $w $title\n" "wm iconname $w Dialog\n" "wm protocol $w WM_DELETE_WINDOW { }\n" "if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {\n" "wm transient $w [winfo toplevel [winfo parent $w]]\n" "}\n" "set windowingsystem [tk windowingsystem]\n" "if {$tcl_platform(platform) eq \"macintosh\" || $windowingsystem eq \"aqua\"} {\n" "::tk::unsupported::MacWindowStyle style $w dBoxProc\n" "}\n" "frame $w.bot\n" "frame $w.top\n" "if {$windowingsystem eq \"x11\"} {\n" "$w.bot configure -relief raised -bd 1\n" "$w.top configure -relief raised -bd 1\n" "}\n" "pack $w.bot -side bottom -fill both\n" "pack $w.top -side top -fill both -expand 1\n" "option add *Dialog.msg.wrapLength 3i widgetDefault\n" "if {$tcl_platform(platform) eq \"macintosh\" || $windowingsystem eq \"aqua\"} {\n" "option add *Dialog.msg.font system widgetDefault\n" "} else {\n" "option add *Dialog.msg.font {Times 12} widgetDefault\n" "}\n" "label $w.msg -justify left -text $text\n" "pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m\n" "if {$bitmap ne \"\"} {\n" "if {($tcl_platform(platform) eq \"macintosh\"\n" "|| $windowingsystem eq \"aqua\") && ($bitmap eq \"error\")} {\n" "set bitmap \"stop\"\n" "}\n" "label $w.bitmap -bitmap $bitmap\n" "pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m\n" "}\n" "set i 0\n" "foreach but $args {\n" "button $w.button$i -text $but -command [list set ::tk::Priv(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 \\\n" "\011\011-padx 10 -pady 4\n" "grid columnconfigure $w.bot $i\n" "if {$tcl_platform(platform) eq \"macintosh\" || $windowingsystem eq \"aqua\"} {\n" "set tmp [string tolower $but]\n" "if {$tmp eq \"ok\" || $tmp eq \"cancel\"} {\n" "grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]\n" "}\n" "}\n" "incr i\n" "}\n" "if {$default >= 0} {\n" "bind $w \"\n" "[list $w.button$default] configure -state active -relief sunken\n" "update idletasks\n" "after 100\n" "set ::tk::Priv(button) $default\n" "\"\n" "}\n" "bind $w {set ::tk::Priv(button) -1}\n" "wm withdraw $w\n" "update idletasks\n" "set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n" "\011 - [winfo vrootx [winfo parent $w]]}]\n" "set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n" "\011 - [winfo vrooty [winfo parent $w]]}]\n" "if {$x < 0} {\n" "set x 0\n" "}\n" "if {$y < 0} {\n" "set y 0\n" "}\n" "wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w]\n" "wm geometry $w +$x+$y\n" "wm deiconify $w\n" "tkwait visibility $w\n" "set oldFocus [focus]\n" "set oldGrab [grab current $w]\n" "if {$oldGrab ne \"\"} {\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" "vwait ::tk::Priv(button)\n" "catch {focus $oldFocus}\n" "catch {\n" "bind $w {}\n" "destroy $w\n" "}\n" "if {$oldGrab ne \"\"} {\n" "if {$grabStatus ne \"global\"} {\n" "grab $oldGrab\n" "} else {\n" "grab -global $oldGrab\n" "}\n" "}\n" "return $Priv(button)\n" "}\n" ; static unsigned char Et_zFile16[] = "bind Entry <> {\n" "if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {\n" "clipboard clear -displayof %W\n" "clipboard append -displayof %W $tk::Priv(data)\n" "%W delete sel.first sel.last\n" "unset tk::Priv(data)\n" "}\n" "}\n" "bind Entry <> {\n" "if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {\n" "clipboard clear -displayof %W\n" "clipboard append -displayof %W $tk::Priv(data)\n" "unset tk::Priv(data)\n" "}\n" "}\n" "bind Entry <> {\n" "global tcl_platform\n" "catch {\n" "if {[tk windowingsystem] ne \"x11\"} {\n" "catch {\n" "%W delete sel.first sel.last\n" "}\n" "}\n" "%W insert insert [::tk::GetSelection %W CLIPBOARD]\n" "tk::EntrySeeInsert %W\n" "}\n" "}\n" "bind Entry <> {\n" "%W delete sel.first sel.last\n" "}\n" "bind Entry <> {\n" "if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]\n" "|| !$tk::Priv(mouseMoved)} {\n" "tk::EntryPaste %W %x\n" "}\n" "}\n" "bind Entry <1> {\n" "tk::EntryButton1 %W %x\n" "%W selection clear\n" "}\n" "bind Entry {\n" "set tk::Priv(x) %x\n" "tk::EntryMouseSelect %W %x\n" "}\n" "bind Entry {\n" "set tk::Priv(selectMode) word\n" "tk::EntryMouseSelect %W %x\n" "catch {%W icursor sel.last}\n" "}\n" "bind Entry {\n" "set tk::Priv(selectMode) line\n" "tk::EntryMouseSelect %W %x\n" "catch {%W icursor sel.last}\n" "}\n" "bind Entry {\n" "set tk::Priv(selectMode) char\n" "%W selection adjust @%x\n" "}\n" "bind Entry \011{\n" "set tk::Priv(selectMode) word\n" "tk::EntryMouseSelect %W %x\n" "}\n" "bind Entry \011{\n" "set tk::Priv(selectMode) line\n" "tk::EntryMouseSelect %W %x\n" "}\n" "bind Entry {\n" "set tk::Priv(x) %x\n" "tk::EntryAutoScan %W\n" "}\n" "bind Entry {\n" "tk::CancelRepeat\n" "}\n" "bind Entry {\n" "tk::CancelRepeat\n" "}\n" "bind Entry {\n" "%W icursor @%x\n" "}\n" "bind Entry {\n" "tk::EntrySetCursor %W [expr {[%W index insert] - 1}]\n" "}\n" "bind Entry {\n" "tk::EntrySetCursor %W [expr {[%W index insert] + 1}]\n" "}\n" "bind Entry {\n" "tk::EntryKeySelect %W [expr {[%W index insert] - 1}]\n" "tk::EntrySeeInsert %W\n" "}\n" "bind Entry {\n" "tk::EntryKeySelect %W [expr {[%W index insert] + 1}]\n" "tk::EntrySeeInsert %W\n" "}\n" "bind Entry {\n" "tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]\n" "}\n" "bind Entry {\n" "tk::EntrySetCursor %W [tk::EntryNextWord %W insert]\n" "}\n" "bind Entry {\n" "tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]\n" "tk::EntrySeeInsert %W\n" "}\n" "bind Entry {\n" "tk::EntryKeySelect %W [tk::EntryNextWord %W insert]\n" "tk::EntrySeeInsert %W\n" "}\n" "bind Entry {\n" "tk::EntrySetCursor %W 0\n" "}\n" "bind Entry {\n" "tk::EntryKeySelect %W 0\n" "tk::EntrySeeInsert %W\n" "}\n" "bind Entry {\n" "tk::EntrySetCursor %W end\n" "}\n" "bind Entry {\n" "tk::EntryKeySelect %W end\n" "tk::EntrySeeInsert %W\n" "}\n" "bind Entry {\n" "if {[%W selection present]} {\n" "%W delete sel.first sel.last\n" "} else {\n" "%W delete insert\n" "}\n" "}\n" "bind Entry {\n" "tk::EntryBackspace %W\n" "}\n" "bind Entry {\n" "%W selection from insert\n" "}\n" "bind Entry {\n" "tk::ListboxBeginSelect %W [%W index active]\n" "}\n" "bind Listbox {\n" "tk::ListboxBeginExtend %W [%W index active]\n" "}\n" "bind Listbox {\n" "tk::ListboxBeginExtend %W [%W index active]\n" "}\n" "bind Listbox {\n" "tk::ListboxCancel %W\n" "}\n" "bind Listbox {\n" "tk::ListboxSelectAll %W\n" "}\n" "bind Listbox {\n" "if {[%W cget -selectmode] ne \"browse\"} {\n" "%W selection clear 0 end\n" "event generate %W <>\n" "}\n" "}\n" "bind Listbox <2> {\n" "%W scan mark %x %y\n" "}\n" "bind Listbox {\n" "%W scan dragto %x %y\n" "}\n" "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Listbox {\n" "%W yview scroll [expr {- (%D)}] units\n" "}\n" "bind Listbox {\n" "%W yview scroll [expr {-10 * (%D)}] units\n" "}\n" "bind Listbox {\n" "%W xview scroll [expr {- (%D)}] units\n" "}\n" "bind Listbox {\n" "%W xview scroll [expr {-10 * (%D)}] units\n" "}\n" "} else {\n" "bind Listbox {\n" "%W yview scroll [expr {- (%D / 120) * 4}] units\n" "}\n" "}\n" "if {\"x11\" eq [tk windowingsystem]} {\n" "bind Listbox <4> {\n" "if {!$tk_strictMotif} {\n" "%W yview scroll -5 units\n" "}\n" "}\n" "bind Listbox <5> {\n" "if {!$tk_strictMotif} {\n" "%W yview scroll 5 units\n" "}\n" "}\n" "}\n" "proc ::tk::ListboxBeginSelect {w el} {\n" "variable ::tk::Priv\n" "if {[$w cget -selectmode] eq \"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 Priv(listboxSelection) {}\n" "set Priv(listboxPrev) $el\n" "}\n" "event generate $w <>\n" "}\n" "proc ::tk::ListboxMotion {w el} {\n" "variable ::tk::Priv\n" "if {$el == $Priv(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 Priv(listboxPrev) $el\n" "event generate $w <>\n" "}\n" "extended {\n" "set i $Priv(listboxPrev)\n" "if {$i eq \"\"} {\n" "set i $el\n" "$w selection set $el\n" "}\n" "if {[$w selection includes anchor]} {\n" "$w selection clear $i $el\n" "$w selection set anchor $el\n" "} else {\n" "$w selection clear $i $el\n" "$w selection clear anchor $el\n" "}\n" "if {![info exists Priv(listboxSelection)]} {\n" "set Priv(listboxSelection) [$w curselection]\n" "}\n" "while {($i < $el) && ($i < $anchor)} {\n" "if {[lsearch $Priv(listboxSelection) $i] >= 0} {\n" "$w selection set $i\n" "}\n" "incr i\n" "}\n" "while {($i > $el) && ($i > $anchor)} {\n" "if {[lsearch $Priv(listboxSelection) $i] >= 0} {\n" "$w selection set $i\n" "}\n" "incr i -1\n" "}\n" "set Priv(listboxPrev) $el\n" "event generate $w <>\n" "}\n" "}\n" "}\n" "proc ::tk::ListboxBeginExtend {w el} {\n" "if {[$w cget -selectmode] eq \"extended\"} {\n" "if {[$w selection includes anchor]} {\n" "ListboxMotion $w $el\n" "} else {\n" "ListboxBeginSelect $w $el\n" "}\n" "}\n" "}\n" "proc ::tk::ListboxBeginToggle {w el} {\n" "variable ::tk::Priv\n" "if {[$w cget -selectmode] eq \"extended\"} {\n" "set Priv(listboxSelection) [$w curselection]\n" "set Priv(listboxPrev) $el\n" "$w selection anchor $el\n" "if {[$w selection includes $el]} {\n" "$w selection clear $el\n" "} else {\n" "$w selection set $el\n" "}\n" "event generate $w <>\n" "}\n" "}\n" "proc ::tk::ListboxAutoScan {w} {\n" "variable ::tk::Priv\n" "if {![winfo exists $w]} return\n" "set x $Priv(x)\n" "set y $Priv(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" "ListboxMotion $w [$w index @$x,$y]\n" "set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]\n" "}\n" "proc ::tk::ListboxUpDown {w amount} {\n" "variable ::tk::Priv\n" "$w activate [expr {[$w index active] + $amount}]\n" "$w see active\n" "switch [$w cget -selectmode] {\n" "browse {\n" "$w selection clear 0 end\n" "$w selection set active\n" "event generate $w <>\n" "}\n" "extended {\n" "$w selection clear 0 end\n" "$w selection set active\n" "$w selection anchor active\n" "set Priv(listboxPrev) [$w index active]\n" "set Priv(listboxSelection) {}\n" "event generate $w <>\n" "}\n" "}\n" "}\n" "proc ::tk::ListboxExtendUpDown {w amount} {\n" "variable ::tk::Priv\n" "if {[$w cget -selectmode] ne \"extended\"} {\n" "return\n" "}\n" "set active [$w index active]\n" "if {![info exists Priv(listboxSelection)]} {\n" "$w selection set $active\n" "set Priv(listboxSelection) [$w curselection]\n" "}\n" "$w activate [expr {$active + $amount}]\n" "$w see active\n" "ListboxMotion $w [$w index active]\n" "}\n" "proc ::tk::ListboxDataExtend {w el} {\n" "set mode [$w cget -selectmode]\n" "if {$mode eq \"extended\"} {\n" "$w activate $el\n" "$w see $el\n" "if {[$w selection includes anchor]} {\n" "ListboxMotion $w $el\n" "}\n" "} elseif {$mode eq \"multiple\"} {\n" "$w activate $el\n" "$w see $el\n" "}\n" "}\n" "proc ::tk::ListboxCancel w {\n" "variable ::tk::Priv\n" "if {[$w cget -selectmode] ne \"extended\"} {\n" "return\n" "}\n" "set first [$w index anchor]\n" "set last $Priv(listboxPrev)\n" "if { $last eq \"\" } {\n" "return\n" "}\n" "if {$first > $last} {\n" "set tmp $first\n" "set first $last\n" "set last $tmp\n" "}\n" "$w selection clear $first $last\n" "while {$first <= $last} {\n" "if {[lsearch $Priv(listboxSelection) $first] >= 0} {\n" "$w selection set $first\n" "}\n" "incr first\n" "}\n" "event generate $w <>\n" "}\n" "proc ::tk::ListboxSelectAll w {\n" "set mode [$w cget -selectmode]\n" "if {$mode eq \"single\" || $mode eq \"browse\"} {\n" "$w selection clear 0 end\n" "$w selection set active\n" "} else {\n" "$w selection set 0 end\n" "}\n" "event generate $w <>\n" "}\n" ; static unsigned char Et_zFile19[] = "bind Menubutton {}\n" "bind Menubutton {\n" "tk::MbEnter %W\n" "}\n" "bind Menubutton {\n" "tk::MbLeave %W\n" "}\n" "bind Menubutton <1> {\n" "if {$tk::Priv(inMenubutton) ne \"\"} {\n" "tk::MbPost $tk::Priv(inMenubutton) %X %Y\n" "}\n" "}\n" "bind Menubutton {\n" "tk::MbMotion %W up %X %Y\n" "}\n" "bind Menubutton {\n" "tk::MbMotion %W down %X %Y\n" "}\n" "bind Menubutton {\n" "tk::MbButtonUp %W\n" "}\n" "bind Menubutton {\n" "tk::MbPost %W\n" "tk::MenuFirstEntry [%W cget -menu]\n" "}\n" "bind Menu {}\n" "bind Menu {\n" "set tk::Priv(window) %W\n" "if {[%W cget -type] eq \"tearoff\"} {\n" "if {\"%m\" ne \"NotifyUngrab\"} {\n" "if {[tk windowingsystem] eq \"x11\"} {\n" "tk_menuSetFocus %W\n" "}\n" "}\n" "}\n" "tk::MenuMotion %W %x %y %s\n" "}\n" "bind Menu {\n" "tk::MenuLeave %W %X %Y %s\n" "}\n" "bind Menu {\n" "tk::MenuMotion %W %x %y %s\n" "}\n" "bind Menu {\n" "tk::MenuButtonDown %W\n" "}\n" "bind Menu {\n" "tk::MenuInvoke %W 1\n" "}\n" "bind Menu {\n" "tk::MenuInvoke %W 0\n" "}\n" "bind Menu {\n" "tk::MenuInvoke %W 0\n" "}\n" "bind Menu {\n" "tk::MenuEscape %W\n" "}\n" "bind Menu {\n" "tk::MenuLeftArrow %W\n" "}\n" "bind Menu {\n" "tk::MenuRightArrow %W\n" "}\n" "bind Menu {\n" "tk::MenuUpArrow %W\n" "}\n" "bind Menu {\n" "tk::MenuDownArrow %W\n" "}\n" "bind Menu {\n" "tk::TraverseWithinMenu %W %A\n" "}\n" "if {[tk windowingsystem] eq \"x11\"} {\n" "bind all {\n" "tk::TraverseToMenu %W %A\n" "}\n" "bind all {\n" "tk::FirstMenu %W\n" "}\n" "} else {\n" "bind Menubutton {\n" "tk::TraverseToMenu %W %A\n" "}\n" "bind Menubutton {\n" "tk::FirstMenu %W\n" "}\n" "}\n" "proc ::tk::MbEnter w {\n" "variable ::tk::Priv\n" "if {$Priv(inMenubutton) ne \"\"} {\n" "MbLeave $Priv(inMenubutton)\n" "}\n" "set Priv(inMenubutton) $w\n" "if {[$w cget -state] ne \"disabled\"} {\n" "$w configure -state active\n" "}\n" "}\n" "proc ::tk::MbLeave w {\n" "variable ::tk::Priv\n" "set Priv(inMenubutton) {}\n" "if {![winfo exists $w]} {\n" "return\n" "}\n" "if {[$w cget -state] eq \"active\"} {\n" "$w configure -state normal\n" "}\n" "}\n" "proc ::tk::MbPost {w {x {}} {y {}}} {\n" "global errorInfo\n" "variable ::tk::Priv\n" "global tcl_platform\n" "if {[$w cget -state] eq \"disabled\" || $w eq $Priv(postedMb)} {\n" "return\n" "}\n" "set menu [$w cget -menu]\n" "if {$menu eq \"\"} {\n" "return\n" "}\n" "set tearoff [expr {[tk windowingsystem] eq \"x11\" \\\n" "\011 || [$menu cget -type] eq \"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 $Priv(postedMb)\n" "if {$cur ne \"\"} {\n" "MenuUnpost {}\n" "}\n" "set Priv(cursor) [$w cget -cursor]\n" "set Priv(relief) [$w cget -relief]\n" "$w configure -cursor arrow\n" "$w configure -relief raised\n" "set Priv(postedMb) $w\n" "set Priv(focus) [focus]\n" "$menu activate none\n" "GenerateMenuSelect $menu\n" "update idletasks\n" "if {[catch {\n" "switch [$w cget -direction] {\n" "above {\n" "set x [winfo rootx $w]\n" "set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]\n" "if {$y < 0} {\n" "set y [expr {[winfo rooty $w] + [winfo height $w]}]\n" "}\n" "PostOverPoint $menu $x $y\n" "}\n" "below {\n" "set x [winfo rootx $w]\n" "set y [expr {[winfo rooty $w] + [winfo height $w]}]\n" "set mh [winfo reqheight $menu]\n" "if {($y + $mh) > [winfo screenheight $w]} {\n" "set y [expr {[winfo rooty $w] - $mh}]\n" "}\n" "PostOverPoint $menu $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 [MenuFindName $menu [$w cget -text]]\n" "if {[$w cget -indicatoron]} {\n" "if {$entry == [$menu index last]} {\n" "incr y [expr {-([$menu yposition $entry] \\\n" "\011\011\011 \011+ [winfo reqheight $menu])/2}]\n" "} else {\n" "incr y [expr {-([$menu yposition $entry] \\\n" "\011\011\011 + [$menu yposition [expr {$entry+1}]])/2}]\n" "}\n" "}\n" "PostOverPoint $menu $x $y\n" "if {$entry ne \"\" \\\n" "\011\011\011&& [$menu entrycget $entry -state] ne \"disabled\"} {\n" "$menu activate $entry\n" "GenerateMenuSelect $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 [MenuFindName $menu [$w cget -text]]\n" "if {[$w cget -indicatoron]} {\n" "if {$entry == [$menu index last]} {\n" "incr y [expr {-([$menu yposition $entry] \\\n" "\011\011\011 \011+ [winfo reqheight $menu])/2}]\n" "} else {\n" "incr y [expr {-([$menu yposition $entry] \\\n" "\011\011\011 + [$menu yposition [expr {$entry+1}]])/2}]\n" "}\n" "}\n" "PostOverPoint $menu $x $y\n" "if {$entry ne \"\" \\\n" "\011\011\011&& [$menu entrycget $entry -state] ne \"disabled\"} {\n" "$menu activate $entry\n" "GenerateMenuSelect $menu\n" "}\n" "}\n" "default {\n" "if {[$w cget -indicatoron]} {\n" "if {$y eq \"\"} {\n" "set x [expr {[winfo rootx $w] + [winfo width $w]/2}]\n" "set y [expr {[winfo rooty $w] + [winfo height $w]/2}]\n" "}\n" "PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]\n" "} else {\n" "PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]\n" "}\n" "}\n" "}\n" "} msg]} {\n" "set savedInfo $errorInfo\n" "MenuUnpost {}\n" "error $msg $savedInfo\n" "}\n" "set Priv(tearoff) $tearoff\n" "if {$tearoff != 0} {\n" "focus $menu\n" "if {[winfo viewable $w]} {\n" "SaveGrabInfo $w\n" "grab -global $w\n" "}\n" "}\n" "}\n" "proc ::tk::MenuUnpost menu {\n" "global tcl_platform\n" "variable ::tk::Priv\n" "set mb $Priv(postedMb)\n" "catch {focus $Priv(focus)}\n" "set Priv(focus) \"\"\n" "catch {\n" "if {$mb ne \"\"} {\n" "set menu [$mb cget -menu]\n" "$menu unpost\n" "set Priv(postedMb) {}\n" "$mb configure -cursor $Priv(cursor)\n" "$mb configure -relief $Priv(relief)\n" "} elseif {$Priv(popup) ne \"\"} {\n" "$Priv(popup) unpost\n" "set Priv(popup) {}\n" "} elseif {[$menu cget -type] ne \"menubar\" && [$menu cget -type] ne \"tearoff\"} {\n" "while {1} {\n" "set parent [winfo parent $menu]\n" "if {[winfo class $parent] ne \"Menu\" || ![winfo ismapped $parent]} {\n" "break\n" "}\n" "$parent activate none\n" "$parent postcascade none\n" "GenerateMenuSelect $parent\n" "set type [$parent cget -type]\n" "if {$type eq \"menubar\" || $type eq \"tearoff\"} {\n" "break\n" "}\n" "set menu $parent\n" "}\n" "if {[$menu cget -type] ne \"menubar\"} {\n" "$menu unpost\n" "}\n" "}\n" "}\n" "if {($Priv(tearoff) != 0) || $Priv(menuBar) ne \"\"} {\n" "if {$menu ne \"\"} {\n" "set grab [grab current $menu]\n" "if {$grab ne \"\"} {\n" "grab release $grab\n" "}\n" "}\n" "RestoreOldGrab\n" "if {$Priv(menuBar) ne \"\"} {\n" "$Priv(menuBar) configure -cursor $Priv(cursor)\n" "set Priv(menuBar) {}\n" "}\n" "if {[tk windowingsystem] ne \"x11\"} {\n" "set Priv(tearoff) 0\n" "}\n" "}\n" "}\n" "proc ::tk::MbMotion {w upDown rootx rooty} {\n" "variable ::tk::Priv\n" "if {$Priv(inMenubutton) eq $w} {\n" "return\n" "}\n" "set new [winfo containing $rootx $rooty]\n" "if {$new ne $Priv(inMenubutton) \\\n" "\011 && ($new eq \"\" || [winfo toplevel $new] eq [winfo toplevel $w])} {\n" "if {$Priv(inMenubutton) ne \"\"} {\n" "MbLeave $Priv(inMenubutton)\n" "}\n" "if {$new ne \"\" \\\n" "\011\011&& [winfo class $new] eq \"Menubutton\" \\\n" "\011\011&& ([$new cget -indicatoron] == 0) \\\n" "\011\011&& ([$w cget -indicatoron] == 0)} {\n" "if {$upDown eq \"down\"} {\n" "MbPost $new $rootx $rooty\n" "} else {\n" "MbEnter $new\n" "}\n" "}\n" "}\n" "}\n" "proc ::tk::MbButtonUp w {\n" "variable ::tk::Priv\n" "global tcl_platform\n" "set menu [$w cget -menu]\n" "set tearoff [expr {[tk windowingsystem] eq \"x11\" || \\\n" "\011 ($menu ne \"\" && [$menu cget -type] eq \"tearoff\")}]\n" "if {($tearoff != 0) && $Priv(postedMb) eq $w \\\n" "\011 && $Priv(inMenubutton) eq $w} {\n" "MenuFirstEntry [$Priv(postedMb) cget -menu]\n" "} else {\n" "MenuUnpost {}\n" "}\n" "}\n" "proc ::tk::MenuMotion {menu x y state} {\n" "variable ::tk::Priv\n" "if {$menu eq $Priv(window)} {\n" "if {[$menu cget -type] eq \"menubar\"} {\n" "if {[info exists Priv(focus)] && $menu ne $Priv(focus)} {\n" "$menu activate @$x,$y\n" "GenerateMenuSelect $menu\n" "}\n" "} else {\n" "$menu activate @$x,$y\n" "GenerateMenuSelect $menu\n" "}\n" "}\n" "if {($state & 0x1f00) != 0} {\n" "$menu postcascade active\n" "}\n" "}\n" "proc ::tk::MenuButtonDown menu {\n" "variable ::tk::Priv\n" "global tcl_platform\n" "if {![winfo viewable $menu]} {\n" "return\n" "}\n" "$menu postcascade active\n" "if {$Priv(postedMb) ne \"\" && [winfo viewable $Priv(postedMb)]} {\n" "grab -global $Priv(postedMb)\n" "} else {\n" "while {[$menu cget -type] eq \"normal\" \\\n" "\011\011&& [winfo class [winfo parent $menu]] eq \"Menu\" \\\n" "\011\011&& [winfo ismapped [winfo parent $menu]]} {\n" "set menu [winfo parent $menu]\n" "}\n" "if {$Priv(menuBar) eq \"\"} {\n" "set Priv(menuBar) $menu\n" "set Priv(cursor) [$menu cget -cursor]\n" "$menu configure -cursor arrow\n" "}\n" "if {$menu ne [grab current $menu]} {\n" "SaveGrabInfo $menu\n" "}\n" "if {[tk windowingsystem] eq \"x11\"} {\n" "grab -global $menu\n" "}\n" "}\n" "}\n" "proc ::tk::MenuLeave {menu rootx rooty state} {\n" "variable ::tk::Priv\n" "set Priv(window) {}\n" "if {[$menu index active] eq \"none\"} {\n" "return\n" "}\n" "if {[$menu type active] eq \"cascade\" \\\n" "\011 && [winfo containing $rootx $rooty] eq [$menu entrycget active -menu]} {\n" "return\n" "}\n" "$menu activate none\n" "GenerateMenuSelect $menu\n" "}\n" "proc ::tk::MenuInvoke {w buttonRelease} {\n" "variable ::tk::Priv\n" "if {$buttonRelease && $Priv(window) eq \"\"} {\n" "$w postcascade none\n" "$w activate none\n" "event generate $w <>\n" "MenuUnpost $w\n" "return\n" "}\n" "if {[$w type active] eq \"cascade\"} {\n" "$w postcascade active\n" "set menu [$w entrycget active -menu]\n" "MenuFirstEntry $menu\n" "} elseif {[$w type active] eq \"tearoff\"} {\n" "::tk::TearOffMenu $w\n" "MenuUnpost $w\n" "} elseif {[$w cget -type] eq \"menubar\"} {\n" "$w postcascade none\n" "set active [$w index active]\n" "set isCascade [string equal [$w type $active] \"cascade\"]\n" "if { $isCascade } {\n" "$w activate none\n" "event generate $w <>\n" "}\n" "MenuUnpost $w\n" "if { !$isCascade } {\n" "uplevel #0 [list $w invoke $active]\n" "}\n" "} else {\n" "set active [$w index active]\n" "if {$Priv(popup) eq \"\" || $active ne \"none\"} {\n" "MenuUnpost $w\n" "}\n" "uplevel #0 [list $w invoke active]\n" "}\n" "}\n" "proc ::tk::MenuEscape menu {\n" "set parent [winfo parent $menu]\n" "if {[winfo class $parent] ne \"Menu\"} {\n" "MenuUnpost $menu\n" "} elseif {[$parent cget -type] eq \"menubar\"} {\n" "MenuUnpost $menu\n" "RestoreOldGrab\n" "} else {\n" "MenuNextMenu $menu left\n" "}\n" "}\n" "proc ::tk::MenuUpArrow {menu} {\n" "if {[$menu cget -type] eq \"menubar\"} {\n" "MenuNextMenu $menu left\n" "} else {\n" "MenuNextEntry $menu -1\n" "}\n" "}\n" "proc ::tk::MenuDownArrow {menu} {\n" "if {[$menu cget -type] eq \"menubar\"} {\n" "MenuNextMenu $menu right\n" "} else {\n" "MenuNextEntry $menu 1\n" "}\n" "}\n" "proc ::tk::MenuLeftArrow {menu} {\n" "if {[$menu cget -type] eq \"menubar\"} {\n" "MenuNextEntry $menu -1\n" "} else {\n" "MenuNextMenu $menu left\n" "}\n" "}\n" "proc ::tk::MenuRightArrow {menu} {\n" "if {[$menu cget -type] eq \"menubar\"} {\n" "MenuNextEntry $menu 1\n" "} else {\n" "MenuNextMenu $menu right\n" "}\n" "}\n" "proc ::tk::MenuNextMenu {menu direction} {\n" "variable ::tk::Priv\n" "if {$direction eq \"right\"} {\n" "set count 1\n" "set parent [winfo parent $menu]\n" "set class [winfo class $parent]\n" "if {[$menu type active] eq \"cascade\"} {\n" "$menu postcascade active\n" "set m2 [$menu entrycget active -menu]\n" "if {$m2 ne \"\"} {\n" "MenuFirstEntry $m2\n" "}\n" "return\n" "} else {\n" "set parent [winfo parent $menu]\n" "while {$parent ne \".\"} {\n" "if {[winfo class $parent] eq \"Menu\" && [$parent cget -type] eq \"menubar\"} {\n" "tk_menuSetFocus $parent\n" "MenuNextEntry $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] eq \"Menu\"} {\n" "$menu activate none\n" "GenerateMenuSelect $menu\n" "tk_menuSetFocus $m2\n" "$m2 postcascade none\n" "if {[$m2 cget -type] ne \"menubar\"} {\n" "return\n" "}\n" "}\n" "}\n" "set m2 [winfo parent $menu]\n" "if {[winfo class $m2] eq \"Menu\"} {\n" "if {[$m2 cget -type] eq \"menubar\"} {\n" "tk_menuSetFocus $m2\n" "MenuNextEntry $m2 -1\n" "return\n" "}\n" "}\n" "set w $Priv(postedMb)\n" "if {$w eq \"\"} {\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] eq \"Menubutton\" \\\n" "\011\011&& [$mb cget -state] ne \"disabled\" \\\n" "\011\011&& [$mb cget -menu] ne \"\" \\\n" "\011\011&& [[$mb cget -menu] index last] ne \"none\"} {\n" "break\n" "}\n" "if {$mb eq $w} {\n" "return\n" "}\n" "incr i $count\n" "}\n" "MbPost $mb\n" "MenuFirstEntry [$mb cget -menu]\n" "}\n" "proc ::tk::MenuNextEntry {menu count} {\n" "if {[$menu index last] eq \"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 eq \"none\"} {\n" "set i 0\n" "} else {\n" "set i [expr {$active + $count}]\n" "}\n" "while {1} {\n" "if {$quitAfter <= 0} {\n" "return\n" "}\n" "while {$i < 0} {\n" "incr i $length\n" "}\n" "while {$i >= $length} {\n" "incr i -$length\n" "}\n" "if {[catch {$menu entrycget $i -state} state] == 0} {\n" "if {$state ne \"disabled\" && \\\n" "\011\011 ($i!=0 || [$menu cget -type] ne \"tearoff\" \\\n" "\011\011 || [$menu type 0] ne \"tearoff\")} {\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" "GenerateMenuSelect $menu\n" "if {[$menu type $i] eq \"cascade\" && [$menu cget -type] eq \"menubar\"} {\n" "set cascade [$menu entrycget $i -menu]\n" "if {$cascade ne \"\"} {\n" "$menu postcascade $i\n" "MenuFirstEntry $cascade\n" "}\n" "}\n" "}\n" "proc ::tk::MenuFind {w char} {\n" "set char [string tolower $char]\n" "set windowlist [winfo child $w]\n" "foreach child $windowlist {\n" "if {[winfo toplevel $w] ne [winfo toplevel $child]} {\n" "continue\n" "}\n" "if {[winfo class $child] eq \"Menu\" && [$child cget -type] eq \"menubar\"} {\n" "if {$char eq \"\"} {\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] eq \"separator\"} {\n" "continue\n" "}\n" "set char2 [string index [$child entrycget $i -label] \\\n" "\011\011\011[$child entrycget $i -underline]]\n" "if {$char eq [string tolower $char2] || $char eq \"\"} {\n" "if {[$child entrycget $i -state] ne \"disabled\"} {\n" "return $child\n" "}\n" "}\n" "}\n" "}\n" "}\n" "foreach child $windowlist {\n" "if {[winfo toplevel $w] ne [winfo toplevel $child]} {\n" "continue\n" "}\n" "switch [winfo class $child] {\n" "Menubutton {\n" "set char2 [string index [$child cget -text] \\\n" "\011\011\011[$child cget -underline]]\n" "if {$char eq [string tolower $char2] || $char eq \"\"} {\n" "if {[$child cget -state] ne \"disabled\"} {\n" "return $child\n" "}\n" "}\n" "}\n" "default {\n" "set match [MenuFind $child $char]\n" "if {$match ne \"\"} {\n" "return $match\n" "}\n" "}\n" "}\n" "}\n" "return {}\n" "}\n" "proc ::tk::TraverseToMenu {w char} {\n" "variable ::tk::Priv\n" "if {$char eq \"\"} {\n" "return\n" "}\n" "while {[winfo class $w] eq \"Menu\"} {\n" "if {[$w cget -type] eq \"menubar\"} {\n" "break\n" "} elseif {$Priv(postedMb) eq \"\"} {\n" "return\n" "}\n" "set w [winfo parent $w]\n" "}\n" "set w [MenuFind [winfo toplevel $w] $char]\n" "if {$w ne \"\"} {\n" "if {[winfo class $w] eq \"Menu\"} {\n" "tk_menuSetFocus $w\n" "set Priv(window) $w\n" "SaveGrabInfo $w\n" "grab -global $w\n" "TraverseWithinMenu $w $char\n" "} else {\n" "MbPost $w\n" "MenuFirstEntry [$w cget -menu]\n" "}\n" "}\n" "}\n" "proc ::tk::FirstMenu w {\n" "variable ::tk::Priv\n" "set w [MenuFind [winfo toplevel $w] \"\"]\n" "if {$w ne \"\"} {\n" "if {[winfo class $w] eq \"Menu\"} {\n" "tk_menuSetFocus $w\n" "set Priv(window) $w\n" "SaveGrabInfo $w\n" "grab -global $w\n" "MenuFirstEntry $w\n" "} else {\n" "MbPost $w\n" "MenuFirstEntry [$w cget -menu]\n" "}\n" "}\n" "}\n" "proc ::tk::TraverseWithinMenu {w char} {\n" "if {$char eq \"\"} {\n" "return\n" "}\n" "set char [string tolower $char]\n" "set last [$w index last]\n" "if {$last eq \"none\"} {\n" "return\n" "}\n" "for {set i 0} {$i <= $last} {incr i} {\n" "if {[catch {set char2 [string index \\\n" "\011\011[$w entrycget $i -label] [$w entrycget $i -underline]]}]} {\n" "continue\n" "}\n" "if {$char eq [string tolower $char2]} {\n" "if {[$w type $i] eq \"cascade\"} {\n" "$w activate $i\n" "$w postcascade active\n" "event generate $w <>\n" "set m2 [$w entrycget $i -menu]\n" "if {$m2 ne \"\"} {\n" "MenuFirstEntry $m2\n" "}\n" "} else {\n" "MenuUnpost $w\n" "uplevel #0 [list $w invoke $i]\n" "}\n" "return\n" "}\n" "}\n" "}\n" "proc ::tk::MenuFirstEntry menu {\n" "if {$menu eq \"\"} {\n" "return\n" "}\n" "tk_menuSetFocus $menu\n" "if {[$menu index active] ne \"none\"} {\n" "return\n" "}\n" "set last [$menu index last]\n" "if {$last eq \"none\"} {\n" "return\n" "}\n" "for {set i 0} {$i <= $last} {incr i} {\n" "if {([catch {set state [$menu entrycget $i -state]}] == 0) \\\n" "\011\011&& $state ne \"disabled\" \\\n" "\011\011&& [$menu type $i] ne \"tearoff\"} {\n" "$menu activate $i\n" "GenerateMenuSelect $menu\n" "if {[$menu type $i] eq \"cascade\" &&\011[$menu cget -type] eq \"menubar\"} {\n" "set cascade [$menu entrycget $i -menu]\n" "if {$cascade ne \"\"} {\n" "$menu postcascade $i\n" "MenuFirstEntry $cascade\n" "}\n" "}\n" "return\n" "}\n" "}\n" "}\n" "proc ::tk::MenuFindName {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 eq \"none\"} {\n" "return\n" "}\n" "for {set i 0} {$i <= $last} {incr i} {\n" "if {![catch {$menu entrycget $i -label} label]} {\n" "if {$label eq $s} {\n" "return $i\n" "}\n" "}\n" "}\n" "return \"\"\n" "}\n" "proc ::tk::PostOverPoint {menu x y {entry {}}} {\n" "global tcl_platform\n" "if {$entry ne \"\"} {\n" "if {$entry == [$menu index last]} {\n" "incr y [expr {-([$menu yposition $entry] \\\n" "\011\011 + [winfo reqheight $menu])/2}]\n" "} else {\n" "incr y [expr {-([$menu yposition $entry] \\\n" "\011\011 + [$menu yposition [expr {$entry+1}]])/2}]\n" "}\n" "incr x [expr {-[winfo reqwidth $menu]/2}]\n" "}\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "set yoffset [expr {[winfo screenheight $menu] \\\n" "\011\011- $y - [winfo reqheight $menu] - 10}]\n" "if {$yoffset < 0} {\n" "incr y $yoffset\n" "if {$y < 0} { set y 0 }\n" "}\n" "if {$y < 0} {\n" "set y 0\n" "}\n" "}\n" "$menu post $x $y\n" "if {$entry ne \"\" && [$menu entrycget $entry -state] ne \"disabled\"} {\n" "$menu activate $entry\n" "GenerateMenuSelect $menu\n" "}\n" "}\n" "proc tk::SaveGrabInfo w {\n" "variable ::tk::Priv\n" "set Priv(oldGrab) [grab current $w]\n" "if {$Priv(oldGrab) ne \"\"} {\n" "set Priv(grabStatus) [grab status $Priv(oldGrab)]\n" "}\n" "}\n" "proc ::tk::RestoreOldGrab {} {\n" "variable ::tk::Priv\n" "if {$Priv(oldGrab) ne \"\"} {\n" "catch {\n" "if {$Priv(grabStatus) eq \"global\"} {\n" "grab set -global $Priv(oldGrab)\n" "} else {\n" "grab set $Priv(oldGrab)\n" "}\n" "}\n" "set Priv(oldGrab) \"\"\n" "}\n" "}\n" "proc ::tk_menuSetFocus {menu} {\n" "variable ::tk::Priv\n" "if {![info exists Priv(focus)] || $Priv(focus) eq \"\"} {\n" "set Priv(focus) [focus]\n" "}\n" "focus $menu\n" "}\n" "proc ::tk::GenerateMenuSelect {menu} {\n" "variable ::tk::Priv\n" "if {$Priv(activeMenu) eq $menu && $Priv(activeItem) eq [$menu index active]} {\n" "return\n" "}\n" "set Priv(activeMenu) $menu\n" "set Priv(activeItem) [$menu index active]\n" "event generate $menu <>\n" "}\n" "proc ::tk_popup {menu x y {entry {}}} {\n" "variable ::tk::Priv\n" "global tcl_platform\n" "if {$Priv(popup) ne \"\" || $Priv(postedMb) ne \"\"} {\n" "tk::MenuUnpost {}\n" "}\n" "tk::PostOverPoint $menu $x $y $entry\n" "if {[tk windowingsystem] eq \"x11\" && [winfo viewable $menu]} {\n" "tk::SaveGrabInfo $menu\n" "grab -global $menu\n" "set Priv(popup) $menu\n" "tk_menuSetFocus $menu\n" "}\n" "}\n" ; static unsigned char Et_zFile20[] = "proc ::tk::CreatePostscriptEncoding {encoding} {\n" "set result \"/CurrentEncoding \\[\\n\"\n" "for {set i 0} {$i<256} {incr i 8} {\n" "for {set j 0} {$j<8} {incr j} {\n" "set enc [encoding convertfrom $encoding [format %c [expr {$i+$j}]]]\n" "if {[catch {format %04X [scan $enc %c]} hexcode]} {set hexcode {}}\n" "if [info exists ::tk::psglyphs($hexcode)] {\n" "append result \"/$::tk::psglyphs($hexcode)\"\n" "} else {\n" "append result \"/space\"\n" "}\n" "}\n" "append result \"\\n\"\n" "}\n" "append result \"\\] def\\n\"\n" "return $result\n" "}\n" "namespace eval ::tk {\n" "array set psglyphs {\n" "0020 space\n" "0021 exclam\n" "0022 quotedbl\n" "0023 numbersign\n" "0024 dollar\n" "0025 percent\n" "0026 ampersand\n" "0027 quotesingle\n" "0028 parenleft\n" "0029 parenright\n" "002A asterisk\n" "002B plus\n" "002C comma\n" "002D hyphen\n" "002E period\n" "002F slash\n" "0030 zero\n" "0031 one\n" "0032 two\n" "0033 three\n" "0034 four\n" "0035 five\n" "0036 six\n" "0037 seven\n" "0038 eight\n" "0039 nine\n" "003A colon\n" "003B semicolon\n" "003C less\n" "003D equal\n" "003E greater\n" "003F question\n" "0040 at\n" "0041 A\n" "0042 B\n" "0043 C\n" "0044 D\n" "0045 E\n" "0046 F\n" "0047 G\n" "0048 H\n" "0049 I\n" "004A J\n" "004B K\n" "004C L\n" "004D M\n" "004E N\n" "004F O\n" "0050 P\n" "0051 Q\n" "0052 R\n" "0053 S\n" "0054 T\n" "0055 U\n" "0056 V\n" "0057 W\n" "0058 X\n" "0059 Y\n" "005A Z\n" "005B bracketleft\n" "005C backslash\n" "005D bracketright\n" "005E asciicircum\n" "005F underscore\n" "0060 grave\n" "0061 a\n" "0062 b\n" "0063 c\n" "0064 d\n" "0065 e\n" "0066 f\n" "0067 g\n" "0068 h\n" "0069 i\n" "006A j\n" "006B k\n" "006C l\n" "006D m\n" "006E n\n" "006F o\n" "0070 p\n" "0071 q\n" "0072 r\n" "0073 s\n" "0074 t\n" "0075 u\n" "0076 v\n" "0077 w\n" "0078 x\n" "0079 y\n" "007A z\n" "007B braceleft\n" "007C bar\n" "007D braceright\n" "007E asciitilde\n" "00A0 space\n" "00A1 exclamdown\n" "00A2 cent\n" "00A3 sterling\n" "00A4 currency\n" "00A5 yen\n" "00A6 brokenbar\n" "00A7 section\n" "00A8 dieresis\n" "00A9 copyright\n" "00AA ordfeminine\n" "00AB guillemotleft\n" "00AC logicalnot\n" "00AD hyphen\n" "00AE registered\n" "00AF macron\n" "00B0 degree\n" "00B1 plusminus\n" "00B2 twosuperior\n" "00B3 threesuperior\n" "00B4 acute\n" "00B5 mu\n" "00B6 paragraph\n" "00B7 periodcentered\n" "00B8 cedilla\n" "00B9 onesuperior\n" "00BA ordmasculine\n" "00BB guillemotright\n" "00BC onequarter\n" "00BD onehalf\n" "00BE threequarters\n" "00BF questiondown\n" "00C0 Agrave\n" "00C1 Aacute\n" "00C2 Acircumflex\n" "00C3 Atilde\n" "00C4 Adieresis\n" "00C5 Aring\n" "00C6 AE\n" "00C7 Ccedilla\n" "00C8 Egrave\n" "00C9 Eacute\n" "00CA Ecircumflex\n" "00CB Edieresis\n" "00CC Igrave\n" "00CD Iacute\n" "00CE Icircumflex\n" "00CF Idieresis\n" "00D0 Eth\n" "00D1 Ntilde\n" "00D2 Ograve\n" "00D3 Oacute\n" "00D4 Ocircumflex\n" "00D5 Otilde\n" "00D6 Odieresis\n" "00D7 multiply\n" "00D8 Oslash\n" "00D9 Ugrave\n" "00DA Uacute\n" "00DB Ucircumflex\n" "00DC Udieresis\n" "00DD Yacute\n" "00DE Thorn\n" "00DF germandbls\n" "00E0 agrave\n" "00E1 aacute\n" "00E2 acircumflex\n" "00E3 atilde\n" "00E4 adieresis\n" "00E5 aring\n" "00E6 ae\n" "00E7 ccedilla\n" "00E8 egrave\n" "00E9 eacute\n" "00EA ecircumflex\n" "00EB edieresis\n" "00EC igrave\n" "00ED iacute\n" "00EE icircumflex\n" "00EF idieresis\n" "00F0 eth\n" "00F1 ntilde\n" "00F2 ograve\n" "00F3 oacute\n" "00F4 ocircumflex\n" "00F5 otilde\n" "00F6 odieresis\n" "00F7 divide\n" "00F8 oslash\n" "00F9 ugrave\n" "00FA uacute\n" "00FB ucircumflex\n" "00FC udieresis\n" "00FD yacute\n" "00FE thorn\n" "00FF ydieresis\n" "0100 Amacron\n" "0101 amacron\n" "0102 Abreve\n" "0103 abreve\n" "0104 Aogonek\n" "0105 aogonek\n" "0106 Cacute\n" "0107 cacute\n" "0108 Ccircumflex\n" "0109 ccircumflex\n" "010A Cdotaccent\n" "010B cdotaccent\n" "010C Ccaron\n" "010D ccaron\n" "010E Dcaron\n" "010F dcaron\n" "0110 Dcroat\n" "0111 dcroat\n" "0112 Emacron\n" "0113 emacron\n" "0114 Ebreve\n" "0115 ebreve\n" "0116 Edotaccent\n" "0117 edotaccent\n" "0118 Eogonek\n" "0119 eogonek\n" "011A Ecaron\n" "011B ecaron\n" "011C Gcircumflex\n" "011D gcircumflex\n" "011E Gbreve\n" "011F gbreve\n" "0120 Gdotaccent\n" "0121 gdotaccent\n" "0122 Gcommaaccent\n" "0123 gcommaaccent\n" "0124 Hcircumflex\n" "0125 hcircumflex\n" "0126 Hbar\n" "0127 hbar\n" "0128 Itilde\n" "0129 itilde\n" "012A Imacron\n" "012B imacron\n" "012C Ibreve\n" "012D ibreve\n" "012E Iogonek\n" "012F iogonek\n" "0130 Idotaccent\n" "0131 dotlessi\n" "0132 IJ\n" "0133 ij\n" "0134 Jcircumflex\n" "0135 jcircumflex\n" "0136 Kcommaaccent\n" "0137 kcommaaccent\n" "0138 kgreenlandic\n" "0139 Lacute\n" "013A lacute\n" "013B Lcommaaccent\n" "013C lcommaaccent\n" "013D Lcaron\n" "013E lcaron\n" "013F Ldot\n" "0140 ldot\n" "0141 Lslash\n" "0142 lslash\n" "0143 Nacute\n" "0144 nacute\n" "0145 Ncommaaccent\n" "0146 ncommaaccent\n" "0147 Ncaron\n" "0148 ncaron\n" "0149 napostrophe\n" "014A Eng\n" "014B eng\n" "014C Omacron\n" "014D omacron\n" "014E Obreve\n" "014F obreve\n" "0150 Ohungarumlaut\n" "0151 ohungarumlaut\n" "0152 OE\n" "0153 oe\n" "0154 Racute\n" "0155 racute\n" "0156 Rcommaaccent\n" "0157 rcommaaccent\n" "0158 Rcaron\n" "0159 rcaron\n" "015A Sacute\n" "015B sacute\n" "015C Scircumflex\n" "015D scircumflex\n" "015E Scedilla\n" "015F scedilla\n" "0160 Scaron\n" "0161 scaron\n" "0162 Tcommaaccent\n" "0163 tcommaaccent\n" "0164 Tcaron\n" "0165 tcaron\n" "0166 Tbar\n" "0167 tbar\n" "0168 Utilde\n" "0169 utilde\n" "016A Umacron\n" "016B umacron\n" "016C Ubreve\n" "016D ubreve\n" "016E Uring\n" "016F uring\n" "0170 Uhungarumlaut\n" "0171 uhungarumlaut\n" "0172 Uogonek\n" "0173 uogonek\n" "0174 Wcircumflex\n" "0175 wcircumflex\n" "0176 Ycircumflex\n" "0177 ycircumflex\n" "0178 Ydieresis\n" "0179 Zacute\n" "017A zacute\n" "017B Zdotaccent\n" "017C zdotaccent\n" "017D Zcaron\n" "017E zcaron\n" "017F longs\n" "0192 florin\n" "01A0 Ohorn\n" "01A1 ohorn\n" "01AF Uhorn\n" "01B0 uhorn\n" "01E6 Gcaron\n" "01E7 gcaron\n" "01FA Aringacute\n" "01FB aringacute\n" "01FC AEacute\n" "01FD aeacute\n" "01FE Oslashacute\n" "01FF oslashacute\n" "0218 Scommaaccent\n" "0219 scommaaccent\n" "021A Tcommaaccent\n" "021B tcommaaccent\n" "02BC afii57929\n" "02BD afii64937\n" "02C6 circumflex\n" "02C7 caron\n" "02C9 macron\n" "02D8 breve\n" "02D9 dotaccent\n" "02DA ring\n" "02DB ogonek\n" "02DC tilde\n" "02DD hungarumlaut\n" "0300 gravecomb\n" "0301 acutecomb\n" "0303 tildecomb\n" "0309 hookabovecomb\n" "0323 dotbelowcomb\n" "0384 tonos\n" "0385 dieresistonos\n" "0386 Alphatonos\n" "0387 anoteleia\n" "0388 Epsilontonos\n" "0389 Etatonos\n" "038A Iotatonos\n" "038C Omicrontonos\n" "038E Upsilontonos\n" "038F Omegatonos\n" "0390 iotadieresistonos\n" "0391 Alpha\n" "0392 Beta\n" "0393 Gamma\n" "0394 Delta\n" "0395 Epsilon\n" "0396 Zeta\n" "0397 Eta\n" "0398 Theta\n" "0399 Iota\n" "039A Kappa\n" "039B Lambda\n" "039C Mu\n" "039D Nu\n" "039E Xi\n" "039F Omicron\n" "03A0 Pi\n" "03A1 Rho\n" "03A3 Sigma\n" "03A4 Tau\n" "03A5 Upsilon\n" "03A6 Phi\n" "03A7 Chi\n" "03A8 Psi\n" "03A9 Omega\n" "03AA Iotadieresis\n" "03AB Upsilondieresis\n" "03AC alphatonos\n" "03AD epsilontonos\n" "03AE etatonos\n" "03AF iotatonos\n" "03B0 upsilondieresistonos\n" "03B1 alpha\n" "03B2 beta\n" "03B3 gamma\n" "03B4 delta\n" "03B5 epsilon\n" "03B6 zeta\n" "03B7 eta\n" "03B8 theta\n" "03B9 iota\n" "03BA kappa\n" "03BB lambda\n" "03BC mu\n" "03BD nu\n" "03BE xi\n" "03BF omicron\n" "03C0 pi\n" "03C1 rho\n" "03C2 sigma1\n" "03C3 sigma\n" "03C4 tau\n" "03C5 upsilon\n" "03C6 phi\n" "03C7 chi\n" "03C8 psi\n" "03C9 omega\n" "03CA iotadieresis\n" "03CB upsilondieresis\n" "03CC omicrontonos\n" "03CD upsilontonos\n" "03CE omegatonos\n" "03D1 theta1\n" "03D2 Upsilon1\n" "03D5 phi1\n" "03D6 omega1\n" "0401 afii10023\n" "0402 afii10051\n" "0403 afii10052\n" "0404 afii10053\n" "0405 afii10054\n" "0406 afii10055\n" "0407 afii10056\n" "0408 afii10057\n" "0409 afii10058\n" "040A afii10059\n" "040B afii10060\n" "040C afii10061\n" "040E afii10062\n" "040F afii10145\n" "0410 afii10017\n" "0411 afii10018\n" "0412 afii10019\n" "0413 afii10020\n" "0414 afii10021\n" "0415 afii10022\n" "0416 afii10024\n" "0417 afii10025\n" "0418 afii10026\n" "0419 afii10027\n" "041A afii10028\n" "041B afii10029\n" "041C afii10030\n" "041D afii10031\n" "041E afii10032\n" "041F afii10033\n" "0420 afii10034\n" "0421 afii10035\n" "0422 afii10036\n" "0423 afii10037\n" "0424 afii10038\n" "0425 afii10039\n" "0426 afii10040\n" "0427 afii10041\n" "0428 afii10042\n" "0429 afii10043\n" "042A afii10044\n" "042B afii10045\n" "042C afii10046\n" "042D afii10047\n" "042E afii10048\n" "042F afii10049\n" "0430 afii10065\n" "0431 afii10066\n" "0432 afii10067\n" "0433 afii10068\n" "0434 afii10069\n" "0435 afii10070\n" "0436 afii10072\n" "0437 afii10073\n" "0438 afii10074\n" "0439 afii10075\n" "043A afii10076\n" "043B afii10077\n" "043C afii10078\n" "043D afii10079\n" "043E afii10080\n" "043F afii10081\n" "0440 afii10082\n" "0441 afii10083\n" "0442 afii10084\n" "0443 afii10085\n" "0444 afii10086\n" "0445 afii10087\n" "0446 afii10088\n" "0447 afii10089\n" "0448 afii10090\n" "0449 afii10091\n" "044A afii10092\n" "044B afii10093\n" "044C afii10094\n" "044D afii10095\n" "044E afii10096\n" "044F afii10097\n" "0451 afii10071\n" "0452 afii10099\n" "0453 afii10100\n" "0454 afii10101\n" "0455 afii10102\n" "0456 afii10103\n" "0457 afii10104\n" "0458 afii10105\n" "0459 afii10106\n" "045A afii10107\n" "045B afii10108\n" "045C afii10109\n" "045E afii10110\n" "045F afii10193\n" "0462 afii10146\n" "0463 afii10194\n" "0472 afii10147\n" "0473 afii10195\n" "0474 afii10148\n" "0475 afii10196\n" "0490 afii10050\n" "0491 afii10098\n" "04D9 afii10846\n" "05B0 afii57799\n" "05B1 afii57801\n" "05B2 afii57800\n" "05B3 afii57802\n" "05B4 afii57793\n" "05B5 afii57794\n" "05B6 afii57795\n" "05B7 afii57798\n" "05B8 afii57797\n" "05B9 afii57806\n" "05BB afii57796\n" "05BC afii57807\n" "05BD afii57839\n" "05BE afii57645\n" "05BF afii57841\n" "05C0 afii57842\n" "05C1 afii57804\n" "05C2 afii57803\n" "05C3 afii57658\n" "05D0 afii57664\n" "05D1 afii57665\n" "05D2 afii57666\n" "05D3 afii57667\n" "05D4 afii57668\n" "05D5 afii57669\n" "05D6 afii57670\n" "05D7 afii57671\n" "05D8 afii57672\n" "05D9 afii57673\n" "05DA afii57674\n" "05DB afii57675\n" "05DC afii57676\n" "05DD afii57677\n" "05DE afii57678\n" "05DF afii57679\n" "05E0 afii57680\n" "05E1 afii57681\n" "05E2 afii57682\n" "05E3 afii57683\n" "05E4 afii57684\n" "05E5 afii57685\n" "05E6 afii57686\n" "05E7 afii57687\n" "05E8 afii57688\n" "05E9 afii57689\n" "05EA afii57690\n" "05F0 afii57716\n" "05F1 afii57717\n" "05F2 afii57718\n" "060C afii57388\n" "061B afii57403\n" "061F afii57407\n" "0621 afii57409\n" "0622 afii57410\n" "0623 afii57411\n" "0624 afii57412\n" "0625 afii57413\n" "0626 afii57414\n" "0627 afii57415\n" "0628 afii57416\n" "0629 afii57417\n" "062A afii57418\n" "062B afii57419\n" "062C afii57420\n" "062D afii57421\n" "062E afii57422\n" "062F afii57423\n" "0630 afii57424\n" "0631 afii57425\n" "0632 afii57426\n" "0633 afii57427\n" "0634 afii57428\n" "0635 afii57429\n" "0636 afii57430\n" "0637 afii57431\n" "0638 afii57432\n" "0639 afii57433\n" "063A afii57434\n" "0640 afii57440\n" "0641 afii57441\n" "0642 afii57442\n" "0643 afii57443\n" "0644 afii57444\n" "0645 afii57445\n" "0646 afii57446\n" "0647 afii57470\n" "0648 afii57448\n" "0649 afii57449\n" "064A afii57450\n" "064B afii57451\n" "064C afii57452\n" "064D afii57453\n" "064E afii57454\n" "064F afii57455\n" "0650 afii57456\n" "0651 afii57457\n" "0652 afii57458\n" "0660 afii57392\n" "0661 afii57393\n" "0662 afii57394\n" "0663 afii57395\n" "0664 afii57396\n" "0665 afii57397\n" "0666 afii57398\n" "0667 afii57399\n" "0668 afii57400\n" "0669 afii57401\n" "066A afii57381\n" "066D afii63167\n" "0679 afii57511\n" "067E afii57506\n" "0686 afii57507\n" "0688 afii57512\n" "0691 afii57513\n" "0698 afii57508\n" "06A4 afii57505\n" "06AF afii57509\n" "06BA afii57514\n" "06D2 afii57519\n" "06D5 afii57534\n" "1E80 Wgrave\n" "1E81 wgrave\n" "1E82 Wacute\n" "1E83 wacute\n" "1E84 Wdieresis\n" "1E85 wdieresis\n" "1EF2 Ygrave\n" "1EF3 ygrave\n" "200C afii61664\n" "200D afii301\n" "200E afii299\n" "200F afii300\n" "2012 figuredash\n" "2013 endash\n" "2014 emdash\n" "2015 afii00208\n" "2017 underscoredbl\n" "2018 quoteleft\n" "2019 quoteright\n" "201A quotesinglbase\n" "201B quotereversed\n" "201C quotedblleft\n" "201D quotedblright\n" "201E quotedblbase\n" "2020 dagger\n" "2021 daggerdbl\n" "2022 bullet\n" "2024 onedotenleader\n" "2025 twodotenleader\n" "2026 ellipsis\n" "202C afii61573\n" "202D afii61574\n" "202E afii61575\n" "2030 perthousand\n" "2032 minute\n" "2033 second\n" "2039 guilsinglleft\n" "203A guilsinglright\n" "203C exclamdbl\n" "2044 fraction\n" "2070 zerosuperior\n" "2074 foursuperior\n" "2075 fivesuperior\n" "2076 sixsuperior\n" "2077 sevensuperior\n" "2078 eightsuperior\n" "2079 ninesuperior\n" "207D parenleftsuperior\n" "207E parenrightsuperior\n" "207F nsuperior\n" "2080 zeroinferior\n" "2081 oneinferior\n" "2082 twoinferior\n" "2083 threeinferior\n" "2084 fourinferior\n" "2085 fiveinferior\n" "2086 sixinferior\n" "2087 seveninferior\n" "2088 eightinferior\n" "2089 nineinferior\n" "208D parenleftinferior\n" "208E parenrightinferior\n" "20A1 colonmonetary\n" "20A3 franc\n" "20A4 lira\n" "20A7 peseta\n" "20AA afii57636\n" "20AB dong\n" "20AC Euro\n" "2105 afii61248\n" "2111 Ifraktur\n" "2113 afii61289\n" "2116 afii61352\n" "2118 weierstrass\n" "211C Rfraktur\n" "211E prescription\n" "2122 trademark\n" "2126 Omega\n" "212E estimated\n" "2135 aleph\n" "2153 onethird\n" "2154 twothirds\n" "215B oneeighth\n" "215C threeeighths\n" "215D fiveeighths\n" "215E seveneighths\n" "2190 arrowleft\n" "2191 arrowup\n" "2192 arrowright\n" "2193 arrowdown\n" "2194 arrowboth\n" "2195 arrowupdn\n" "21A8 arrowupdnbse\n" "21B5 carriagereturn\n" "21D0 arrowdblleft\n" "21D1 arrowdblup\n" "21D2 arrowdblright\n" "21D3 arrowdbldown\n" "21D4 arrowdblboth\n" "2200 universal\n" "2202 partialdiff\n" "2203 existential\n" "2205 emptyset\n" "2206 Delta\n" "2207 gradient\n" "2208 element\n" "2209 notelement\n" "220B suchthat\n" "220F product\n" "2211 summation\n" "2212 minus\n" "2215 fraction\n" "2217 asteriskmath\n" "2219 periodcentered\n" "221A radical\n" "221D proportional\n" "221E infinity\n" "221F orthogonal\n" "2220 angle\n" "2227 logicaland\n" "2228 logicalor\n" "2229 intersection\n" "222A union\n" "222B integral\n" "2234 therefore\n" "223C similar\n" "2245 congruent\n" "2248 approxequal\n" "2260 notequal\n" "2261 equivalence\n" "2264 lessequal\n" "2265 greaterequal\n" "2282 propersubset\n" "2283 propersuperset\n" "2284 notsubset\n" "2286 reflexsubset\n" "2287 reflexsuperset\n" "2295 circleplus\n" "2297 circlemultiply\n" "22A5 perpendicular\n" "22C5 dotmath\n" "2302 house\n" "2310 revlogicalnot\n" "2320 integraltp\n" "2321 integralbt\n" "2329 angleleft\n" "232A angleright\n" "2500 SF100000\n" "2502 SF110000\n" "250C SF010000\n" "2510 SF030000\n" "2514 SF020000\n" "2518 SF040000\n" "251C SF080000\n" "2524 SF090000\n" "252C SF060000\n" "2534 SF070000\n" "253C SF050000\n" "2550 SF430000\n" "2551 SF240000\n" "2552 SF510000\n" "2553 SF520000\n" "2554 SF390000\n" "2555 SF220000\n" "2556 SF210000\n" "2557 SF250000\n" "2558 SF500000\n" "2559 SF490000\n" "255A SF380000\n" "255B SF280000\n" "255C SF270000\n" "255D SF260000\n" "255E SF360000\n" "255F SF370000\n" "2560 SF420000\n" "2561 SF190000\n" "2562 SF200000\n" "2563 SF230000\n" "2564 SF470000\n" "2565 SF480000\n" "2566 SF410000\n" "2567 SF450000\n" "2568 SF460000\n" "2569 SF400000\n" "256A SF540000\n" "256B SF530000\n" "256C SF440000\n" "2580 upblock\n" "2584 dnblock\n" "2588 block\n" "258C lfblock\n" "2590 rtblock\n" "2591 ltshade\n" "2592 shade\n" "2593 dkshade\n" "25A0 filledbox\n" "25A1 H22073\n" "25AA H18543\n" "25AB H18551\n" "25AC filledrect\n" "25B2 triagup\n" "25BA triagrt\n" "25BC triagdn\n" "25C4 triaglf\n" "25CA lozenge\n" "25CB circle\n" "25CF H18533\n" "25D8 invbullet\n" "25D9 invcircle\n" "25E6 openbullet\n" "263A smileface\n" "263B invsmileface\n" "263C sun\n" "2640 female\n" "2642 male\n" "2660 spade\n" "2663 club\n" "2665 heart\n" "2666 diamond\n" "266A musicalnote\n" "266B musicalnotedbl\n" "F6BE dotlessj\n" "F6BF LL\n" "F6C0 ll\n" "F6C1 Scedilla\n" "F6C2 scedilla\n" "F6C3 commaaccent\n" "F6C4 afii10063\n" "F6C5 afii10064\n" "F6C6 afii10192\n" "F6C7 afii10831\n" "F6C8 afii10832\n" "F6C9 Acute\n" "F6CA Caron\n" "F6CB Dieresis\n" "F6CC DieresisAcute\n" "F6CD DieresisGrave\n" "F6CE Grave\n" "F6CF Hungarumlaut\n" "F6D0 Macron\n" "F6D1 cyrBreve\n" "F6D2 cyrFlex\n" "F6D3 dblGrave\n" "F6D4 cyrbreve\n" "F6D5 cyrflex\n" "F6D6 dblgrave\n" "F6D7 dieresisacute\n" "F6D8 dieresisgrave\n" "F6D9 copyrightserif\n" "F6DA registerserif\n" "F6DB trademarkserif\n" "F6DC onefitted\n" "F6DD rupiah\n" "F6DE threequartersemdash\n" "F6DF centinferior\n" "F6E0 centsuperior\n" "F6E1 commainferior\n" "F6E2 commasuperior\n" "F6E3 dollarinferior\n" "F6E4 dollarsuperior\n" "F6E5 hypheninferior\n" "F6E6 hyphensuperior\n" "F6E7 periodinferior\n" "F6E8 periodsuperior\n" "F6E9 asuperior\n" "F6EA bsuperior\n" "F6EB dsuperior\n" "F6EC esuperior\n" "F6ED isuperior\n" "F6EE lsuperior\n" "F6EF msuperior\n" "F6F0 osuperior\n" "F6F1 rsuperior\n" "F6F2 ssuperior\n" "F6F3 tsuperior\n" "F6F4 Brevesmall\n" "F6F5 Caronsmall\n" "F6F6 Circumflexsmall\n" "F6F7 Dotaccentsmall\n" "F6F8 Hungarumlautsmall\n" "F6F9 Lslashsmall\n" "F6FA OEsmall\n" "F6FB Ogoneksmall\n" "F6FC Ringsmall\n" "F6FD Scaronsmall\n" "F6FE Tildesmall\n" "F6FF Zcaronsmall\n" "F721 exclamsmall\n" "F724 dollaroldstyle\n" "F726 ampersandsmall\n" "F730 zerooldstyle\n" "F731 oneoldstyle\n" "F732 twooldstyle\n" "F733 threeoldstyle\n" "F734 fouroldstyle\n" "F735 fiveoldstyle\n" "F736 sixoldstyle\n" "F737 sevenoldstyle\n" "F738 eightoldstyle\n" "F739 nineoldstyle\n" "F73F questionsmall\n" "F760 Gravesmall\n" "F761 Asmall\n" "F762 Bsmall\n" "F763 Csmall\n" "F764 Dsmall\n" "F765 Esmall\n" "F766 Fsmall\n" "F767 Gsmall\n" "F768 Hsmall\n" "F769 Ismall\n" "F76A Jsmall\n" "F76B Ksmall\n" "F76C Lsmall\n" "F76D Msmall\n" "F76E Nsmall\n" "F76F Osmall\n" "F770 Psmall\n" "F771 Qsmall\n" "F772 Rsmall\n" "F773 Ssmall\n" "F774 Tsmall\n" "F775 Usmall\n" "F776 Vsmall\n" "F777 Wsmall\n" "F778 Xsmall\n" "F779 Ysmall\n" "F77A Zsmall\n" "F7A1 exclamdownsmall\n" "F7A2 centoldstyle\n" "F7A8 Dieresissmall\n" "F7AF Macronsmall\n" "F7B4 Acutesmall\n" "F7B8 Cedillasmall\n" "F7BF questiondownsmall\n" "F7E0 Agravesmall\n" "F7E1 Aacutesmall\n" "F7E2 Acircumflexsmall\n" "F7E3 Atildesmall\n" "F7E4 Adieresissmall\n" "F7E5 Aringsmall\n" "F7E6 AEsmall\n" "F7E7 Ccedillasmall\n" "F7E8 Egravesmall\n" "F7E9 Eacutesmall\n" "F7EA Ecircumflexsmall\n" "F7EB Edieresissmall\n" "F7EC Igravesmall\n" "F7ED Iacutesmall\n" "F7EE Icircumflexsmall\n" "F7EF Idieresissmall\n" "F7F0 Ethsmall\n" "F7F1 Ntildesmall\n" "F7F2 Ogravesmall\n" "F7F3 Oacutesmall\n" "F7F4 Ocircumflexsmall\n" "F7F5 Otildesmall\n" "F7F6 Odieresissmall\n" "F7F8 Oslashsmall\n" "F7F9 Ugravesmall\n" "F7FA Uacutesmall\n" "F7FB Ucircumflexsmall\n" "F7FC Udieresissmall\n" "F7FD Yacutesmall\n" "F7FE Thornsmall\n" "F7FF Ydieresissmall\n" "F8E5 radicalex\n" "F8E6 arrowvertex\n" "F8E7 arrowhorizex\n" "F8E8 registersans\n" "F8E9 copyrightsans\n" "F8EA trademarksans\n" "F8EB parenlefttp\n" "F8EC parenleftex\n" "F8ED parenleftbt\n" "F8EE bracketlefttp\n" "F8EF bracketleftex\n" "F8F0 bracketleftbt\n" "F8F1 bracelefttp\n" "F8F2 braceleftmid\n" "F8F3 braceleftbt\n" "F8F4 braceex\n" "F8F5 integralex\n" "F8F6 parenrighttp\n" "F8F7 parenrightex\n" "F8F8 parenrightbt\n" "F8F9 bracketrighttp\n" "F8FA bracketrightex\n" "F8FB bracketrightbt\n" "F8FC bracerighttp\n" "F8FD bracerightmid\n" "F8FE bracerightbt\n" "FB00 ff\n" "FB01 fi\n" "FB02 fl\n" "FB03 ffi\n" "FB04 ffl\n" "FB1F afii57705\n" "FB2A afii57694\n" "FB2B afii57695\n" "FB35 afii57723\n" "FB4B afii57700\n" "}\n" "set ps_preamable \"%%BeginProlog\\n\"\n" "append ps_preamable [CreatePostscriptEncoding [encoding system]]\n" "append ps_preamable {\n" "50 dict begin\n" "% This is a standard prolog for Postscript generated by Tk's canvas\n" "% widget.\n" "% RCS: @(#) $Id: mkpsenc.tcl,v 1.3 2002/07/19 14:37:21 drh Exp $\n" "% The definitions below just define all of the variables used in\n" "% any of the procedures here. This is needed for obscure reasons\n" "% explained on p. 716 of the Postscript manual (Section H.2.7,\n" "% \"Initializing Variables,\" in the section on Encapsulated Postscript).\n" "/baseline 0 def\n" "/stipimage 0 def\n" "/height 0 def\n" "/justify 0 def\n" "/lineLength 0 def\n" "/spacing 0 def\n" "/stipple 0 def\n" "/strings 0 def\n" "/xoffset 0 def\n" "/yoffset 0 def\n" "/tmpstip null def\n" "/cstringshow {\n" "{\n" "dup type /stringtype eq\n" "{ show } { glyphshow }\n" "ifelse\n" "}\n" "forall\n" "} bind def\n" "/cstringwidth {\n" "0 exch 0 exch\n" "{\n" "dup type /stringtype eq\n" "{ stringwidth } { \n" "currentfont /Encoding get exch 1 exch put (\\001) stringwidth \n" "}\n" "ifelse \n" "exch 3 1 roll add 3 1 roll add exch\n" "}\n" "forall\n" "} bind def\n" "% font ISOEncode font\n" "% This procedure changes the encoding of a font from the default\n" "% Postscript encoding to current system encoding. It's typically invoked just\n" "% before invoking \"setfont\". The body of this procedure comes from\n" "% Section 5.6.1 of the Postscript book.\n" "/ISOEncode {\n" "dup length dict begin\n" "{1 index /FID ne {def} {pop pop} ifelse} forall\n" "/Encoding CurrentEncoding def\n" "currentdict\n" "end\n" "% I'm not sure why it's necessary to use \"definefont\" on this new\n" "% font, but it seems to be important; just use the name \"Temporary\"\n" "% for the font.\n" "/Temporary exch definefont\n" "} bind def\n" "% StrokeClip\n" "%\n" "% This procedure converts the current path into a clip area under\n" "% the assumption of stroking. It's a bit tricky because some Postscript\n" "% interpreters get errors during strokepath for dashed lines. If\n" "% this happens then turn off dashes and try again.\n" "/StrokeClip {\n" "{strokepath} stopped {\n" "(This Postscript printer gets limitcheck overflows when) =\n" "(stippling dashed lines; lines will be printed solid instead.) =\n" "[] 0 setdash strokepath} if\n" "clip\n" "} bind def\n" "% desiredSize EvenPixels closestSize\n" "%\n" "% The procedure below is used for stippling. Given the optimal size\n" "% of a dot in a stipple pattern in the current user coordinate system,\n" "% compute the closest size that is an exact multiple of the device's\n" "% pixel size. This allows stipple patterns to be displayed without\n" "% aliasing effects.\n" "/EvenPixels {\n" "% Compute exact number of device pixels per stipple dot.\n" "dup 0 matrix currentmatrix dtransform\n" "dup mul exch dup mul add sqrt\n" "% Round to an integer, make sure the number is at least 1, and compute\n" "% user coord distance corresponding to this.\n" "dup round dup 1 lt {pop 1} if\n" "exch div mul\n" "} bind def\n" "% width height string StippleFill --\n" "%\n" "% Given a path already set up and a clipping region generated from\n" "% it, this procedure will fill the clipping region with a stipple\n" "% pattern. \"String\" contains a proper image description of the\n" "% stipple pattern and \"width\" and \"height\" give its dimensions. Each\n" "% stipple dot is assumed to be about one unit across in the current\n" "% user coordinate system. This procedure trashes the graphics state.\n" "/StippleFill {\n" "% The following code is needed to work around a NeWSprint bug.\n" "/tmpstip 1 index def\n" "% Change the scaling so that one user unit in user coordinates\n" "% corresponds to the size of one stipple dot.\n" "1 EvenPixels dup scale\n" "% Compute the bounding box occupied by the path (which is now\n" "% the clipping region), and round the lower coordinates down\n" "% to the nearest starting point for the stipple pattern. Be\n" "% careful about negative numbers, since the rounding works\n" "% differently on them.\n" "pathbbox\n" "4 2 roll\n" "5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n" "6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n" "% Stack now: width height string y1 y2 x1 x2\n" "% Below is a doubly-nested for loop to iterate across this area\n" "% in units of the stipple pattern size, going up columns then\n" "% across rows, blasting out a stipple-pattern-sized rectangle at\n" "% each position\n" "6 index exch {\n" "2 index 5 index 3 index {\n" "% Stack now: width height string y1 y2 x y\n" "gsave\n" "1 index exch translate\n" "5 index 5 index true matrix tmpstip imagemask\n" "grestore\n" "} for\n" "pop\n" "} for\n" "pop pop pop pop pop\n" "} bind def\n" "% -- AdjustColor --\n" "% Given a color value already set for output by the caller, adjusts\n" "% that value to a grayscale or mono value if requested by the CL\n" "% variable.\n" "/AdjustColor {\n" "CL 2 lt {\n" "currentgray\n" "CL 0 eq {\n" ".5 lt {0} {1} ifelse\n" "} if\n" "setgray\n" "} if\n" "} bind def\n" "% x y strings spacing xoffset yoffset justify stipple DrawText --\n" "% This procedure does all of the real work of drawing text. The\n" "% color and font must already have been set by the caller, and the\n" "% following arguments must be on the stack:\n" "%\n" "% x, y -\011Coordinates at which to draw text.\n" "% strings -\011An array of strings, one for each line of the text item,\n" "%\011\011in order from top to bottom.\n" "% spacing -\011Spacing between lines.\n" "% xoffset -\011Horizontal offset for text bbox relative to x and y: 0 for\n" "%\011\011nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n" "% yoffset -\011Vertical offset for text bbox relative to x and y: 0 for\n" "%\011\011nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n" "% justify -\0110 for left justification, 0.5 for center, 1 for right justify.\n" "% stipple -\011Boolean value indicating whether or not text is to be\n" "%\011\011drawn in stippled fashion. If text is stippled,\n" "%\011\011procedure StippleText must have been defined to call\n" "%\011\011StippleFill in the right way.\n" "%\n" "% Also, when this procedure is invoked, the color and font must already\n" "% have been set for the text.\n" "/DrawText {\n" "/stipple exch def\n" "/justify exch def\n" "/yoffset exch def\n" "/xoffset exch def\n" "/spacing exch def\n" "/strings exch def\n" "% First scan through all of the text to find the widest line.\n" "/lineLength 0 def\n" "strings {\n" "cstringwidth pop\n" "dup lineLength gt {/lineLength exch def} {pop} ifelse\n" "newpath\n" "} forall\n" "% Compute the baseline offset and the actual font height.\n" "0 0 moveto (TXygqPZ) false charpath\n" "pathbbox dup /baseline exch def\n" "exch pop exch sub /height exch def pop\n" "newpath\n" "% Translate coordinates first so that the origin is at the upper-left\n" "% corner of the text's bounding box. Remember that x and y for\n" "% positioning are still on the stack.\n" "translate\n" "lineLength xoffset mul\n" "strings length 1 sub spacing mul height add yoffset mul translate\n" "% Now use the baseline and justification information to translate so\n" "% that the origin is at the baseline and positioning point for the\n" "% first line of text.\n" "justify lineLength mul baseline neg translate\n" "% Iterate over each of the lines to output it. For each line,\n" "% compute its width again so it can be properly justified, then\n" "% display it.\n" "strings {\n" "dup cstringwidth pop\n" "justify neg mul 0 moveto\n" "stipple {\n" "% The text is stippled, so turn it into a path and print\n" "% by calling StippledText, which in turn calls StippleFill.\n" "% Unfortunately, many Postscript interpreters will get\n" "% overflow errors if we try to do the whole string at\n" "% once, so do it a character at a time.\n" "gsave\n" "/char (X) def\n" "{\n" "dup type /stringtype eq {\n" "% This segment is a string.\n" "{\n" "char 0 3 -1 roll put\n" "currentpoint\n" "gsave\n" "char true charpath clip StippleText\n" "grestore\n" "char stringwidth translate\n" "moveto\n" "} forall\n" "} {\n" "% This segment is glyph name\n" "% Temporary override\n" "currentfont /Encoding get exch 1 exch put\n" "currentpoint\n" "gsave (\\001) true charpath clip StippleText\n" "grestore\n" "(\\001) stringwidth translate\n" "moveto\n" "} ifelse\n" "} forall\n" "grestore \n" "} {cstringshow} ifelse\n" "0 spacing neg translate\n" "} forall\n" "} bind def\n" "%%EndProlog\n" "}\n" "}\n" "proc tk::ensure_psenc_is_loaded {} {\n" "}\n" ; static unsigned char Et_zFile21[] = "namespace eval ::tk::dialog {}\n" "image create bitmap ::tk::dialog::b1 -foreground black \\\n" "-data \"#define b1_width 32\\n#define b1_height 32\n" "static unsigned char q1_bits[] = {\n" "0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,\n" "0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,\n" "0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,\n" "0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,\n" "0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,\n" "0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,\n" "0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,\n" "0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,\n" "0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,\n" "0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n" "image create bitmap ::tk::dialog::b2 -foreground white \\\n" "-data \"#define b2_width 32\\n#define b2_height 32\n" "static unsigned char b2_bits[] = {\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,\n" "0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,\n" "0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,\n" "0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,\n" "0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,\n" "0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,\n" "0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,\n" "0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,\n" "0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,\n" "0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n" "image create bitmap ::tk::dialog::q -foreground blue \\\n" "-data \"#define q_width 32\\n#define q_height 32\n" "static unsigned char q_bits[] = {\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,\n" "0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,\n" "0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,\n" "0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,\n" "0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n" "image create bitmap ::tk::dialog::i -foreground blue \\\n" "-data \"#define i_width 32\\n#define i_height 32\n" "static unsigned char i_bits[] = {\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,\n" "0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,\n" "0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,\n" "0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,\n" "0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n" "image create bitmap ::tk::dialog::w1 -foreground black \\\n" "-data \"#define w1_width 32\\n#define w1_height 32\n" "static unsigned char w1_bits[] = {\n" "0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,\n" "0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,\n" "0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,\n" "0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,\n" "0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,\n" "0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,\n" "0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,\n" "0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,\n" "0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,\n" "0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,\n" "0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};\"\n" "image create bitmap ::tk::dialog::w2 -foreground yellow \\\n" "-data \"#define w2_width 32\\n#define w2_height 32\n" "static unsigned char w2_bits[] = {\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,\n" "0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,\n" "0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,\n" "0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,\n" "0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,\n" "0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,\n" "0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,\n" "0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,\n" "0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,\n" "0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n" "image create bitmap ::tk::dialog::w3 -foreground black \\\n" "-data \"#define w3_width 32\\n#define w3_height 32\n" "static unsigned char w3_bits[] = {\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,\n" "0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,\n" "0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,\n" "0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,\n" "0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n" "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n" "proc ::tk::MessageBox {args} {\n" "global tcl_platform tk_strictMotif\n" "variable ::tk::Priv\n" "set w ::tk::PrivMsgBox\n" "upvar $w data\n" "set specs {\n" "{-default \"\" \"\" \"\"}\n" "{-icon \"\" \"\" \"info\"}\n" "{-message \"\" \"\" \"\"}\n" "{-parent \"\" \"\" .}\n" "{-title \"\" \"\" \" \"}\n" "{-type \"\" \"\" \"ok\"}\n" "}\n" "tclParseConfigSpec $w $specs \"\" $args\n" "if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {\n" "error \"bad -icon value \\\"$data(-icon)\\\": must be error, info, question, or warning\"\n" "}\n" "set windowingsystem [tk windowingsystem]\n" "if {$windowingsystem eq \"classic\" || $windowingsystem eq \"aqua\"} {\n" "switch -- $data(-icon) {\n" "\"error\" {set data(-icon) \"stop\"}\n" "\"warning\" {set data(-icon) \"caution\"}\n" "\"info\" {set data(-icon) \"note\"}\n" "}\n" "}\n" "if {![winfo exists $data(-parent)]} {\n" "error \"bad window path name \\\"$data(-parent)\\\"\"\n" "}\n" "switch -- $data(-type) {\n" "abortretryignore { \n" "set names [list abort retry ignore]\n" "set labels [list &Abort &Retry &Ignore]\n" "}\n" "ok {\n" "set names [list ok]\n" "set labels {&OK}\n" "}\n" "okcancel {\n" "set names [list ok cancel]\n" "set labels [list &OK &Cancel]\n" "}\n" "retrycancel {\n" "set names [list retry cancel]\n" "set labels [list &Retry &Cancel]\n" "}\n" "yesno {\n" "set names [list yes no]\n" "set labels [list &Yes &No]\n" "}\n" "yesnocancel {\n" "set names [list yes no cancel]\n" "set labels [list &Yes &No &Cancel]\n" "}\n" "default {\n" "error \"bad -type value \\\"$data(-type)\\\": must be\\\n" "\011\011 abortretryignore, ok, okcancel, retrycancel,\\\n" "\011\011 yesno, or yesnocancel\"\n" "}\n" "}\n" "set buttons {}\n" "foreach name $names lab $labels {\n" "lappend buttons [list $name -text [mc $lab]]\n" "}\n" "if {$data(-default) eq \"\"} {\n" "set data(-default) [lindex [lindex $buttons 0] 0]\n" "}\n" "set valid 0\n" "foreach btn $buttons {\n" "if {[lindex $btn 0] eq $data(-default)} {\n" "set valid 1\n" "break\n" "}\n" "}\n" "if {!$valid} {\n" "error \"invalid default button \\\"$data(-default)\\\"\"\n" "}\n" "if {$data(-parent) ne \".\"} {\n" "set w $data(-parent).__tk__messagebox\n" "} else {\n" "set w .__tk__messagebox\n" "}\n" "destroy $w\n" "toplevel $w -class Dialog\n" "wm title $w $data(-title)\n" "wm iconname $w Dialog\n" "wm protocol $w WM_DELETE_WINDOW { }\n" "set bg [$w cget -background]\n" "if {[winfo viewable [winfo toplevel $data(-parent)]] } {\n" "wm transient $w $data(-parent)\n" "} \n" "if {$windowingsystem eq \"classic\" || $windowingsystem eq \"aqua\"} {\n" "unsupported::MacWindowStyle style $w dBoxProc\n" "}\n" "frame $w.bot -background $bg\n" "pack $w.bot -side bottom -fill both\n" "frame $w.top -background $bg\n" "pack $w.top -side top -fill both -expand 1\n" "if {$windowingsystem ne \"classic\" && $windowingsystem ne \"aqua\"} {\n" "$w.bot configure -relief raised -bd 1\n" "$w.top configure -relief raised -bd 1\n" "}\n" "option add *Dialog.msg.wrapLength 3i widgetDefault\n" "if {$windowingsystem eq \"classic\" || $windowingsystem eq \"aqua\"} {\n" "option add *Dialog.msg.font system widgetDefault\n" "} else {\n" "option add *Dialog.msg.font {Times 14} widgetDefault\n" "}\n" "label $w.msg -anchor nw -justify left -text $data(-message) \\\n" "\011 -background $bg\n" "if {$data(-icon) ne \"\"} {\n" "if {($windowingsystem eq \"classic\" || $windowingsystem eq \"aqua\")\n" "|| ([winfo depth $w] < 4) || $tk_strictMotif} {\n" "label $w.bitmap -bitmap $data(-icon) -background $bg\n" "} else {\n" "canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \\\n" "\011\011 -background $bg\n" "switch $data(-icon) {\n" "error {\n" "$w.bitmap create oval 0 0 31 31 -fill red -outline black\n" "$w.bitmap create line 9 9 23 23 -fill white -width 4\n" "$w.bitmap create line 9 23 23 9 -fill white -width 4\n" "}\n" "info {\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::b1\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::b2\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::i\n" "}\n" "question {\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::b1\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::b2\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::q\n" "}\n" "default {\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::w1\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::w2\n" "$w.bitmap create image 0 0 -anchor nw \\\n" "\011\011\011 -image ::tk::dialog::w3\n" "}\n" "}\n" "}\n" "}\n" "grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m\n" "grid columnconfigure $w.top 1 -weight 1\n" "grid rowconfigure $w.top 0 -weight 1\n" "set i 0\n" "foreach but $buttons {\n" "set name [lindex $but 0]\n" "set opts [lrange $but 1 end]\n" "if {![llength $opts]} {\n" "set capName [string toupper $name 0]\n" "set opts [list -text $capName]\n" "}\n" "eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \\\n" "\011\011[list -command [list set tk::Priv(button) $name]]\n" "if {$name eq $data(-default)} {\n" "$w.$name configure -default active\n" "} else {\n" "$w.$name configure -default normal\n" "}\n" "grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew\n" "grid columnconfigure $w.bot $i -uniform buttons\n" "incr i\n" "}\n" "bind $w [list ::tk::AltKeyInDialog $w %A]\n" "if {$data(-default) ne \"\"} {\n" "bind $w {\n" "if {\"Button\" eq [winfo class %W]} {\n" "%W configure -default active\n" "}\n" "}\n" "bind $w {\n" "if {\"Button\" eq [winfo class %W]} {\n" "%W configure -default normal\n" "}\n" "}\n" "}\n" "bind $w {\n" "if {\"Button\" eq [winfo class %W]} {\n" "tk::ButtonInvoke %W\n" "}\n" "}\n" "::tk::PlaceWindow $w widget $data(-parent)\n" "if {$data(-default) ne \"\"} {\n" "set focus $w.$data(-default)\n" "} else {\n" "set focus $w\n" "}\n" "::tk::SetFocusGrab $w $focus\n" "vwait ::tk::Priv(button)\n" "::tk::RestoreFocusGrab $w $focus\n" "return $Priv(button)\n" "}\n" ; static unsigned char Et_zFile22[] = "proc tk_menuBar args {}\n" "proc tk_bindForTraversal args {}\n" ; static unsigned char Et_zFile23[] = "proc ::tk_optionMenu {w varName firstValue args} {\n" "upvar #0 $varName var\n" "if {![info exists var]} {\n" "set var $firstValue\n" "}\n" "menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \\\n" "\011 -relief raised -bd 2 -highlightthickness 2 -anchor c \\\n" "\011 -direction flush\n" "menu $w.menu -tearoff 0\n" "$w.menu add radiobutton -label $firstValue -variable $varName\n" "foreach i $args {\n" "$w.menu add radiobutton -label $i -variable $varName\n" "}\n" "return $w.menu\n" "}\n" ; static unsigned char Et_zFile24[] = "proc ::tk_setPalette {args} {\n" "if {[winfo depth .] == 1} {\n" "return\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" "set bg [winfo rgb . $new(background)]\n" "if {![info exists new(foreground)]} {\n" "foreach {r g b} $bg {break}\n" "if {$r+1.5*$g+0.5*$b > 100000} {\n" "set new(foreground) black\n" "} else {\n" "set new(foreground) white\n" "}\n" "}\n" "foreach {fg_r fg_g fg_b} [winfo rgb . $new(foreground)] {break}\n" "foreach {bg_r bg_g bg_b} $bg {break}\n" "set darkerBg [format #%02x%02x%02x [expr {(9*$bg_r)/2560}] \\\n" "\011 [expr {(9*$bg_g)/2560}] [expr {(9*$bg_b)/2560}]]\n" "foreach i {activeForeground insertBackground selectForeground \\\n" "\011 highlightColor} {\n" "if {![info exists new($i)]} {\n" "set new($i) $new(foreground)\n" "}\n" "}\n" "if {![info exists new(disabledForeground)]} {\n" "set new(disabledForeground) [format #%02x%02x%02x \\\n" "\011\011[expr {(3*$bg_r + $fg_r)/1024}] \\\n" "\011\011[expr {(3*$bg_g + $fg_g)/1024}] \\\n" "\011\011[expr {(3*$bg_b + $fg_b)/1024}]]\n" "}\n" "if {![info exists new(highlightBackground)]} {\n" "set new(highlightBackground) $new(background)\n" "}\n" "if {![info exists new(activeBackground)]} {\n" "foreach i {0 1 2} color \"$bg_r $bg_g $bg_b\" {\n" "set light($i) [expr {$color/256}]\n" "set inc1 [expr {($light($i)*15)/100}]\n" "set inc2 [expr {(255-$light($i))/3}]\n" "if {$inc1 > $inc2} {\n" "incr light($i) $inc1\n" "} else {\n" "incr light($i) $inc2\n" "}\n" "if {$light($i) > 255} {\n" "set light($i) 255\n" "}\n" "}\n" "set new(activeBackground) [format #%02x%02x%02x $light(0) \\\n" "\011\011$light(1) $light(2)]\n" "}\n" "if {![info exists new(selectBackground)]} {\n" "set new(selectBackground) $darkerBg\n" "}\n" "if {![info exists new(troughColor)]} {\n" "set new(troughColor) $darkerBg\n" "}\n" "if {![info exists new(selectColor)]} {\n" "set new(selectColor) #b03060\n" "}\n" "toplevel .___tk_set_palette\n" "wm withdraw .___tk_set_palette\n" "foreach q {\n" "button canvas checkbutton entry frame label labelframe\n" "listbox menubutton menu message radiobutton scale scrollbar\n" "spinbox text\n" "} {\n" "$q .___tk_set_palette.$q\n" "}\n" "eval [tk::RecolorTree . new]\n" "destroy .___tk_set_palette\n" "foreach option [array names new] {\n" "option add *$option $new($option) widgetDefault\n" "}\n" "array set ::tk::Palette [array get new]\n" "}\n" "proc ::tk::RecolorTree {w colors} {\n" "upvar $colors c\n" "set result {}\n" "set prototype .___tk_set_palette.[string tolower [winfo class $w]]\n" "if {![winfo exists $prototype]} {\n" "unset prototype\n" "}\n" "foreach dbOption [array names c] {\n" "set option -[string tolower $dbOption]\n" "set class [string replace $dbOption 0 0 [string toupper \\\n" "\011\011[string index $dbOption 0]]]\n" "if {![catch {$w configure $option} value]} {\n" "set defaultcolor [option get $w $dbOption $class]\n" "if {[string match {} $defaultcolor] || \\\n" "\011\011 ([info exists prototype] && \\\n" "\011\011 [$prototype cget $option] ne \"$defaultcolor\")} {\n" "set defaultcolor [winfo rgb . [lindex $value 3]]\n" "} else {\n" "set defaultcolor [winfo rgb . $defaultcolor]\n" "}\n" "set chosencolor [winfo rgb . [lindex $value 4]]\n" "if {[string match $defaultcolor $chosencolor]} {\n" "append result \";\\noption add [list \\\n" "\011\011 *[winfo class $w].$dbOption $c($dbOption) 60]\"\n" "$w configure $option $c($dbOption)\n" "}\n" "}\n" "}\n" "foreach child [winfo children $w] {\n" "append result \";\\n[::tk::RecolorTree $child c]\"\n" "}\n" "return $result\n" "}\n" "proc ::tk::Darken {color percent} {\n" "foreach {red green blue} [winfo rgb . $color] {\n" "set red [expr {($red/256)*$percent/100}]\n" "set green [expr {($green/256)*$percent/100}]\n" "set blue [expr {($blue/256)*$percent/100}]\n" "break\n" "}\n" "if {$red > 255} {\n" "set red 255\n" "}\n" "if {$green > 255} {\n" "set green 255\n" "}\n" "if {$blue > 255} {\n" "set blue 255\n" "}\n" "return [format \"#%02x%02x%02x\" $red $green $blue]\n" "}\n" "proc ::tk_bisque {} {\n" "tk_setPalette activeBackground #e6ceb1 activeForeground black \\\n" "\011 background #ffe4c4 disabledForeground #b0b0b0 foreground black \\\n" "\011 highlightBackground #ffe4c4 highlightColor black \\\n" "\011 insertBackground black selectColor #b03060 \\\n" "\011 selectBackground #e6ceb1 selectForeground black \\\n" "\011 troughColor #cdb79e\n" "}\n" ; static unsigned char Et_zFile25[] = "bind Panedwindow { ::tk::panedwindow::MarkSash %W %x %y 1 }\n" "bind Panedwindow { ::tk::panedwindow::MarkSash %W %x %y 0 }\n" "bind Panedwindow { ::tk::panedwindow::DragSash %W %x %y 1 }\n" "bind Panedwindow { ::tk::panedwindow::DragSash %W %x %y 0 }\n" "bind Panedwindow {::tk::panedwindow::ReleaseSash %W 1}\n" "bind Panedwindow {::tk::panedwindow::ReleaseSash %W 0}\n" "bind Panedwindow { ::tk::panedwindow::Motion %W %x %y }\n" "bind Panedwindow { ::tk::panedwindow::Leave %W }\n" "namespace eval ::tk::panedwindow {}\n" "proc ::tk::panedwindow::MarkSash {w x y proxy} {\n" "if {[$w cget -opaqueresize]} { set proxy 0 }\n" "set what [$w identify $x $y]\n" "if { [llength $what] == 2 } {\n" "foreach {index which} $what break\n" "if { !$::tk_strictMotif || $which eq \"handle\" } {\n" "if {!$proxy} { $w sash mark $index $x $y }\n" "set ::tk::Priv(sash) $index\n" "foreach {sx sy} [$w sash coord $index] break\n" "set ::tk::Priv(dx) [expr {$sx-$x}]\n" "set ::tk::Priv(dy) [expr {$sy-$y}]\n" "DragSash $w $x $y $proxy\n" "}\n" "}\n" "}\n" "proc ::tk::panedwindow::DragSash {w x y proxy} {\n" "if {[$w cget -opaqueresize]} { set proxy 0 }\n" "if { [info exists ::tk::Priv(sash)] } {\n" "if {$proxy} {\n" "$w proxy place \\\n" "\011\011 [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]\n" "} else {\n" "$w sash place $::tk::Priv(sash) \\\n" "\011\011 [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}]\n" "}\n" "}\n" "}\n" "proc ::tk::panedwindow::ReleaseSash {w proxy} {\n" "if {[$w cget -opaqueresize]} { set proxy 0 }\n" "if { [info exists ::tk::Priv(sash)] } {\n" "if {$proxy} {\n" "foreach {x y} [$w proxy coord] break\n" "$w sash place $::tk::Priv(sash) $x $y\n" "$w proxy forget\n" "}\n" "unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy)\n" "}\n" "}\n" "proc ::tk::panedwindow::Motion {w x y} {\n" "variable ::tk::Priv\n" "set id [$w identify $x $y]\n" "if {([llength $id] == 2) && \\\n" "\011 (!$::tk_strictMotif || [lindex $id 1] eq \"handle\")} {\n" "if { ![info exists Priv($w,panecursor)] } {\n" "set Priv($w,panecursor) [$w cget -cursor]\n" "if { [$w cget -sashcursor] eq \"\" } {\n" "if { [$w cget -orient] eq \"horizontal\" } {\n" "$w configure -cursor sb_h_double_arrow\n" "} else {\n" "$w configure -cursor sb_v_double_arrow\n" "}\n" "} else {\n" "$w configure -cursor [$w cget -sashcursor]\n" "}\n" "if {[info exists Priv($w,pwAfterId)]} {\n" "after cancel $Priv($w,pwAfterId)\n" "}\n" "set Priv($w,pwAfterId) [after 150 \\\n" "\011\011 [list ::tk::panedwindow::Cursor $w]]\n" "}\n" "return\n" "}\n" "if { [info exists Priv($w,panecursor)] } {\n" "$w configure -cursor $Priv($w,panecursor)\n" "unset Priv($w,panecursor)\n" "}\n" "}\n" "proc ::tk::panedwindow::Cursor {w} {\n" "variable ::tk::Priv\n" "if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {\n" "if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {\n" "set Priv($w,pwAfterId) [after 150 \\\n" "\011\011 [list ::tk::panedwindow::Cursor $w]]\n" "} else {\n" "$w configure -cursor $Priv($w,panecursor)\n" "unset Priv($w,panecursor)\n" "if {[info exists Priv($w,pwAfterId)]} {\n" "after cancel $Priv($w,pwAfterId)\n" "unset Priv($w,pwAfterId)\n" "}\n" "}\n" "}\n" "}\n" "proc ::tk::panedwindow::Leave {w} {\n" "if {[info exists ::tk::Priv($w,panecursor)]} {\n" "$w configure -cursor $::tk::Priv($w,panecursor)\n" "unset ::tk::Priv($w,panecursor)\n" "}\n" "}\n" ; static unsigned char Et_zFile26[] = "if {[package vcompare [package provide Tcl]\0118.4] != 0} { return }\n" "package ifneeded Tk 8.4\011[list load [file join $dir .. libtk8.4.so] Tk]\n" ; static unsigned char Et_zFile27[] = "package require opt 0.4.1;\n" "namespace eval ::safe {\n" "variable tkSafeId 0;\n" "proc ::safe::tkInterpInit {slave argv} {\n" "global env tk_library\n" "set tk_library [file join $tk_library]\n" "allowTk $slave $argv\n" "::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]\n" "return $slave\n" "}\n" "proc ::safe::loadTk {} {}\n" "::tcl::OptProc loadTk {\n" "{slave -interp \"name of the slave interpreter\"}\n" "{-use -windowId {} \"window Id to use (new toplevel otherwise)\"}\n" "{-display -displayName {} \"display name to use (current one otherwise)\"}\n" "} {\n" "set displayGiven [::tcl::OptProcArgGiven \"-display\"]\n" "if {!$displayGiven} {\n" "if {[catch {set display [winfo screen .]}]} {\n" "if {[info exists ::env(DISPLAY)]} {\n" "set display $::env(DISPLAY)\n" "} else {\n" "Log $slave \"no winfo screen . nor env(DISPLAY)\" WARNING\n" "set display \":0.0\"\n" "}\n" "}\n" "}\n" "if {![::tcl::OptProcArgGiven \"-use\"]} {\n" "::tcl::Lassign [tkTopLevel $slave $display] w use\n" "Set [DeleteHookName $slave] [list tkDelete {} $w]\n" "} else {\n" "Set [DeleteHookName $slave] [list disallowTk]\n" "if {[string match \".*\" $use]} {\n" "set windowName $use\n" "set use [winfo id $windowName]\n" "set nDisplay [winfo screen $windowName]\n" "} else {\n" "if {![catch {winfo pathname $use} name]} {\n" "set nDisplay [winfo screen $name]\n" "} else {\n" "set nDisplay $display\n" "}\n" "}\n" "if {$nDisplay ne $display} {\n" "if {$displayGiven} {\n" "error \"conflicting -display $display and -use\\\n" "\011\011\011$use -> $nDisplay\"\n" "} else {\n" "set display $nDisplay\n" "}\n" "}\n" "}\n" "tkInterpInit $slave [list \"-use\" $use \"-display\" $display]\n" "load {} Tk $slave\n" "return $slave\n" "}\n" "proc ::safe::TkInit {interpPath} {\n" "variable tkInit\n" "if {[info exists tkInit($interpPath)]} {\n" "set value $tkInit($interpPath)\n" "Log $interpPath \"TkInit called, returning \\\"$value\\\"\" NOTICE\n" "return $value\n" "} else {\n" "Log $interpPath \"TkInit called for interp with clearance:\\\n" "\011\011preventing Tk init\" ERROR\n" "error \"not allowed\"\n" "}\n" "}\n" "proc ::safe::allowTk {interpPath argv} {\n" "variable tkInit\n" "set tkInit($interpPath) $argv\n" "return\n" "}\n" "proc ::safe::disallowTk {interpPath} {\n" "variable tkInit\n" "if {[info exists tkInit($interpPath)]} {\n" "unset tkInit($interpPath)\n" "}\n" "return\n" "}\n" "proc ::safe::tkDelete {W window slave} {\n" "Log $slave \"Called tkDelete $W $window\" NOTICE\n" "if {[::interp exists $slave]} {\n" "if {[catch {::safe::interpDelete $slave} msg]} {\n" "Log $slave \"Deletion error : $msg\"\n" "}\n" "}\n" "if {[winfo exists $window]} {\n" "Log $slave \"Destroy toplevel $window\" NOTICE\n" "destroy $window\n" "}\n" "disallowTk $slave\n" "return\n" "}\n" "proc ::safe::tkTopLevel {slave display} {\n" "variable tkSafeId\n" "incr tkSafeId\n" "set w \".safe$tkSafeId\"\n" "if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {\n" "return -code error \"Unable to create toplevel for\\\n" "\011\011safe slave \\\"$slave\\\" ($msg)\"\n" "}\n" "Log $slave \"New toplevel $w\" NOTICE\n" "set msg \"Untrusted Tcl applet ($slave)\"\n" "wm title $w $msg\n" "set wc $w.fc\n" "frame $wc -bg red -borderwidth 3 -relief ridge\n" "bindtags $wc [concat Safe$wc [bindtags $wc]]\n" "bind Safe$wc [list ::safe::tkDelete %W $w $slave]\n" "label $wc.l -text $msg -padx 2 -pady 0 -anchor w\n" "frame $wc.fb -bd 0\n" "button $wc.fb.b -text \"Delete\" \\\n" "\011 -bd 1 -padx 2 -pady 0 -highlightthickness 0 \\\n" "\011 -command [list ::safe::tkDelete $w $w $slave]\n" "pack $wc.fb.b -side right -fill both\n" "pack $wc.fb -side right -fill both -expand 1\n" "pack $wc.l -side left -fill both -expand 1\n" "pack $wc -side bottom -fill x\n" "frame $w.c -container 1\n" "pack $w.c -fill both -expand 1\n" "list $w [winfo id $w.c]\n" "}\n" "}\n" ; static unsigned char Et_zFile28[] = "bind Scale {\n" "if {$tk_strictMotif} {\n" "set tk::Priv(activeBg) [%W cget -activebackground]\n" "%W configure -activebackground [%W cget -background]\n" "}\n" "tk::ScaleActivate %W %x %y\n" "}\n" "bind Scale {\n" "tk::ScaleActivate %W %x %y\n" "}\n" "bind Scale {\n" "if {$tk_strictMotif} {\n" "%W configure -activebackground $tk::Priv(activeBg)\n" "}\n" "if {[%W cget -state] eq \"active\"} {\n" "%W configure -state normal\n" "}\n" "}\n" "bind Scale <1> {\n" "tk::ScaleButtonDown %W %x %y\n" "}\n" "bind Scale {\n" "tk::ScaleDrag %W %x %y\n" "}\n" "bind Scale { }\n" "bind Scale { }\n" "bind Scale {\n" "tk::CancelRepeat\n" "tk::ScaleEndDrag %W\n" "tk::ScaleActivate %W %x %y\n" "}\n" "bind Scale <2> {\n" "tk::ScaleButton2Down %W %x %y\n" "}\n" "bind Scale {\n" "tk::ScaleDrag %W %x %y\n" "}\n" "bind Scale { }\n" "bind Scale { }\n" "bind Scale {\n" "tk::CancelRepeat\n" "tk::ScaleEndDrag %W\n" "tk::ScaleActivate %W %x %y\n" "}\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "bind Scale <3>\011\011[bind Scale <2>]\n" "bind Scale \011[bind Scale ]\n" "bind Scale \011[bind Scale ]\n" "bind Scale \011[bind Scale ]\n" "bind Scale [bind Scale ]\n" "}\n" "bind Scale {\n" "tk::ScaleControlPress %W %x %y\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W up little noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W down little noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W up little noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W down little noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W up big noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W down big noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W up big noRepeat\n" "}\n" "bind Scale {\n" "tk::ScaleIncrement %W down big noRepeat\n" "}\n" "bind Scale {\n" "%W set [%W cget -from]\n" "}\n" "bind Scale {\n" "%W set [%W cget -to]\n" "}\n" "proc ::tk::ScaleActivate {w x y} {\n" "if {[$w cget -state] eq \"disabled\"} {\n" "return\n" "}\n" "if {[$w identify $x $y] eq \"slider\"} {\n" "set state active\n" "} else {\n" "set state normal\n" "}\n" "if {[$w cget -state] ne $state} {\n" "$w configure -state $state\n" "}\n" "}\n" "proc ::tk::ScaleButtonDown {w x y} {\n" "variable ::tk::Priv\n" "set Priv(dragging) 0\n" "set el [$w identify $x $y]\n" "set Priv($w,relief) [$w cget -sliderrelief]\n" "if {$el eq \"trough1\"} {\n" "ScaleIncrement $w up little initial\n" "} elseif {$el eq \"trough2\"} {\n" "ScaleIncrement $w down little initial\n" "} elseif {$el eq \"slider\"} {\n" "set Priv(dragging) 1\n" "set Priv(initValue) [$w get]\n" "set coords [$w coords]\n" "set Priv(deltaX) [expr {$x - [lindex $coords 0]}]\n" "set Priv(deltaY) [expr {$y - [lindex $coords 1]}]\n" "switch -exact -- $Priv($w,relief) {\n" "\"raised\" { $w configure -sliderrelief sunken }\n" "\"ridge\" { $w configure -sliderrelief groove }\n" "}\n" "}\n" "}\n" "proc ::tk::ScaleDrag {w x y} {\n" "variable ::tk::Priv\n" "if {!$Priv(dragging)} {\n" "return\n" "}\n" "$w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]\n" "}\n" "proc ::tk::ScaleEndDrag {w} {\n" "variable ::tk::Priv\n" "set Priv(dragging) 0\n" "if {[info exists Priv($w,relief)]} {\n" "$w configure -sliderrelief $Priv($w,relief)\n" "unset Priv($w,relief)\n" "}\n" "}\n" "proc ::tk::ScaleIncrement {w dir big repeat} {\n" "variable ::tk::Priv\n" "if {![winfo exists $w]} return\n" "if {$big eq \"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 eq \"up\")} {\n" "set inc [expr {-$inc}]\n" "}\n" "$w set [expr {[$w get] + $inc}]\n" "if {$repeat eq \"again\"} {\n" "set Priv(afterId) [after [$w cget -repeatinterval] \\\n" "\011\011[list tk::ScaleIncrement $w $dir $big again]]\n" "} elseif {$repeat eq \"initial\"} {\n" "set delay [$w cget -repeatdelay]\n" "if {$delay > 0} {\n" "set Priv(afterId) [after $delay \\\n" "\011\011 [list tk::ScaleIncrement $w $dir $big again]]\n" "}\n" "}\n" "}\n" "proc ::tk::ScaleControlPress {w x y} {\n" "set el [$w identify $x $y]\n" "if {$el eq \"trough1\"} {\n" "$w set [$w cget -from]\n" "} elseif {$el eq \"trough2\"} {\n" "$w set [$w cget -to]\n" "}\n" "}\n" "proc ::tk::ScaleButton2Down {w x y} {\n" "variable ::tk::Priv\n" "if {[$w cget -state] eq \"disabled\"} {\n" "return\n" "}\n" "$w configure -state active\n" "$w set [$w get $x $y]\n" "set Priv(dragging) 1\n" "set Priv(initValue) [$w get]\n" "set Priv($w,relief) [$w cget -sliderrelief]\n" "set coords \"$x $y\"\n" "set Priv(deltaX) 0\n" "set Priv(deltaY) 0\n" "}\n" ; static unsigned char Et_zFile29[] = "if {[tk windowingsystem] eq \"x11\"} {\n" "bind Scrollbar {\n" "if {$tk_strictMotif} {\n" "set tk::Priv(activeBg) [%W cget -activebackground]\n" "%W configure -activebackground [%W cget -background]\n" "}\n" "%W activate [%W identify %x %y]\n" "}\n" "bind Scrollbar {\n" "%W activate [%W identify %x %y]\n" "}\n" "bind Scrollbar {\n" "if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} {\n" "%W configure -activebackground $tk::Priv(activeBg)\n" "}\n" "%W activate {}\n" "}\n" "bind Scrollbar <1> {\n" "tk::ScrollButtonDown %W %x %y\n" "}\n" "bind Scrollbar {\n" "tk::ScrollDrag %W %x %y\n" "}\n" "bind Scrollbar {\n" "tk::ScrollDrag %W %x %y\n" "}\n" "bind Scrollbar {\n" "tk::ScrollButtonUp %W %x %y\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar <2> {\n" "tk::ScrollButton2Down %W %x %y\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "tk::ScrollDrag %W %x %y\n" "}\n" "bind Scrollbar {\n" "tk::ScrollButtonUp %W %x %y\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "}\n" "bind Scrollbar {\n" "tk::ScrollTopBottom %W %x %y\n" "}\n" "bind Scrollbar {\n" "tk::ScrollTopBottom %W %x %y\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W v -1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W v 1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByPages %W v -1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByPages %W v 1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W h -1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W h 1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByPages %W h -1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByPages %W h 1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByPages %W hv -1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByPages %W hv 1\n" "}\n" "bind Scrollbar {\n" "tk::ScrollToPos %W 0\n" "}\n" "bind Scrollbar {\n" "tk::ScrollToPos %W 1\n" "}\n" "}\n" "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W v [expr {- (%D)}]\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W v [expr {-10 * (%D)}]\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W h [expr {- (%D)}]\n" "}\n" "bind Scrollbar {\n" "tk::ScrollByUnits %W h [expr {-10 * (%D)}]\n" "}\n" "}\n" "proc tk::ScrollButtonDown {w x y} {\n" "variable ::tk::Priv\n" "set Priv(relief) [$w cget -activerelief]\n" "$w configure -activerelief sunken\n" "set element [$w identify $x $y]\n" "if {$element eq \"slider\"} {\n" "ScrollStartDrag $w $x $y\n" "} else {\n" "ScrollSelect $w $element initial\n" "}\n" "}\n" "proc ::tk::ScrollButtonUp {w x y} {\n" "variable ::tk::Priv\n" "tk::CancelRepeat\n" "if {[info exists Priv(relief)]} {\n" "$w configure -activerelief $Priv(relief)\n" "ScrollEndDrag $w $x $y\n" "$w activate [$w identify $x $y]\n" "}\n" "}\n" "proc ::tk::ScrollSelect {w element repeat} {\n" "variable ::tk::Priv\n" "if {![winfo exists $w]} return\n" "switch -- $element {\n" "\"arrow1\"\011{ScrollByUnits $w hv -1}\n" "\"trough1\"\011{ScrollByPages $w hv -1}\n" "\"trough2\"\011{ScrollByPages $w hv 1}\n" "\"arrow2\"\011{ScrollByUnits $w hv 1}\n" "default\011\011{return}\n" "}\n" "if {$repeat eq \"again\"} {\n" "set Priv(afterId) [after [$w cget -repeatinterval] \\\n" "\011\011[list tk::ScrollSelect $w $element again]]\n" "} elseif {$repeat eq \"initial\"} {\n" "set delay [$w cget -repeatdelay]\n" "if {$delay > 0} {\n" "set Priv(afterId) [after $delay \\\n" "\011\011 [list tk::ScrollSelect $w $element again]]\n" "}\n" "}\n" "}\n" "proc ::tk::ScrollStartDrag {w x y} {\n" "variable ::tk::Priv\n" "if {[$w cget -command] eq \"\"} {\n" "return\n" "}\n" "set Priv(pressX) $x\n" "set Priv(pressY) $y\n" "set Priv(initValues) [$w get]\n" "set iv0 [lindex $Priv(initValues) 0]\n" "if {[llength $Priv(initValues)] == 2} {\n" "set Priv(initPos) $iv0\n" "} elseif {$iv0 == 0} {\n" "set Priv(initPos) 0.0\n" "} else {\n" "set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \\\n" "\011\011/ [lindex $Priv(initValues) 0]}]\n" "}\n" "}\n" "proc ::tk::ScrollDrag {w x y} {\n" "variable ::tk::Priv\n" "if {$Priv(initPos) eq \"\"} {\n" "return\n" "}\n" "set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]]\n" "if {[$w cget -jump]} {\n" "if {[llength $Priv(initValues)] == 2} {\n" "$w set [expr {[lindex $Priv(initValues) 0] + $delta}] \\\n" "\011\011 [expr {[lindex $Priv(initValues) 1] + $delta}]\n" "} else {\n" "set delta [expr {round($delta * [lindex $Priv(initValues) 0])}]\n" "eval [list $w] set [lreplace $Priv(initValues) 2 3 \\\n" "\011\011 [expr {[lindex $Priv(initValues) 2] + $delta}] \\\n" "\011\011 [expr {[lindex $Priv(initValues) 3] + $delta}]]\n" "}\n" "} else {\n" "ScrollToPos $w [expr {$Priv(initPos) + $delta}]\n" "}\n" "}\n" "proc ::tk::ScrollEndDrag {w x y} {\n" "variable ::tk::Priv\n" "if {$Priv(initPos) eq \"\"} {\n" "return\n" "}\n" "if {[$w cget -jump]} {\n" "set delta [$w delta [expr {$x - $Priv(pressX)}] \\\n" "\011\011[expr {$y - $Priv(pressY)}]]\n" "ScrollToPos $w [expr {$Priv(initPos) + $delta}]\n" "}\n" "set Priv(initPos) \"\"\n" "}\n" "proc ::tk::ScrollByUnits {w orient amount} {\n" "set cmd [$w cget -command]\n" "if {$cmd eq \"\" || ([string first [string index [$w cget -orient] 0] $orient] < 0)} {\n" "return\n" "}\n" "set info [$w get]\n" "if {[llength $info] == 2} {\n" "uplevel #0 $cmd scroll $amount units\n" "} else {\n" "uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]\n" "}\n" "}\n" "proc ::tk::ScrollByPages {w orient amount} {\n" "set cmd [$w cget -command]\n" "if {$cmd eq \"\" || ([string first [string index [$w cget -orient] 0] $orient] < 0)} {\n" "return\n" "}\n" "set info [$w get]\n" "if {[llength $info] == 2} {\n" "uplevel #0 $cmd scroll $amount pages\n" "} else {\n" "uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]\n" "}\n" "}\n" "proc ::tk::ScrollToPos {w pos} {\n" "set cmd [$w cget -command]\n" "if {$cmd eq \"\"} {\n" "return\n" "}\n" "set info [$w get]\n" "if {[llength $info] == 2} {\n" "uplevel #0 $cmd moveto $pos\n" "} else {\n" "uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]\n" "}\n" "}\n" "proc ::tk::ScrollTopBottom {w x y} {\n" "variable ::tk::Priv\n" "set element [$w identify $x $y]\n" "if {[string match *1 $element]} {\n" "ScrollToPos $w 0\n" "} elseif {[string match *2 $element]} {\n" "ScrollToPos $w 1\n" "}\n" "set Priv(relief) [$w cget -activerelief]\n" "}\n" "proc ::tk::ScrollButton2Down {w x y} {\n" "variable ::tk::Priv\n" "set element [$w identify $x $y]\n" "if {[string match {arrow[12]} $element]} {\n" "ScrollButtonDown $w $x $y\n" "return\n" "}\n" "ScrollToPos $w [$w fraction $x $y]\n" "set Priv(relief) [$w cget -activerelief]\n" "update idletasks\n" "$w configure -activerelief sunken\n" "$w activate slider\n" "ScrollStartDrag $w $x $y\n" "}\n" ; static unsigned char Et_zFile30[] = "namespace eval ::tk::spinbox {}\n" "bind Spinbox <> {\n" "if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {\n" "clipboard clear -displayof %W\n" "clipboard append -displayof %W $tk::Priv(data)\n" "%W delete sel.first sel.last\n" "unset tk::Priv(data)\n" "}\n" "}\n" "bind Spinbox <> {\n" "if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {\n" "clipboard clear -displayof %W\n" "clipboard append -displayof %W $tk::Priv(data)\n" "unset tk::Priv(data)\n" "}\n" "}\n" "bind Spinbox <> {\n" "global tcl_platform\n" "catch {\n" "if {[tk windowingsystem] ne \"x11\"} {\n" "catch {\n" "%W delete sel.first sel.last\n" "}\n" "}\n" "%W insert insert [::tk::GetSelection %W CLIPBOARD]\n" "::tk::EntrySeeInsert %W\n" "}\n" "}\n" "bind Spinbox <> {\n" "%W delete sel.first sel.last\n" "}\n" "bind Spinbox <> {\n" "if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]\n" "|| !$tk::Priv(mouseMoved)} {\n" "::tk::spinbox::Paste %W %x\n" "}\n" "}\n" "bind Spinbox <1> {\n" "::tk::spinbox::ButtonDown %W %x %y\n" "}\n" "bind Spinbox {\n" "::tk::spinbox::Motion %W %x %y\n" "}\n" "bind Spinbox {\n" "set tk::Priv(selectMode) word\n" "::tk::spinbox::MouseSelect %W %x sel.first\n" "}\n" "bind Spinbox {\n" "set tk::Priv(selectMode) line\n" "::tk::spinbox::MouseSelect %W %x 0\n" "}\n" "bind Spinbox {\n" "set tk::Priv(selectMode) char\n" "%W selection adjust @%x\n" "}\n" "bind Spinbox {\n" "set tk::Priv(selectMode) word\n" "::tk::spinbox::MouseSelect %W %x\n" "}\n" "bind Spinbox {\n" "set tk::Priv(selectMode) line\n" "::tk::spinbox::MouseSelect %W %x\n" "}\n" "bind Spinbox {\n" "set tk::Priv(x) %x\n" "::tk::spinbox::AutoScan %W\n" "}\n" "bind Spinbox {\n" "tk::CancelRepeat\n" "}\n" "bind Spinbox {\n" "::tk::spinbox::ButtonUp %W %x %y\n" "}\n" "bind Spinbox {\n" "%W icursor @%x\n" "}\n" "bind Spinbox {\n" "%W invoke buttonup\n" "}\n" "bind Spinbox {\n" "%W invoke buttondown\n" "}\n" "bind Spinbox {\n" "::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]\n" "}\n" "bind Spinbox {\n" "::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]\n" "}\n" "bind Spinbox {\n" "::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]\n" "::tk::EntrySeeInsert %W\n" "}\n" "bind Spinbox {\n" "::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]\n" "::tk::EntrySeeInsert %W\n" "}\n" "bind Spinbox {\n" "::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]\n" "}\n" "bind Spinbox {\n" "::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]\n" "}\n" "bind Spinbox {\n" "::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]\n" "::tk::EntrySeeInsert %W\n" "}\n" "bind Spinbox {\n" "::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]\n" "::tk::EntrySeeInsert %W\n" "}\n" "bind Spinbox {\n" "::tk::EntrySetCursor %W 0\n" "}\n" "bind Spinbox {\n" "::tk::EntryKeySelect %W 0\n" "::tk::EntrySeeInsert %W\n" "}\n" "bind Spinbox {\n" "::tk::EntrySetCursor %W end\n" "}\n" "bind Spinbox {\n" "::tk::EntryKeySelect %W end\n" "::tk::EntrySeeInsert %W\n" "}\n" "bind Spinbox {\n" "if {[%W selection present]} {\n" "%W delete sel.first sel.last\n" "} else {\n" "%W delete insert\n" "}\n" "}\n" "bind Spinbox {\n" "::tk::EntryBackspace %W\n" "}\n" "bind Spinbox {\n" "%W selection from insert\n" "}\n" "bind Spinbox {\n" "%W mark set anchor insert\n" "}\n" "bind Text {\n" "set tk::Priv(selectMode) char\n" "tk::TextKeyExtend %W insert\n" "}\n" "bind Text {\n" "set tk::Priv(selectMode) char\n" "tk::TextKeyExtend %W insert\n" "}\n" "bind Text {\n" "%W tag add sel 1.0 end\n" "}\n" "bind Text {\n" "%W tag remove sel 1.0 end\n" "}\n" "bind Text <> {\n" "tk_textCut %W\n" "}\n" "bind Text <> {\n" "tk_textCopy %W\n" "}\n" "bind Text <> {\n" "tk_textPaste %W\n" "}\n" "bind Text <> {\n" "catch {%W delete sel.first sel.last}\n" "}\n" "bind Text <> {\n" "if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]\n" "|| !$tk::Priv(mouseMoved)} {\n" "tk::TextPasteSelection %W %x %y\n" "}\n" "}\n" "bind Text {\n" "catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}\n" "}\n" "bind Text {\n" "tk::TextInsert %W %A\n" "}\n" "bind Text {# nothing }\n" "bind Text {# nothing}\n" "bind Text {# nothing}\n" "bind Text {# nothing}\n" "bind Text {# nothing}\n" "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Text {# nothing}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W {insert linestart}\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W insert-1c\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "%W delete insert\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W {insert lineend}\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W insert+1c\n" "}\n" "}\n" "bind Text {\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 {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W [tk::TextUpDownLine %W 1]\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "%W insert insert \\n\n" "%W mark set insert insert-1c\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W [tk::TextUpDownLine %W -1]\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextTranspose %W\n" "}\n" "}\n" "bind Text <> {\n" "catch { %W edit undo }\n" "}\n" "bind Text <> {\n" "catch { %W edit redo }\n" "}\n" "if {$tcl_platform(platform) ne \"windows\"} {\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextScrollPages %W 1\n" "}\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "%W delete insert [tk::TextNextWord %W insert]\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W [tk::TextNextWord %W insert]\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W 1.0\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextSetCursor %W end-1c\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "%W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "%W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert\n" "}\n" "}\n" "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Text {\n" "%W tag configure sel -borderwidth 0\n" "%W configure -selectbackground systemHighlight -selectforeground systemHighlightText\n" "}\n" "bind Text {\n" "%W tag configure sel -borderwidth 1\n" "%W configure -selectbackground white -selectforeground black\n" "}\n" "bind Text {\n" "tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]\n" "}\n" "bind Text {\n" "tk::TextSetCursor %W [tk::TextNextWord %W insert]\n" "}\n" "bind Text {\n" "tk::TextSetCursor %W [tk::TextPrevPara %W insert]\n" "}\n" "bind Text {\n" "tk::TextSetCursor %W [tk::TextNextPara %W insert]\n" "}\n" "bind Text {\n" "tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]\n" "}\n" "bind Text {\n" "tk::TextKeySelect %W [tk::TextNextWord %W insert]\n" "}\n" "bind Text {\n" "tk::TextKeySelect %W [tk::TextPrevPara %W insert]\n" "}\n" "bind Text {\n" "tk::TextKeySelect %W [tk::TextNextPara %W insert]\n" "}\n" "}\n" "bind Text {\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" "tk::TextScanMark %W %x %y\n" "}\n" "}\n" "bind Text {\n" "if {!$tk_strictMotif} {\n" "tk::TextScanDrag %W %x %y\n" "}\n" "}\n" "set ::tk::Priv(prevPos) {}\n" "if {[tk windowingsystem] eq \"classic\" || [tk windowingsystem] eq \"aqua\"} {\n" "bind Text {\n" "%W yview scroll [expr {- (%D)}] units\n" "}\n" "bind Text {\n" "%W yview scroll [expr {-10 * (%D)}] units\n" "}\n" "bind Text {\n" "%W xview scroll [expr {- (%D)}] units\n" "}\n" "bind Text {\n" "%W xview scroll [expr {-10 * (%D)}] units\n" "}\n" "} else {\n" "bind Text {\n" "%W yview scroll [expr {- (%D / 120) * 4}] units\n" "}\n" "}\n" "if {\"x11\" eq [tk windowingsystem]} {\n" "bind Text <4> {\n" "if {!$tk_strictMotif} {\n" "%W yview scroll -5 units\n" "}\n" "}\n" "bind Text <5> {\n" "if {!$tk_strictMotif} {\n" "%W yview scroll 5 units\n" "}\n" "}\n" "}\n" "proc ::tk::TextClosestGap {w x y} {\n" "set pos [$w index @$x,$y]\n" "set bbox [$w bbox $pos]\n" "if {$bbox eq \"\"} {\n" "return $pos\n" "}\n" "if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {\n" "return $pos\n" "}\n" "$w index \"$pos + 1 char\"\n" "}\n" "proc ::tk::TextButton1 {w x y} {\n" "variable ::tk::Priv\n" "set Priv(selectMode) char\n" "set Priv(mouseMoved) 0\n" "set Priv(pressX) $x\n" "$w mark set insert [TextClosestGap $w $x $y]\n" "$w mark set anchor insert\n" "if {$::tcl_platform(platform) eq \"windows\" || [$w cget -state] eq \"normal\"} {focus $w}\n" "if {[$w cget -autoseparators]} {$w edit separator}\n" "}\n" "proc ::tk::TextSelectTo {w x y {extend 0}} {\n" "global tcl_platform\n" "variable ::tk::Priv\n" "set cur [TextClosestGap $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($Priv(pressX) - $x) >= 3)} {\n" "set Priv(mouseMoved) 1\n" "}\n" "switch $Priv(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 [TextPrevPos $w \"$cur + 1c\" tcl_wordBreakBefore]\n" "if { !$extend } {\n" "set last [TextNextPos $w \"anchor\" tcl_wordBreakAfter]\n" "} else {\n" "set last anchor\n" "}\n" "} else {\n" "set last [TextNextPos $w \"$cur - 1c\" tcl_wordBreakAfter]\n" "if { !$extend } {\n" "set first [TextPrevPos $w anchor tcl_wordBreakBefore]\n" "} else {\n" "set first anchor\n" "}\n" "}\n" "}\n" "line {\n" "if {[$w compare $cur < anchor]} {\n" "set first [$w index \"$cur linestart\"]\n" "set last [$w index \"anchor - 1c lineend + 1c\"]\n" "} else {\n" "set first [$w index \"anchor linestart\"]\n" "set last [$w index \"$cur lineend + 1c\"]\n" "}\n" "}\n" "}\n" "if {$Priv(mouseMoved) || $Priv(selectMode) ne \"char\"} {\n" "$w tag remove sel 0.0 end\n" "$w mark set insert $cur\n" "$w tag add sel $first $last\n" "$w tag remove sel $last end\n" "update idletasks\n" "}\n" "}\n" "proc ::tk::TextKeyExtend {w index} {\n" "set cur [$w index $index]\n" "if {[catch {$w index anchor}]} {\n" "$w mark set anchor $cur\n" "}\n" "set anchor [$w index anchor]\n" "if {[$w compare $cur < anchor]} {\n" "set first $cur\n" "set last anchor\n" "} else {\n" "set first anchor\n" "set last $cur\n" "}\n" "$w tag remove sel 0.0 $first\n" "$w tag add sel $first $last\n" "$w tag remove sel $last end\n" "}\n" "proc ::tk::TextPasteSelection {w x y} {\n" "$w mark set insert [TextClosestGap $w $x $y]\n" "if {![catch {::tk::GetSelection $w PRIMARY} sel]} {\n" "set oldSeparator [$w cget -autoseparators]\n" "if {$oldSeparator} {\n" "$w configure -autoseparators 0\n" "$w edit separator\n" "}\n" "$w insert insert $sel\n" "if {$oldSeparator} {\n" "$w edit separator\n" "$w configure -autoseparators 1\n" "}\n" "}\n" "if {[$w cget -state] eq \"normal\"} {focus $w}\n" "}\n" "proc ::tk::TextAutoScan {w} {\n" "variable ::tk::Priv\n" "if {![winfo exists $w]} return\n" "if {$Priv(y) >= [winfo height $w]} {\n" "$w yview scroll 2 units\n" "} elseif {$Priv(y) < 0} {\n" "$w yview scroll -2 units\n" "} elseif {$Priv(x) >= [winfo width $w]} {\n" "$w xview scroll 2 units\n" "} elseif {$Priv(x) < 0} {\n" "$w xview scroll -2 units\n" "} else {\n" "return\n" "}\n" "TextSelectTo $w $Priv(x) $Priv(y)\n" "set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]\n" "}\n" "proc ::tk::TextSetCursor {w pos} {\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" "if {[$w cget -autoseparators]} {$w edit separator}\n" "}\n" "proc ::tk::TextKeySelect {w new} {\n" "if {[$w tag nextrange sel 1.0 end] eq \"\"} {\n" "if {[$w compare $new < insert]} {\n" "$w tag add sel $new insert\n" "} else {\n" "$w tag add sel insert $new\n" "}\n" "$w mark set anchor insert\n" "} else {\n" "if {[$w compare $new < anchor]} {\n" "set first $new\n" "set last anchor\n" "} else {\n" "set first anchor\n" "set last $new\n" "}\n" "$w tag remove sel 1.0 $first\n" "$w tag add sel $first $last\n" "$w tag remove sel $last end\n" "}\n" "$w mark set insert $new\n" "$w see insert\n" "update idletasks\n" "}\n" "proc ::tk::TextResetAnchor {w index} {\n" "if {[$w tag ranges sel] eq \"\"} {\n" "return\n" "}\n" "set a [$w index $index]\n" "set b [$w index sel.first]\n" "set c [$w index sel.last]\n" "if {[$w compare $a < $b]} {\n" "$w mark set anchor sel.last\n" "return\n" "}\n" "if {[$w compare $a > $c]} {\n" "$w mark set anchor sel.first\n" "return\n" "}\n" "scan $a \"%d.%d\" lineA chA\n" "scan $b \"%d.%d\" lineB chB\n" "scan $c \"%d.%d\" lineC chC\n" "if {$lineB < $lineC+2} {\n" "set total [string length [$w get $b $c]]\n" "if {$total <= 2} {\n" "return\n" "}\n" "if {[string length [$w get $b $a]] < ($total/2)} {\n" "$w mark set anchor sel.last\n" "} else {\n" "$w mark set anchor sel.first\n" "}\n" "return\n" "}\n" "if {($lineA-$lineB) < ($lineC-$lineA)} {\n" "$w mark set anchor sel.last\n" "} else {\n" "$w mark set anchor sel.first\n" "}\n" "}\n" "proc ::tk::TextInsert {w s} {\n" "if {$s eq \"\" || [$w cget -state] eq \"disabled\"} {\n" "return\n" "}\n" "set compound 0\n" "catch {\n" "if {[$w compare sel.first <= insert] \\\n" "\011\011&& [$w compare sel.last >= insert]} {\n" "set oldSeparator [$w cget -autoseparators]\n" "if { $oldSeparator } {\n" "$w configure -autoseparators 0\n" "$w edit separator\n" "set compound 1\n" "}\n" "$w delete sel.first sel.last\n" "}\n" "}\n" "$w insert insert $s\n" "$w see insert\n" "if { $compound && $oldSeparator } {\n" "$w edit separator\n" "$w configure -autoseparators 1\n" "}\n" "}\n" "proc ::tk::TextUpDownLine {w n} {\n" "variable ::tk::Priv\n" "set i [$w index insert]\n" "scan $i \"%d.%d\" line char\n" "if {$Priv(prevPos) ne $i} {\n" "set Priv(char) $char\n" "}\n" "set new [$w index [expr {$line + $n}].$Priv(char)]\n" "if {[$w compare $new == end] || [$w compare $new == \"insert linestart\"]} {\n" "set new $i\n" "}\n" "set Priv(prevPos) $new\n" "return $new\n" "}\n" "proc ::tk::TextPrevPara {w pos} {\n" "set pos [$w index \"$pos linestart\"]\n" "while {1} {\n" "if {([$w get \"$pos - 1 line\"] eq \"\\n\" \\\n" "\011\011 && [$w get $pos] ne \"\\n\") || $pos eq \"1.0\"} {\n" "if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n" "\011\011 dummy index]} {\n" "set pos [$w index \"$pos + [lindex $index 0] chars\"]\n" "}\n" "if {[$w compare $pos != insert] || [lindex [split $pos .] 0] == 1} {\n" "return $pos\n" "}\n" "}\n" "set pos [$w index \"$pos - 1 line\"]\n" "}\n" "}\n" "proc ::tk::TextNextPara {w start} {\n" "set pos [$w index \"$start linestart + 1 line\"]\n" "while {[$w get $pos] ne \"\\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] eq \"\\n\"} {\n" "set pos [$w index \"$pos + 1 line\"]\n" "if {[$w compare $pos == end]} {\n" "return [$w index \"end - 1c\"]\n" "}\n" "}\n" "if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n" "\011 dummy index]} {\n" "return [$w index \"$pos + [lindex $index 0] chars\"]\n" "}\n" "return $pos\n" "}\n" "proc ::tk::TextScrollPages {w count} {\n" "set bbox [$w bbox insert]\n" "$w yview scroll $count pages\n" "if {$bbox eq \"\"} {\n" "return [$w index @[expr {[winfo height $w]/2}],0]\n" "}\n" "return [$w index @[lindex $bbox 0],[lindex $bbox 1]]\n" "}\n" "proc ::tk::TextTranspose 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" "set autosep [$w cget -autoseparators]\n" "if {$autosep} {\n" "$w configure -autoseparators 0\n" "$w edit separator\n" "}\n" "$w delete \"$pos - 2 char\" $pos\n" "$w insert insert $new\n" "$w see insert\n" "if {$autosep} {\n" "$w edit separator\n" "$w configure -autoseparators $autosep\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" "proc ::tk_textCut w {\n" "if {![catch {set data [$w get sel.first sel.last]}]} {\n" "clipboard clear -displayof $w\n" "clipboard append -displayof $w $data\n" "$w delete sel.first sel.last\n" "}\n" "}\n" "proc ::tk_textPaste w {\n" "global tcl_platform\n" "if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {\n" "set oldSeparator [$w cget -autoseparators]\n" "if { $oldSeparator } {\n" "$w configure -autoseparators 0\n" "$w edit separator\n" "}\n" "if {[tk windowingsystem] ne \"x11\"} {\n" "catch { $w delete sel.first sel.last }\n" "}\n" "$w insert insert $sel\n" "if { $oldSeparator } {\n" "$w edit separator\n" "$w configure -autoseparators 1\n" "}\n" "}\n" "}\n" "if {$tcl_platform(platform) eq \"windows\"} {\n" "proc ::tk::TextNextWord {w start} {\n" "TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \\\n" "\011 tcl_startOfNextWord\n" "}\n" "} else {\n" "proc ::tk::TextNextWord {w start} {\n" "TextNextPos $w $start tcl_endOfWord\n" "}\n" "}\n" "proc ::tk::TextNextPos {w start op} {\n" "set text \"\"\n" "set cur $start\n" "while {[$w compare $cur < end]} {\n" "set text $text[$w get $cur \"$cur lineend + 1c\"]\n" "set pos [$op $text 0]\n" "if {$pos >= 0} {\n" "set dump [$w dump -image -window $start \"$start + $pos c\"]\n" "if {[llength $dump]} {\n" "set pos [expr {$pos + ([llength $dump]/3)}]\n" "}\n" "return [$w index \"$start + $pos c\"]\n" "}\n" "set cur [$w index \"$cur lineend +1c\"]\n" "}\n" "return end\n" "}\n" "proc ::tk::TextPrevPos {w start op} {\n" "set text \"\"\n" "set cur $start\n" "while {[$w compare $cur > 0.0]} {\n" "set text [$w get \"$cur linestart - 1c\" $cur]$text\n" "set pos [$op $text end]\n" "if {$pos >= 0} {\n" "set dump [$w dump -image -window \"$cur linestart\" \"$start - 1c\"]\n" "if {[llength $dump]} {\n" "if {[$w compare [lindex $dump 2] > \\\n" "\011\011\011\"$cur linestart - 1c + $pos c\"]} {\n" "incr pos -1\n" "}\n" "set pos [expr {$pos + ([llength $dump]/3)}]\n" "}\n" "return [$w index \"$cur linestart - 1c + $pos c\"]\n" "}\n" "set cur [$w index \"$cur linestart - 1c\"]\n" "}\n" "return 0.0\n" "}\n" "proc ::tk::TextScanMark {w x y} {\n" "$w scan mark $x $y\n" "set ::tk::Priv(x) $x\n" "set ::tk::Priv(y) $y\n" "set ::tk::Priv(mouseMoved) 0\n" "}\n" "proc ::tk::TextScanDrag {w x y} {\n" "if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }\n" "if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y }\n" "if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} {\n" "set ::tk::Priv(mouseMoved) 1\n" "}\n" "if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} {\n" "$w scan dragto $x $y\n" "}\n" "}\n" ; static unsigned char Et_zFile34[] = "package require -exact Tk 8.4\n" "package require -exact Tcl 8.4\n" "namespace eval ::tk {\n" "namespace eval msgcat {\n" "namespace export mc mcmax \n" "if {[interp issafe] || [catch {package require msgcat}]} {\n" "proc mc {src args} {\n" "return [eval [list format $src] $args]\n" "}\n" "proc mcmax {args} {\n" "set max 0\n" "foreach string $args {\n" "set len [string length $string]\n" "if {$len>$max} {\n" "set max $len\n" "}\n" "}\n" "return $max\n" "}\n" "} else {\n" "namespace import ::msgcat::mc\n" "namespace import ::msgcat::mcmax\n" "::msgcat::mcload [file join $::tk_library msgs]\n" "}\n" "}\n" "namespace import ::tk::msgcat::*\n" "}\n" "if {[info exists ::auto_path] && $::tk_library ne \"\" && \\\n" "\011[lsearch -exact $::auto_path $::tk_library] < 0} {\n" "lappend ::auto_path $::tk_library\n" "}\n" "set ::tk_strictMotif 0\n" "catch {tk useinputmethods 1}\n" "proc ::tk::PlaceWindow {w {place \"\"} {anchor \"\"}} {\n" "wm withdraw $w\n" "update idletasks\n" "set checkBounds 1\n" "set place_len [string length $place]\n" "if {$place eq \"\"} {\n" "set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]\n" "set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]\n" "set checkBounds 0\n" "} elseif {[string equal -length $place_len $place \"pointer\"]} {\n" "if {[string equal -length [string length $anchor] $anchor \"center\"]} {\n" "set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]\n" "set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]\n" "} else {\n" "set x [winfo pointerx $w]\n" "set y [winfo pointery $w]\n" "}\n" "} elseif {[string equal -length $place_len $place \"widget\"] && \\\n" "\011 [winfo exists $anchor] && [winfo ismapped $anchor]} {\n" "set x [expr {[winfo rootx $anchor] + \\\n" "\011\011([winfo width $anchor]-[winfo reqwidth $w])/2}]\n" "set y [expr {[winfo rooty $anchor] + \\\n" "\011\011([winfo height $anchor]-[winfo reqheight $w])/2}]\n" "} else {\n" "set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]\n" "set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]\n" "set checkBounds 0\n" "}\n" "set windowingsystem [tk windowingsystem]\n" "if {$windowingsystem eq \"win32\"} {\n" "set checkBounds 0\n" "}\n" "if {$checkBounds} {\n" "if {$x < 0} {\n" "set x 0\n" "} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {\n" "set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]\n" "}\n" "if {$y < 0} {\n" "set y 0\n" "} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {\n" "set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]\n" "}\n" "if {$windowingsystem eq \"macintosh\" || $windowingsystem eq \"aqua\"} {\n" "if {$y < 20} { set y 20 }\n" "}\n" "}\n" "wm geometry $w +$x+$y\n" "wm deiconify $w\n" "}\n" "proc ::tk::SetFocusGrab {grab {focus {}}} {\n" "set index \"$grab,$focus\"\n" "upvar ::tk::FocusGrab($index) data\n" "lappend data [focus]\n" "set oldGrab [grab current $grab]\n" "lappend data $oldGrab\n" "if {[winfo exists $oldGrab]} {\n" "lappend data [grab status $oldGrab]\n" "}\n" "catch {grab $grab}\n" "if {[winfo exists $focus]} {\n" "focus $focus\n" "}\n" "}\n" "proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {\n" "set index \"$grab,$focus\"\n" "if {[info exists ::tk::FocusGrab($index)]} {\n" "foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }\n" "unset ::tk::FocusGrab($index)\n" "} else {\n" "set oldGrab \"\"\n" "}\n" "catch {focus $oldFocus}\n" "grab release $grab\n" "if {$destroy eq \"withdraw\"} {\n" "wm withdraw $grab\n" "} else {\n" "destroy $grab\n" "}\n" "if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {\n" "if {$oldStatus eq \"global\"} {\n" "grab -global $oldGrab\n" "} else {\n" "grab $oldGrab\n" "}\n" "}\n" "}\n" "if {$tcl_platform(platform) eq \"unix\"} {\n" "proc ::tk::GetSelection {w {sel PRIMARY}} {\n" "if {[catch {selection get -displayof $w -selection $sel \\\n" "\011\011-type UTF8_STRING} txt] \\\n" "\011\011&& [catch {selection get -displayof $w -selection $sel} txt]} {\n" "return -code error \"could not find default selection\"\n" "} else {\n" "return $txt\n" "}\n" "}\n" "} else {\n" "proc ::tk::GetSelection {w {sel PRIMARY}} {\n" "if {[catch {selection get -displayof $w -selection $sel} txt]} {\n" "return -code error \"could not find default selection\"\n" "} else {\n" "return $txt\n" "}\n" "}\n" "}\n" "proc ::tk::ScreenChanged screen {\n" "set x [string last . $screen]\n" "if {$x > 0} {\n" "set disp [string range $screen 0 [expr {$x - 1}]]\n" "} else {\n" "set disp $screen\n" "}\n" "uplevel #0 upvar #0 ::tk::Priv.$disp ::tk::Priv\n" "variable ::tk::Priv\n" "global tcl_platform\n" "if {[info exists Priv]} {\n" "set Priv(screen) $screen\n" "return\n" "}\n" "array set Priv {\n" "activeMenu\011{}\n" "activeItem\011{}\n" "afterId\011\011{}\n" "buttons\011\0110\n" "buttonWindow\011{}\n" "dragging\0110\n" "focus\011\011{}\n" "grab\011\011{}\n" "initPos\011\011{}\n" "inMenubutton\011{}\n" "listboxPrev\011{}\n" "menuBar\011\011{}\n" "mouseMoved\0110\n" "oldGrab\011\011{}\n" "popup\011\011{}\n" "postedMb\011{}\n" "pressX\011\0110\n" "pressY\011\0110\n" "prevPos\011\0110\n" "selectMode\011char\n" "}\n" "set Priv(screen) $screen\n" "set Priv(tearoff) [string equal [tk windowingsystem] \"x11\"]\n" "set Priv(window) {}\n" "}\n" "tk::ScreenChanged [winfo screen .]\n" "proc ::tk::EventMotifBindings {n1 dummy dummy} {\n" "upvar $n1 name\n" "if {$name} {\n" "set op delete\n" "} else {\n" "set op add\n" "}\n" "event $op <> \n" "event $op <> \n" "event $op <> \n" "event $op <> \n" "}\n" "if {[info commands tk_chooseColor] eq \"\"} {\n" "proc ::tk_chooseColor {args} {\n" "return [eval tk::dialog::color:: $args]\n" "}\n" "}\n" "if {[info commands tk_getOpenFile] eq \"\"} {\n" "proc ::tk_getOpenFile {args} {\n" "if {$::tk_strictMotif} {\n" "return [eval tk::MotifFDialog open $args]\n" "} else {\n" "return [eval ::tk::dialog::file:: open $args]\n" "}\n" "}\n" "}\n" "if {[info commands tk_getSaveFile] eq \"\"} {\n" "proc ::tk_getSaveFile {args} {\n" "if {$::tk_strictMotif} {\n" "return [eval tk::MotifFDialog save $args]\n" "} else {\n" "return [eval ::tk::dialog::file:: save $args]\n" "}\n" "}\n" "}\n" "if {[info commands tk_messageBox] eq \"\"} {\n" "proc ::tk_messageBox {args} {\n" "return [eval tk::MessageBox $args]\n" "}\n" "}\n" "if {[info command tk_chooseDirectory] eq \"\"} {\n" "proc ::tk_chooseDirectory {args} {\n" "return [eval ::tk::dialog::file::chooseDir:: $args]\n" "}\n" "}\n" "switch [tk windowingsystem] {\n" "\"x11\" {\n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "catch { event add <> }\n" "catch { event add <> }\n" "trace add variable ::tk_strictMotif write ::tk::EventMotifBindings\n" "set ::tk_strictMotif $::tk_strictMotif\n" "}\n" "\"win32\" {\n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "}\n" "\"aqua\" {\n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "}\n" "\"classic\" {\n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "}\n" "}\n" "if {$::tk_library ne \"\"} {\n" "if {$tcl_platform(platform) eq \"macintosh\"} {\n" "proc ::tk::SourceLibFile {file} {\n" "if {[catch {\n" "namespace eval :: \\\n" "\011\011\011[list source [file join $::tk_library $file.tcl]]\n" "}]} {\n" "namespace eval :: [list source -rsrc $file]\n" "}\n" "}\n" "} else {\n" "proc ::tk::SourceLibFile {file} {\n" "namespace eval :: [list source [file join $::tk_library $file.tcl]]\n" "}\011\n" "}\n" "namespace eval ::tk {\n" "SourceLibFile button\n" "SourceLibFile entry\n" "SourceLibFile listbox\n" "SourceLibFile menu\n" "SourceLibFile panedwindow\n" "SourceLibFile scale\n" "SourceLibFile scrlbar\n" "SourceLibFile spinbox\n" "SourceLibFile text\n" "}\n" "}\n" "event add <> \n" "bind all {tk::TabToWindow [tk_focusNext %W]}\n" "bind all <> {tk::TabToWindow [tk_focusPrev %W]}\n" "proc ::tk::CancelRepeat {} {\n" "variable ::tk::Priv\n" "after cancel $Priv(afterId)\n" "set Priv(afterId) {}\n" "}\n" "proc ::tk::TabToWindow {w} {\n" "set wclass [winfo class $w]\n" "if {$wclass eq \"Entry\" || $wclass eq \"Spinbox\"} {\n" "$w selection range 0 end\n" "$w icursor end\n" "}\n" "focus $w\n" "}\n" "proc ::tk::UnderlineAmpersand {text} {\n" "set idx [string first \"&\" $text]\n" "if {$idx >= 0} {\n" "set underline $idx\n" "while {[string match \"&\" [string index $text [expr {$idx + 1}]]]} {\n" "set base [expr {$idx + 2}]\n" "set idx [string first \"&\" [string range $text $base end]]\n" "if {$idx < 0} {\n" "break\n" "} else {\n" "set underline [expr {$underline + $idx + 1}]\n" "incr idx $base\n" "}\n" "}\n" "}\n" "if {$idx >= 0} {\n" "regsub -all -- {&([^&])} $text {\\1} text\n" "} \n" "return [list $text $idx]\n" "}\n" "proc ::tk::SetAmpText {widget text} {\n" "foreach {newtext under} [::tk::UnderlineAmpersand $text] {\n" "$widget configure -text $newtext -underline $under\n" "}\n" "}\n" "proc ::tk::AmpWidget {class path args} {\n" "set wcmd [list $class $path]\n" "foreach {opt val} $args {\n" "if {$opt eq \"-text\"} {\n" "foreach {newtext under} [::tk::UnderlineAmpersand $val] {\n" "lappend wcmd -text $newtext -underline $under\n" "}\n" "} else {\n" "lappend wcmd $opt $val\n" "}\n" "}\n" "eval $wcmd\n" "if {$class eq \"button\"} {\n" "bind $path <> [list $path invoke]\n" "}\n" "return $path\n" "}\n" "proc ::tk::FindAltKeyTarget {path char} {\n" "switch [winfo class $path] {\n" "Button -\n" "Label {\n" "if {[string equal -nocase $char \\\n" "\011\011[string index [$path cget -text] \\\n" "\011\011[$path cget -underline]]]} {return $path} else {return {}}\n" "}\n" "default {\n" "foreach child \\\n" "\011\011[concat [grid slaves $path] \\\n" "\011\011[pack slaves $path] \\\n" "\011\011[place slaves $path] ] {\n" "if {\"\" ne [set target [::tk::FindAltKeyTarget $child $char]]} {\n" "return $target\n" "}\n" "}\n" "}\n" "}\n" "return {}\n" "}\n" "proc ::tk::AltKeyInDialog {path key} {\n" "set target [::tk::FindAltKeyTarget $path $key]\n" "if { $target eq \"\"} return\n" "event generate $target <>\n" "}\n" "proc ::tk::mcmaxamp {args} {\n" "set maxlen 0\n" "foreach arg $args {\n" "set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]]\n" "if {$length>$maxlen} {\n" "set maxlen $length\n" "}\n" "}\n" "return $maxlen\n" "}\n" "if {[tk windowingsystem] eq \"aqua\"} {\n" "namespace eval ::tk::mac {\n" "set useCustomMDEF 0\n" "}\n" "}\n" ; static unsigned char Et_zFile35[] = "proc ::tk::IconList {w args} {\n" "IconList_Config $w $args\n" "IconList_Create $w\n" "}\n" "proc ::tk::IconList_Index {w i} {\n" "upvar #0 ::tk::$w data\n" "upvar #0 ::tk::$w:itemList itemList\n" "if {![info exists data(list)]} {set data(list) {}}\n" "switch -regexp -- $i {\n" "\"^-?[0-9]+$\" {\n" "if { $i < 0 } {\n" "set i 0\n" "}\n" "if { $i >= [llength $data(list)] } {\n" "set i [expr {[llength $data(list)] - 1}]\n" "}\n" "return $i\n" "}\n" "\"^active$\" {\n" "return $data(index,active)\n" "}\n" "\"^anchor$\" {\n" "return $data(index,anchor)\n" "}\n" "\"^end$\" {\n" "return [llength $data(list)]\n" "}\n" "\"@-?[0-9]+,-?[0-9]+\" {\n" "foreach {x y} [scan $i \"@%d,%d\"] {\n" "break\n" "}\n" "set item [$data(canvas) find closest $x $y]\n" "return [lindex [$data(canvas) itemcget $item -tags] 1]\n" "}\n" "}\n" "}\n" "proc ::tk::IconList_Selection {w op args} {\n" "upvar ::tk::$w data\n" "switch -exact -- $op {\n" "\"anchor\" {\n" "if { [llength $args] == 1 } {\n" "set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]\n" "} else {\n" "return $data(index,anchor)\n" "}\n" "}\n" "\"clear\" {\n" "if { [llength $args] == 2 } {\n" "foreach {first last} $args {\n" "break\n" "}\n" "} elseif { [llength $args] == 1 } {\n" "set first [set last [lindex $args 0]]\n" "} else {\n" "error \"wrong # args: should be [lindex [info level 0] 0] path\\\n" "\011\011\011clear first ?last?\"\n" "}\n" "set first [IconList_Index $w $first]\n" "set last [IconList_Index $w $last]\n" "if { $first > $last } {\n" "set tmp $first\n" "set first $last\n" "set last $tmp\n" "}\n" "set ind 0\n" "foreach item $data(selection) {\n" "if { $item >= $first } {\n" "set first $ind\n" "break\n" "}\n" "}\n" "set ind [expr {[llength $data(selection)] - 1}]\n" "for {} {$ind >= 0} {incr ind -1} {\n" "set item [lindex $data(selection) $ind]\n" "if { $item <= $last } {\n" "set last $ind\n" "break\n" "}\n" "}\n" "if { $first > $last } {\n" "return\n" "}\n" "set data(selection) [lreplace $data(selection) $first $last]\n" "event generate $w <>\n" "IconList_DrawSelection $w\n" "}\n" "\"includes\" {\n" "set index [lsearch -exact $data(selection) [lindex $args 0]]\n" "return [expr {$index != -1}]\n" "}\n" "\"set\" {\n" "if { [llength $args] == 2 } {\n" "foreach {first last} $args {\n" "break\n" "}\n" "} elseif { [llength $args] == 1 } {\n" "set last [set first [lindex $args 0]]\n" "} else {\n" "error \"wrong # args: should be [lindex [info level 0] 0] path\\\n" "\011\011\011set first ?last?\"\n" "}\n" "set first [IconList_Index $w $first]\n" "set last [IconList_Index $w $last]\n" "if { $first > $last } {\n" "set tmp $first\n" "set first $last\n" "set last $tmp\n" "}\n" "for {set i $first} {$i <= $last} {incr i} {\n" "lappend data(selection) $i\n" "}\n" "set data(selection) [lsort -integer -unique $data(selection)]\n" "event generate $w <>\n" "IconList_DrawSelection $w\n" "}\n" "}\n" "}\n" "proc ::tk::IconList_Curselection {w} {\n" "upvar ::tk::$w data\n" "return $data(selection)\n" "}\n" "proc ::tk::IconList_DrawSelection {w} {\n" "upvar ::tk::$w data\n" "upvar ::tk::$w:itemList itemList\n" "$data(canvas) delete selection\n" "foreach item $data(selection) {\n" "set rTag [lindex [lindex $data(list) $item] 2]\n" "foreach {iTag tTag text serial} $itemList($rTag) {\n" "break\n" "}\n" "set bbox [$data(canvas) bbox $tTag]\n" "$data(canvas) create rect $bbox -fill \\#a0a0ff -outline \\#a0a0ff \\\n" "\011\011-tags selection\n" "}\n" "$data(canvas) lower selection\n" "return\n" "}\n" "proc ::tk::IconList_Get {w item} {\n" "upvar ::tk::$w data\n" "upvar ::tk::$w:itemList itemList\n" "set rTag [lindex [lindex $data(list) $item] 2]\n" "foreach {iTag tTag text serial} $itemList($rTag) {\n" "break\n" "}\n" "return $text\n" "}\n" "proc ::tk::IconList_Config {w argList} {\n" "set specs {\n" "{-command \"\" \"\" \"\"}\n" "{-multiple \"\" \"\" \"0\"}\n" "}\n" "tclParseConfigSpec ::tk::$w $specs \"\" $argList\n" "}\n" "proc ::tk::IconList_Create {w} {\n" "upvar ::tk::$w data\n" "frame $w\n" "set data(sbar) [scrollbar $w.sbar -orient horizontal \\\n" "\011 -highlightthickness 0 -takefocus 0]\n" "set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \\\n" "\011 -width 400 -height 120 -takefocus 1]\n" "pack $data(sbar) -side bottom -fill x -padx 2\n" "pack $data(canvas) -expand yes -fill both\n" "$data(sbar) configure -command [list $data(canvas) xview]\n" "$data(canvas) configure -xscrollcommand [list $data(sbar) set]\n" "set data(maxIW) 1\n" "set data(maxIH) 1\n" "set data(maxTW) 1\n" "set data(maxTH) 1\n" "set data(numItems) 0\n" "set data(curItem) {}\n" "set data(noScroll) 1\n" "set data(selection) {}\n" "set data(index,anchor) \"\"\n" "set fg [option get $data(canvas) foreground Foreground]\n" "if {$fg eq \"\"} {\n" "set data(fill) black\n" "} else {\n" "set data(fill) $fg\n" "}\n" "bind $data(canvas) \011[list tk::IconList_Arrange $w]\n" "bind $data(canvas) <1>\011\011[list tk::IconList_Btn1 $w %x %y]\n" "bind $data(canvas) \011[list tk::IconList_Motion1 $w %x %y]\n" "bind $data(canvas) \011[list tk::IconList_Leave1 $w %x %y]\n" "bind $data(canvas) \011[list tk::IconList_CtrlBtn1 $w %x %y]\n" "bind $data(canvas) \011[list tk::IconList_ShiftBtn1 $w %x %y]\n" "bind $data(canvas) \011[list tk::CancelRepeat]\n" "bind $data(canvas) [list tk::CancelRepeat]\n" "bind $data(canvas) \\\n" "\011 [list tk::IconList_Double1 $w %x %y]\n" "bind $data(canvas) \011\011[list tk::IconList_UpDown $w -1]\n" "bind $data(canvas) \011\011[list tk::IconList_UpDown $w 1]\n" "bind $data(canvas) \011\011[list tk::IconList_LeftRight $w -1]\n" "bind $data(canvas) \011\011[list tk::IconList_LeftRight $w 1]\n" "bind $data(canvas) \011\011[list tk::IconList_ReturnKey $w]\n" "bind $data(canvas) \011[list tk::IconList_KeyPress $w %A]\n" "bind $data(canvas) \";\"\n" "bind $data(canvas) \011\";\"\n" "bind $data(canvas) \011[list tk::IconList_FocusIn $w]\n" "bind $data(canvas) \011[list tk::IconList_FocusOut $w]\n" "return $w\n" "}\n" "proc ::tk::IconList_AutoScan {w} {\n" "upvar ::tk::$w data\n" "variable ::tk::Priv\n" "if {![winfo exists $w]} return\n" "set x $Priv(x)\n" "set y $Priv(y)\n" "if {$data(noScroll)} {\n" "return\n" "}\n" "if {$x >= [winfo width $data(canvas)]} {\n" "$data(canvas) xview scroll 1 units\n" "} elseif {$x < 0} {\n" "$data(canvas) xview scroll -1 units\n" "} elseif {$y >= [winfo height $data(canvas)]} {\n" "} elseif {$y < 0} {\n" "} else {\n" "return\n" "}\n" "IconList_Motion1 $w $x $y\n" "set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]\n" "}\n" "proc ::tk::IconList_DeleteAll {w} {\n" "upvar ::tk::$w data\n" "upvar ::tk::$w:itemList itemList\n" "$data(canvas) delete all\n" "unset -nocomplain data(selected) data(rect) data(list) itemList\n" "set data(maxIW) 1\n" "set data(maxIH) 1\n" "set data(maxTW) 1\n" "set data(maxTH) 1\n" "set data(numItems) 0\n" "set data(curItem) {}\n" "set data(noScroll) 1\n" "set data(selection) {}\n" "set data(index,anchor) \"\"\n" "$data(sbar) set 0.0 1.0\n" "$data(canvas) xview moveto 0\n" "}\n" "proc ::tk::IconList_Add {w image items} {\n" "upvar ::tk::$w data\n" "upvar ::tk::$w:itemList itemList\n" "upvar ::tk::$w:textList textList\n" "foreach text $items {\n" "set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \\\n" "\011\011-tags [list icon $data(numItems) item$data(numItems)]]\n" "set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \\\n" "\011\011-font $data(font) -fill $data(fill) \\\n" "\011\011-tags [list text $data(numItems) item$data(numItems)]]\n" "set rTag [$data(canvas) create rect 0 0 0 0 -fill \"\" -outline \"\" \\\n" "\011\011-tags [list rect $data(numItems) item$data(numItems)]]\n" "foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {\n" "break\n" "}\n" "set iW [expr {$x2 - $x1}]\n" "set iH [expr {$y2 - $y1}]\n" "if {$data(maxIW) < $iW} {\n" "set data(maxIW) $iW\n" "}\n" "if {$data(maxIH) < $iH} {\n" "set data(maxIH) $iH\n" "}\n" "foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {\n" "break\n" "}\n" "set tW [expr {$x2 - $x1}]\n" "set tH [expr {$y2 - $y1}]\n" "if {$data(maxTW) < $tW} {\n" "set data(maxTW) $tW\n" "}\n" "if {$data(maxTH) < $tH} {\n" "set data(maxTH) $tH\n" "}\n" "lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \\\n" "\011\011$tH $data(numItems)]\n" "set itemList($rTag) [list $iTag $tTag $text $data(numItems)]\n" "set textList($data(numItems)) [string tolower $text]\n" "incr data(numItems)\n" "}\n" "}\n" "proc ::tk::IconList_Arrange {w} {\n" "upvar ::tk::$w data\n" "if {![info exists data(list)]} {\n" "if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {\n" "set data(noScroll) 1\n" "$data(sbar) configure -command \"\"\n" "}\n" "return\n" "}\n" "set W [winfo width $data(canvas)]\n" "set H [winfo height $data(canvas)]\n" "set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n" "\011 [$data(canvas) cget -bd]}]\n" "if {$pad < 2} {\n" "set pad 2\n" "}\n" "incr W -[expr {$pad*2}]\n" "incr H -[expr {$pad*2}]\n" "set dx [expr {$data(maxIW) + $data(maxTW) + 8}]\n" "if {$data(maxTH) > $data(maxIH)} {\n" "set dy $data(maxTH)\n" "} else {\n" "set dy $data(maxIH)\n" "}\n" "incr dy 2\n" "set shift [expr {$data(maxIW) + 4}]\n" "set x [expr {$pad * 2}]\n" "set y [expr {$pad * 1}] ; # Why * 1 ?\n" "set usedColumn 0\n" "foreach sublist $data(list) {\n" "set usedColumn 1\n" "foreach {iTag tTag rTag iW iH tW tH} $sublist {\n" "break\n" "}\n" "set i_dy [expr {($dy - $iH)/2}]\n" "set t_dy [expr {($dy - $tH)/2}]\n" "$data(canvas) coords $iTag $x [expr {$y + $i_dy}]\n" "$data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]\n" "$data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]\n" "incr y $dy\n" "if {($y + $dy) > $H} {\n" "set y [expr {$pad * 1}] ; # *1 ?\n" "incr x $dx\n" "set usedColumn 0\n" "}\n" "}\n" "if {$usedColumn} {\n" "set sW [expr {$x + $dx}]\n" "} else {\n" "set sW $x\n" "}\n" "if {$sW < $W} {\n" "$data(canvas) configure -scrollregion [list $pad $pad $sW $H]\n" "$data(sbar) configure -command \"\"\n" "$data(canvas) xview moveto 0\n" "set data(noScroll) 1\n" "} else {\n" "$data(canvas) configure -scrollregion [list $pad $pad $sW $H]\n" "$data(sbar) configure -command [list $data(canvas) xview]\n" "set data(noScroll) 0\n" "}\n" "set data(itemsPerColumn) [expr {($H-$pad)/$dy}]\n" "if {$data(itemsPerColumn) < 1} {\n" "set data(itemsPerColumn) 1\n" "}\n" "if {$data(curItem) ne \"\"} {\n" "IconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0\n" "}\n" "}\n" "proc ::tk::IconList_Invoke {w} {\n" "upvar ::tk::$w data\n" "if {$data(-command) ne \"\" && [llength $data(selection)]} {\n" "uplevel #0 $data(-command)\n" "}\n" "}\n" "proc ::tk::IconList_See {w rTag} {\n" "upvar ::tk::$w data\n" "upvar ::tk::$w:itemList itemList\n" "if {$data(noScroll)} {\n" "return\n" "}\n" "set sRegion [$data(canvas) cget -scrollregion]\n" "if {$sRegion eq \"\"} {\n" "return\n" "}\n" "if { $rTag < 0 || $rTag >= [llength $data(list)] } {\n" "return\n" "}\n" "set bbox [$data(canvas) bbox item$rTag]\n" "set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n" "\011 [$data(canvas) cget -bd]}]\n" "set x1 [lindex $bbox 0]\n" "set x2 [lindex $bbox 2]\n" "incr x1 -[expr {$pad * 2}]\n" "incr x2 -[expr {$pad * 1}] ; # *1 ?\n" "set cW [expr {[winfo width $data(canvas)] - $pad*2}]\n" "set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]\n" "set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]\n" "set oldDispX $dispX\n" "if {($x2 - $dispX) >= $cW} {\n" "set dispX [expr {$x2 - $cW}]\n" "}\n" "if {($x1 - $dispX) < 0} {\n" "set dispX $x1\n" "}\n" "if {$oldDispX ne $dispX} {\n" "set fraction [expr {double($dispX)/double($scrollW)}]\n" "$data(canvas) xview moveto $fraction\n" "}\n" "}\n" "proc ::tk::IconList_Btn1 {w x y} {\n" "upvar ::tk::$w data\n" "focus $data(canvas)\n" "set x [expr {int([$data(canvas) canvasx $x])}]\n" "set y [expr {int([$data(canvas) canvasy $y])}]\n" "set i [IconList_Index $w @${x},${y}]\n" "if {$i eq \"\"} return\n" "IconList_Selection $w clear 0 end\n" "IconList_Selection $w set $i\n" "IconList_Selection $w anchor $i\n" "}\n" "proc ::tk::IconList_CtrlBtn1 {w x y} {\n" "upvar ::tk::$w data\n" "if { $data(-multiple) } {\n" "focus $data(canvas)\n" "set x [expr {int([$data(canvas) canvasx $x])}]\n" "set y [expr {int([$data(canvas) canvasy $y])}]\n" "set i [IconList_Index $w @${x},${y}]\n" "if {$i eq \"\"} return\n" "if { [IconList_Selection $w includes $i] } {\n" "IconList_Selection $w clear $i\n" "} else {\n" "IconList_Selection $w set $i\n" "IconList_Selection $w anchor $i\n" "}\n" "}\n" "}\n" "proc ::tk::IconList_ShiftBtn1 {w x y} {\n" "upvar ::tk::$w data\n" "if { $data(-multiple) } {\n" "focus $data(canvas)\n" "set x [expr {int([$data(canvas) canvasx $x])}]\n" "set y [expr {int([$data(canvas) canvasy $y])}]\n" "set i [IconList_Index $w @${x},${y}]\n" "if {$i eq \"\"} return\n" "set a [IconList_Index $w anchor]\n" "if { $a eq \"\" } {\n" "set a $i\n" "}\n" "IconList_Selection $w clear 0 end\n" "IconList_Selection $w set $a $i\n" "}\n" "}\n" "proc ::tk::IconList_Motion1 {w x y} {\n" "upvar ::tk::$w data\n" "variable ::tk::Priv\n" "set Priv(x) $x\n" "set Priv(y) $y\n" "set x [expr {int([$data(canvas) canvasx $x])}]\n" "set y [expr {int([$data(canvas) canvasy $y])}]\n" "set i [IconList_Index $w @${x},${y}]\n" "if {$i eq \"\"} return\n" "IconList_Selection $w clear 0 end\n" "IconList_Selection $w set $i\n" "}\n" "proc ::tk::IconList_Double1 {w x y} {\n" "upvar ::tk::$w data\n" "if {[llength $data(selection)]} {\n" "IconList_Invoke $w\n" "}\n" "}\n" "proc ::tk::IconList_ReturnKey {w} {\n" "IconList_Invoke $w\n" "}\n" "proc ::tk::IconList_Leave1 {w x y} {\n" "variable ::tk::Priv\n" "set Priv(x) $x\n" "set Priv(y) $y\n" "IconList_AutoScan $w\n" "}\n" "proc ::tk::IconList_FocusIn {w} {\n" "upvar ::tk::$w data\n" "if {![info exists data(list)]} {\n" "return\n" "}\n" "if {[llength $data(selection)]} {\n" "IconList_DrawSelection $w\n" "}\n" "}\n" "proc ::tk::IconList_FocusOut {w} {\n" "IconList_Selection $w clear 0 end\n" "}\n" "proc ::tk::IconList_UpDown {w amount} {\n" "upvar ::tk::$w data\n" "if {![info exists data(list)]} {\n" "return\n" "}\n" "set curr [tk::IconList_Curselection $w]\n" "if { [llength $curr] == 0 } {\n" "set i 0\n" "} else {\n" "set i [tk::IconList_Index $w anchor]\n" "if {$i eq \"\"} return\n" "incr i $amount\n" "}\n" "IconList_Selection $w clear 0 end\n" "IconList_Selection $w set $i\n" "IconList_Selection $w anchor $i\n" "IconList_See $w $i\n" "}\n" "proc ::tk::IconList_LeftRight {w amount} {\n" "upvar ::tk::$w data\n" "if {![info exists data(list)]} {\n" "return\n" "}\n" "set curr [IconList_Curselection $w]\n" "if { [llength $curr] == 0 } {\n" "set i 0\n" "} else {\n" "set i [IconList_Index $w anchor]\n" "if {$i eq \"\"} return\n" "incr i [expr {$amount*$data(itemsPerColumn)}]\n" "}\n" "IconList_Selection $w clear 0 end\n" "IconList_Selection $w set $i\n" "IconList_Selection $w anchor $i\n" "IconList_See $w $i\n" "}\n" "proc ::tk::IconList_KeyPress {w key} {\n" "variable ::tk::Priv\n" "append Priv(ILAccel,$w) $key\n" "IconList_Goto $w $Priv(ILAccel,$w)\n" "catch {\n" "after cancel $Priv(ILAccel,$w,afterId)\n" "}\n" "set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]\n" "}\n" "proc ::tk::IconList_Goto {w text} {\n" "upvar ::tk::$w data\n" "upvar ::tk::$w:textList textList\n" "if {![info exists data(list)]} {\n" "return\n" "}\n" "if {$text eq \"\"} {\n" "return\n" "}\n" "if {$data(curItem) eq \"\" || $data(curItem) == 0} {\n" "set start 0\n" "} else {\n" "set start $data(curItem)\n" "}\n" "set text [string tolower $text]\n" "set theIndex -1\n" "set less 0\n" "set len [string length $text]\n" "set len0 [expr {$len-1}]\n" "set i $start\n" "while {1} {\n" "set sub [string range $textList($i) 0 $len0]\n" "if {$text eq $sub} {\n" "set theIndex $i\n" "break\n" "}\n" "incr i\n" "if {$i == $data(numItems)} {\n" "set i 0\n" "}\n" "if {$i == $start} {\n" "break\n" "}\n" "}\n" "if {$theIndex > -1} {\n" "IconList_Selection $w clear 0 end\n" "IconList_Selection $w set $theIndex\n" "IconList_Selection $w anchor $theIndex\n" "IconList_See $w $theIndex\n" "}\n" "}\n" "proc ::tk::IconList_Reset {w} {\n" "variable ::tk::Priv\n" "unset -nocomplain Priv(ILAccel,$w)\n" "}\n" "namespace eval ::tk::dialog {}\n" "namespace eval ::tk::dialog::file {\n" "namespace import -force ::tk::msgcat::*\n" "set ::tk::dialog::file::showHiddenBtn 0\n" "set ::tk::dialog::file::showHiddenVar 1\n" "}\n" "proc ::tk::dialog::file:: {type args} {\n" "variable ::tk::Priv\n" "set dataName __tk_filedialog\n" "upvar ::tk::dialog::file::$dataName data\n" "::tk::dialog::file::Config $dataName $type $args\n" "if {$data(-parent) eq \".\"} {\n" "set w .$dataName\n" "} else {\n" "set w $data(-parent).$dataName\n" "}\n" "if {![winfo exists $w]} {\n" "::tk::dialog::file::Create $w TkFDialog\n" "} elseif {[winfo class $w] ne \"TkFDialog\"} {\n" "destroy $w\n" "::tk::dialog::file::Create $w TkFDialog\n" "} else {\n" "set data(dirMenuBtn) $w.f1.menu\n" "set data(dirMenu) $w.f1.menu.menu\n" "set data(upBtn) $w.f1.up\n" "set data(icons) $w.icons\n" "set data(ent) $w.f2.ent\n" "set data(typeMenuLab) $w.f2.lab2\n" "set data(typeMenuBtn) $w.f2.menu\n" "set data(typeMenu) $data(typeMenuBtn).m\n" "set data(okBtn) $w.f2.ok\n" "set data(cancelBtn) $w.f2.cancel\n" "set data(hiddenBtn) $w.f2.hidden\n" "::tk::dialog::file::SetSelectMode $w $data(-multiple)\n" "}\n" "if {$::tk::dialog::file::showHiddenBtn} {\n" "$data(hiddenBtn) configure -state normal\n" "grid $data(hiddenBtn)\n" "} else {\n" "$data(hiddenBtn) configure -state disabled\n" "grid remove $data(hiddenBtn)\n" "}\n" "unset -nocomplain data(extUsed)\n" "if {[winfo viewable [winfo toplevel $data(-parent)]]} {\n" "wm transient $w $data(-parent)\n" "}\n" "trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]\n" "$data(dirMenuBtn) configure \\\n" "\011 -textvariable ::tk::dialog::file::${dataName}(selectPath)\n" "if {[llength $data(-filetypes)]} {\n" "$data(typeMenu) delete 0 end\n" "foreach type $data(-filetypes) {\n" "set title [lindex $type 0]\n" "set filter [lindex $type 1]\n" "$data(typeMenu) add command -label $title \\\n" "\011\011-command [list ::tk::dialog::file::SetFilter $w $type]\n" "}\n" "::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]\n" "$data(typeMenuBtn) configure -state normal\n" "$data(typeMenuLab) configure -state normal\n" "} else {\n" "set data(filter) \"*\"\n" "$data(typeMenuBtn) configure -state disabled -takefocus 0\n" "$data(typeMenuLab) configure -state disabled\n" "}\n" "::tk::dialog::file::UpdateWhenIdle $w\n" "::tk::PlaceWindow $w widget $data(-parent)\n" "wm title $w $data(-title)\n" "::tk::SetFocusGrab $w $data(ent)\n" "$data(ent) delete 0 end\n" "$data(ent) insert 0 $data(selectFile)\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "vwait ::tk::Priv(selectFilePath)\n" "::tk::RestoreFocusGrab $w $data(ent) withdraw\n" "foreach trace [trace info variable data(selectPath)] {\n" "trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]\n" "}\n" "$data(dirMenuBtn) configure -textvariable {}\n" "return $Priv(selectFilePath)\n" "}\n" "proc ::tk::dialog::file::Config {dataName type argList} {\n" "upvar ::tk::dialog::file::$dataName data\n" "set data(type) $type\n" "foreach trace [trace info variable data(selectPath)] {\n" "trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]\n" "}\n" "set specs {\n" "{-defaultextension \"\" \"\" \"\"}\n" "{-filetypes \"\" \"\" \"\"}\n" "{-initialdir \"\" \"\" \"\"}\n" "{-initialfile \"\" \"\" \"\"}\n" "{-parent \"\" \"\" \".\"}\n" "{-title \"\" \"\" \"\"}\n" "}\n" "if { $type eq \"open\" } {\n" "lappend specs {-multiple \"\" \"\" \"0\"}\n" "}\n" "if {![info exists data(selectPath)]} {\n" "set data(selectPath) [pwd]\n" "set data(selectFile) \"\"\n" "}\n" "tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n" "if {$data(-title) eq \"\"} {\n" "if {$type eq \"open\"} {\n" "set data(-title) \"[mc \"Open\"]\"\n" "} else {\n" "set data(-title) \"[mc \"Save As\"]\"\n" "}\n" "}\n" "if {$data(-initialdir) ne \"\"} {\n" "if {[file isdirectory $data(-initialdir)]} {\n" "set old [pwd]\n" "cd $data(-initialdir)\n" "set data(selectPath) [pwd]\n" "cd $old\n" "} else {\n" "set data(selectPath) [pwd]\n" "}\n" "}\n" "set data(selectFile) $data(-initialfile)\n" "set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]\n" "if {![winfo exists $data(-parent)]} {\n" "error \"bad window path name \\\"$data(-parent)\\\"\"\n" "}\n" "if {$type eq \"save\"} {\n" "set data(-multiple) 0\n" "} elseif {$data(-multiple)} { \n" "set data(-multiple) 1 \n" "} else {\n" "set data(-multiple) 0\n" "}\n" "}\n" "proc ::tk::dialog::file::Create {w class} {\n" "set dataName [lindex [split $w .] end]\n" "upvar ::tk::dialog::file::$dataName data\n" "variable ::tk::Priv\n" "global tk_library\n" "toplevel $w -class $class\n" "set f1 [frame $w.f1]\n" "bind [::tk::AmpWidget label $f1.lab -text \"[mc \"&Directory:\"]\" ] \\\n" "\011<> [list focus $f1.menu]\n" "set data(dirMenuBtn) $f1.menu\n" "set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] \"\"]\n" "set data(upBtn) [button $f1.up]\n" "if {![info exists Priv(updirImage)]} {\n" "set Priv(updirImage) [image create bitmap -data {\n" "#define updir_width 28\n" "#define updir_height 16\n" "static char updir_bits[] = {\n" "0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,\n" "0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,\n" "0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,\n" "0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,\n" "0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,\n" "0xf0, 0xff, 0xff, 0x01};}]\n" "}\n" "$data(upBtn) configure -image $Priv(updirImage)\n" "$f1.menu configure -takefocus 1 -highlightthickness 2\n" "pack $data(upBtn) -side right -padx 4 -fill both\n" "pack $f1.lab -side left -padx 4 -fill both\n" "pack $f1.menu -expand yes -fill both -padx 4\n" "if { $class eq \"TkFDialog\" } {\n" "if { $data(-multiple) } {\n" "set fNameCaption [mc \"File &names:\"]\n" "} else {\n" "set fNameCaption [mc \"File &name:\"]\n" "}\n" "set fTypeCaption [mc \"Files of &type:\"]\n" "set iconListCommand [list ::tk::dialog::file::OkCmd $w]\n" "} else {\n" "set fNameCaption [mc \"&Selection:\"]\n" "set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]\n" "}\n" "set data(icons) [::tk::IconList $w.icons \\\n" "\011 -command\011$iconListCommand \\\n" "\011 -multiple\011$data(-multiple)]\n" "bind $data(icons) <> \\\n" "\011 [list ::tk::dialog::file::ListBrowse $w]\n" "set f2 [frame $w.f2 -bd 0]\n" "bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\\\n" "\011 <> [list focus $f2.ent]\n" "set data(ent) [entry $f2.ent]\n" "set ::tk::$w.icons(font) [$data(ent) cget -font]\n" "if { $class eq \"TkFDialog\" } {\n" "set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \\\n" "\011\011-text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]]\n" "set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \\\n" "\011\011-menu $f2.menu.m]\n" "set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]\n" "$data(typeMenuBtn) configure -takefocus 1 -highlightthickness 2 \\\n" "\011\011-relief raised -bd 2 -anchor w\n" "bind $data(typeMenuLab) <> [list \\\n" "\011\011focus $data(typeMenuBtn)]\n" "}\n" "if {$class eq \"TkFDialog\"} {\n" "set text [mc \"Show &Hidden Files and Directories\"]\n" "} else {\n" "set text [mc \"Show &Hidden Directories\"]\n" "}\n" "set data(hiddenBtn) [::tk::AmpWidget checkbutton $f2.hidden \\\n" "\011 -text $text -anchor w -padx 3 -state disabled \\\n" "\011 -variable ::tk::dialog::file::showHiddenVar \\\n" "\011 -command [list ::tk::dialog::file::UpdateWhenIdle $w]]\n" "set data(okBtn) [::tk::AmpWidget button $f2.ok \\\n" "\011 -text [mc \"&OK\"] -default active -pady 3]\n" "bind $data(okBtn) [list ::tk::dialog::file::Destroyed $w]\n" "set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \\\n" "\011 -text [mc \"&Cancel\"] -default normal -pady 3]\n" "grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew\n" "grid configure $f2.ent -padx 2\n" "if { $class eq \"TkFDialog\" } {\n" "grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \\\n" "\011\011-padx 4 -sticky ew\n" "grid configure $data(typeMenuBtn) -padx 0\n" "grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew\n" "} else {\n" "grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew\n" "}\n" "grid columnconfigure $f2 1 -weight 1\n" "pack $f1 -side top -fill x -pady 4\n" "pack $f2 -side bottom -fill x\n" "pack $data(icons) -expand yes -fill both -padx 4 -pady 1\n" "wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]\n" "$data(upBtn) configure -command [list ::tk::dialog::file::UpDirCmd $w]\n" "$data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]\n" "bind $w [list tk::ButtonInvoke $data(cancelBtn)]\n" "bind $w [list tk::AltKeyInDialog $w %A]\n" "if { $class eq \"TkFDialog\" } {\n" "bind $data(ent) [list ::tk::dialog::file::ActivateEnt $w]\n" "$data(okBtn) configure -command [list ::tk::dialog::file::OkCmd $w]\n" "bind $w [format {\n" "if {[%s cget -state] eq \"normal\"} {\n" "focus %s\n" "}\n" "} $data(typeMenuBtn) $data(typeMenuBtn)]\n" "} else {\n" "set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]\n" "bind $data(ent) $okCmd\n" "$data(okBtn) configure -command $okCmd\n" "bind $w [list focus $data(ent)]\n" "bind $w [list tk::ButtonInvoke $data(okBtn)]\n" "}\n" "bind $w [list $data(hiddenBtn) invoke]\n" "::tk::FocusGroup_Create $w\n" "::tk::FocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w]\n" "::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]\n" "}\n" "proc ::tk::dialog::file::SetSelectMode {w multi} {\n" "set dataName __tk_filedialog\n" "upvar ::tk::dialog::file::$dataName data\n" "if { $multi } {\n" "set fNameCaption \"[mc {File &names:}]\"\n" "} else {\n" "set fNameCaption \"[mc {File &name:}]\"\n" "}\n" "set iconListCommand [list ::tk::dialog::file::OkCmd $w]\n" "::tk::SetAmpText $w.f2.lab $fNameCaption \n" "::tk::IconList_Config $data(icons) \\\n" "\011 [list -multiple $multi -command $iconListCommand]\n" "return\n" "}\n" "proc ::tk::dialog::file::UpdateWhenIdle {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {[info exists data(updateId)]} {\n" "return\n" "} else {\n" "set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]\n" "}\n" "}\n" "proc ::tk::dialog::file::Update {w} {\n" "if {![winfo exists $w]} {\n" "return\n" "}\n" "set class [winfo class $w]\n" "if {($class ne \"TkFDialog\") && ($class ne \"TkChooseDir\")} {\n" "return\n" "}\n" "set dataName [winfo name $w]\n" "upvar ::tk::dialog::file::$dataName data\n" "variable ::tk::Priv\n" "global tk_library\n" "unset -nocomplain data(updateId)\n" "if {![info exists Priv(folderImage)]} {\n" "set Priv(folderImage) [image create photo -data {\n" "R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB\n" "QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]\n" "set Priv(fileImage) [image create photo -data {\n" "R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO\n" "rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]\n" "}\n" "set folder $Priv(folderImage)\n" "set file $Priv(fileImage)\n" "set appPWD [pwd]\n" "if {[catch {\n" "cd $data(selectPath)\n" "}]} {\n" "tk_messageBox -type ok -parent $w -icon warning -message \\\n" "\011 [mc \"Cannot change to the directory \\\"%1\\$s\\\".\\nPermission denied.\" $data(selectPath)]\n" "cd $appPWD\n" "return\n" "}\n" "set entCursor [$data(ent) cget -cursor]\n" "set dlgCursor [$w cget -cursor]\n" "$data(ent) configure -cursor watch\n" "$w configure -cursor watch\n" "update idletasks\n" "::tk::IconList_DeleteAll $data(icons)\n" "set showHidden $::tk::dialog::file::showHiddenVar\n" "set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]\n" "if {$showHidden} { lappend cmd .* }\n" "set dirs [lsort -dictionary -unique [eval $cmd]]\n" "set dirList {}\n" "foreach d $dirs {\n" "if {$d eq \".\" || $d eq \"..\"} {\n" "continue\n" "}\n" "lappend dirList $d\n" "}\n" "::tk::IconList_Add $data(icons) $folder $dirList\n" "if {$class eq \"TkFDialog\"} {\n" "set cmd [list glob -tails -directory [pwd] \\\n" "\011\011 -type {f b c l p s} -nocomplain]\n" "if {$data(filter) eq \"*\"} {\n" "lappend cmd *\n" "if {$showHidden} { lappend cmd .* }\n" "} else {\n" "eval [list lappend cmd] $data(filter)\n" "}\n" "set fileList [lsort -dictionary -unique [eval $cmd]]\n" "::tk::IconList_Add $data(icons) $file $fileList\n" "}\n" "::tk::IconList_Arrange $data(icons)\n" "set list \"\"\n" "set dir \"\"\n" "foreach subdir [file split $data(selectPath)] {\n" "set dir [file join $dir $subdir]\n" "lappend list $dir\n" "}\n" "$data(dirMenu) delete 0 end\n" "set var [format %s(selectPath) ::tk::dialog::file::$dataName]\n" "foreach path $list {\n" "$data(dirMenu) add command -label $path -command [list set $var $path]\n" "}\n" "cd $appPWD\n" "if { $class eq \"TkFDialog\" } {\n" "if {$data(type) eq \"open\"} {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Open\"]\n" "} else {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Save\"]\n" "}\n" "}\n" "$data(ent) configure -cursor $entCursor\n" "$w configure -cursor $dlgCursor\n" "}\n" "proc ::tk::dialog::file::SetPathSilently {w path} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]\n" "set data(selectPath) $path\n" "trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]\n" "}\n" "proc ::tk::dialog::file::SetPath {w name1 name2 op} {\n" "if {[winfo exists $w]} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "::tk::dialog::file::UpdateWhenIdle $w\n" "if { [winfo class $w] eq \"TkChooseDir\" } {\n" "$data(ent) delete 0 end\n" "$data(ent) insert end $data(selectPath)\n" "}\n" "}\n" "}\n" "proc ::tk::dialog::file::SetFilter {w type} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "upvar ::tk::$data(icons) icons\n" "set data(filter) [lindex $type 1]\n" "$data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1\n" "if {![info exists data(extUsed)]} {\n" "if {[string length $data(-defaultextension)]} {\n" "set data(extUsed) 1\n" "} else {\n" "set data(extUsed) 0\n" "}\n" "}\n" "if {!$data(extUsed)} {\n" "set index [lsearch -regexp $data(filter) {^\\*\\.\\w+$}]\n" "if {$index >= 0} {\n" "set data(-defaultextension) \\\n" "\011\011 [string trimleft [lindex $data(filter) $index] \"*\"]\n" "} else {\n" "set data(-defaultextension) \"\"\n" "}\n" "}\n" "$icons(sbar) set 0.0 0.0\n" "::tk::dialog::file::UpdateWhenIdle $w\n" "}\n" "proc ::tk::dialog::file::ResolveFile {context text defaultext} {\n" "set appPWD [pwd]\n" "set path [::tk::dialog::file::JoinFile $context $text]\n" "if {![file isdirectory $path] && [file ext $path] eq \"\"} {\n" "set path \"$path$defaultext\"\n" "}\n" "if {[catch {file exists $path}]} {\n" "return [list ERROR $path \"\"]\n" "}\n" "if {[file exists $path]} {\n" "if {[file isdirectory $path]} {\n" "if {[catch {cd $path}]} {\n" "return [list CHDIR $path \"\"]\n" "}\n" "set directory [pwd]\n" "set file \"\"\n" "set flag OK\n" "cd $appPWD\n" "} else {\n" "if {[catch {cd [file dirname $path]}]} {\n" "return [list CHDIR [file dirname $path] \"\"]\n" "}\n" "set directory [pwd]\n" "set file [file tail $path]\n" "set flag OK\n" "cd $appPWD\n" "}\n" "} else {\n" "set dirname [file dirname $path]\n" "if {[file exists $dirname]} {\n" "if {[catch {cd $dirname}]} {\n" "return [list CHDIR $dirname \"\"]\n" "}\n" "set directory [pwd]\n" "set file [file tail $path]\n" "if {[regexp {[*]|[?]} $file]} {\n" "set flag PATTERN\n" "} else {\n" "set flag FILE\n" "}\n" "cd $appPWD\n" "} else {\n" "set directory $dirname\n" "set file [file tail $path]\n" "set flag PATH\n" "}\n" "}\n" "return [list $flag $directory $file]\n" "}\n" "proc ::tk::dialog::file::EntFocusIn {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {[$data(ent) get] ne \"\"} {\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "} else {\n" "$data(ent) selection clear\n" "}\n" "if { [winfo class $w] eq \"TkFDialog\" } {\n" "if {$data(type) eq \"open\"} {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Open\"]\n" "} else {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Save\"]\n" "}\n" "}\n" "}\n" "proc ::tk::dialog::file::EntFocusOut {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "$data(ent) selection clear\n" "}\n" "proc ::tk::dialog::file::ActivateEnt {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set text [$data(ent) get]\n" "if {$data(-multiple)} {\n" "set selIcos [::tk::IconList_Curselection $data(icons)]\n" "set data(selectFile) \"\"\n" "if {[llength $selIcos] == 0 && $text ne \"\"} {\n" "::tk::dialog::file::VerifyFileName $w $text\n" "} else {\n" "foreach item $selIcos {\n" "::tk::dialog::file::VerifyFileName $w \\\n" "\011\011 [::tk::IconList_Get $data(icons) $item]\n" "}\n" "}\n" "} else {\n" "::tk::dialog::file::VerifyFileName $w $text\n" "}\n" "}\n" "proc ::tk::dialog::file::VerifyFileName {w filename} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \\\n" "\011 $data(-defaultextension)]\n" "foreach {flag path file} $list {\n" "break\n" "}\n" "switch -- $flag {\n" "OK {\n" "if {$file eq \"\"} {\n" "set data(selectPath) $path\n" "$data(ent) delete 0 end\n" "} else {\n" "::tk::dialog::file::SetPathSilently $w $path\n" "if {$data(-multiple)} {\n" "lappend data(selectFile) $file\n" "} else {\n" "set data(selectFile) $file\n" "}\n" "::tk::dialog::file::Done $w\n" "}\n" "}\n" "PATTERN {\n" "set data(selectPath) $path\n" "set data(filter) $file\n" "}\n" "FILE {\n" "if {$data(type) eq \"open\"} {\n" "tk_messageBox -icon warning -type ok -parent $w \\\n" "\011\011 -message \"[mc \"File \\\"%1\\$s\\\" does not exist.\" [file join $path $file]]\"\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "} else {\n" "::tk::dialog::file::SetPathSilently $w $path\n" "if {$data(-multiple)} {\n" "lappend data(selectFile) $file\n" "} else {\n" "set data(selectFile) $file\n" "}\n" "::tk::dialog::file::Done $w\n" "}\n" "}\n" "PATH {\n" "tk_messageBox -icon warning -type ok -parent $w \\\n" "\011\011-message \"[mc \"Directory \\\"%1\\$s\\\" does not exist.\" $path]\"\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "}\n" "CHDIR {\n" "tk_messageBox -type ok -parent $w -message \\\n" "\011 \"[mc \"Cannot change to the directory \\\"%1\\$s\\\".\\nPermission denied.\" $path]\"\\\n" "\011\011-icon warning\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "}\n" "ERROR {\n" "tk_messageBox -type ok -parent $w -message \\\n" "\011 \"[mc \"Invalid file name \\\"%1\\$s\\\".\" $path]\"\\\n" "\011\011-icon warning\n" "$data(ent) selection range 0 end\n" "$data(ent) icursor end\n" "}\n" "}\n" "}\n" "proc ::tk::dialog::file::InvokeBtn {w key} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {[$data(okBtn) cget -text] eq $key} {\n" "::tk::ButtonInvoke $data(okBtn)\n" "}\n" "}\n" "proc ::tk::dialog::file::UpDirCmd {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {$data(selectPath) ne \"/\"} {\n" "set data(selectPath) [file dirname $data(selectPath)]\n" "}\n" "}\n" "proc ::tk::dialog::file::JoinFile {path file} {\n" "if {[string match {~*} $file] && [file exists $path/$file]} {\n" "return [file join $path ./$file]\n" "} else {\n" "return [file join $path $file]\n" "}\n" "}\n" "proc ::tk::dialog::file::OkCmd {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set filenames {}\n" "foreach item [::tk::IconList_Curselection $data(icons)] {\n" "lappend filenames [::tk::IconList_Get $data(icons) $item]\n" "}\n" "if {([llength $filenames] && !$data(-multiple)) || \\\n" "\011 ($data(-multiple) && ([llength $filenames] == 1))} {\n" "set filename [lindex $filenames 0]\n" "set file [::tk::dialog::file::JoinFile $data(selectPath) $filename]\n" "if {[file isdirectory $file]} {\n" "::tk::dialog::file::ListInvoke $w [list $filename]\n" "return\n" "}\n" "}\n" "::tk::dialog::file::ActivateEnt $w\n" "}\n" "proc ::tk::dialog::file::CancelCmd {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "variable ::tk::Priv\n" "bind $data(okBtn) {}\n" "set Priv(selectFilePath) \"\"\n" "}\n" "proc ::tk::dialog::file::Destroyed {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "variable ::tk::Priv\n" "set Priv(selectFilePath) \"\"\n" "}\n" "proc ::tk::dialog::file::ListBrowse {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set text {}\n" "foreach item [::tk::IconList_Curselection $data(icons)] {\n" "lappend text [::tk::IconList_Get $data(icons) $item]\n" "}\n" "if {[llength $text] == 0} {\n" "return\n" "}\n" "if { [llength $text] > 1 } {\n" "set newtext {}\n" "foreach file $text {\n" "set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file]\n" "if { ![file isdirectory $fullfile] } {\n" "lappend newtext $file\n" "}\n" "}\n" "set text $newtext\n" "set isDir 0\n" "} else {\n" "set text [lindex $text 0]\n" "set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n" "set isDir [file isdirectory $file]\n" "}\n" "if {!$isDir} {\n" "$data(ent) delete 0 end\n" "$data(ent) insert 0 $text\n" "if { [winfo class $w] eq \"TkFDialog\" } {\n" "if {$data(type) eq \"open\"} {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Open\"]\n" "} else {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Save\"]\n" "}\n" "}\n" "} else {\n" "if { [winfo class $w] eq \"TkFDialog\" } {\n" "::tk::SetAmpText $data(okBtn) [mc \"&Open\"]\n" "}\n" "}\n" "}\n" "proc ::tk::dialog::file::ListInvoke {w filenames} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {[llength $filenames] == 0} {\n" "return\n" "}\n" "set file [::tk::dialog::file::JoinFile $data(selectPath) \\\n" "\011 [lindex $filenames 0]]\n" "set class [winfo class $w]\n" "if {$class eq \"TkChooseDir\" || [file isdirectory $file]} {\n" "set appPWD [pwd]\n" "if {[catch {cd $file}]} {\n" "tk_messageBox -type ok -parent $w -message \\\n" "\011 \"[mc \"Cannot change to the directory \\\"%1\\$s\\\".\\nPermission denied.\" $file]\"\\\n" "\011\011-icon warning\n" "} else {\n" "cd $appPWD\n" "set data(selectPath) $file\n" "}\n" "} else {\n" "if {$data(-multiple)} {\n" "set data(selectFile) $filenames\n" "} else {\n" "set data(selectFile) $file\n" "}\n" "::tk::dialog::file::Done $w\n" "}\n" "}\n" "proc ::tk::dialog::file::Done {w {selectFilePath \"\"}} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "variable ::tk::Priv\n" "if {$selectFilePath eq \"\"} {\n" "if {$data(-multiple)} {\n" "set selectFilePath {}\n" "foreach f $data(selectFile) {\n" "lappend selectFilePath [::tk::dialog::file::JoinFile \\\n" "\011\011 $data(selectPath) $f]\n" "}\n" "} else {\n" "set selectFilePath [::tk::dialog::file::JoinFile \\\n" "\011\011 $data(selectPath) $data(selectFile)]\n" "}\n" "set Priv(selectFile) $data(selectFile)\n" "set Priv(selectPath) $data(selectPath)\n" "if {$data(type) eq \"save\"} {\n" "if {[file exists $selectFilePath]} {\n" "set reply [tk_messageBox -icon warning -type yesno\\\n" "\011\011 -parent $w -message \\\n" "\011\011\011\"[mc \"File \\\"%1\\$s\\\" already exists.\\nDo you want to overwrite it?\" $selectFilePath]\"]\n" "if {$reply eq \"no\"} {\n" "return\n" "}\n" "}\n" "}\n" "}\n" "bind $data(okBtn) {}\n" "set Priv(selectFilePath) $selectFilePath\n" "}\n" ; static unsigned char Et_zFile36[] = "namespace eval ::tk::unsupported {\n" "variable PrivateCommands \n" "array set PrivateCommands {\n" "tkButtonAutoInvoke\011\011::tk::ButtonAutoInvoke\n" "tkButtonDown\011\011\011::tk::ButtonDown\n" "tkButtonEnter\011\011\011::tk::ButtonEnter\n" "tkButtonInvoke\011\011\011::tk::ButtonInvoke\n" "tkButtonLeave\011\011\011::tk::ButtonLeave\n" "tkButtonUp\011\011\011::tk::ButtonUp\n" "tkCancelRepeat\011\011\011::tk::CancelRepeat\n" "tkCheckRadioDown\011\011::tk::CheckRadioDown\n" "tkCheckRadioEnter\011\011::tk::CheckRadioEnter\n" "tkCheckRadioInvoke\011\011::tk::CheckRadioInvoke\n" "tkColorDialog\011\011\011::tk::dialog::color::\n" "tkColorDialog_BuildDialog\011::tk::dialog::color::BuildDialog\n" "tkColorDialog_CancelCmd\011\011::tk::dialog::color::CancelCmd\n" "tkColorDialog_Config\011\011::tk::dialog::color::Config\n" "tkColorDialog_CreateSelector\011::tk::dialog::color::CreateSelector\n" "tkColorDialog_DrawColorScale\011::tk::dialog::color::DrawColorScale\n" "tkColorDialog_EnterColorBar\011::tk::dialog::color::EnterColorBar\n" "tkColorDialog_InitValues\011::tk::dialog::color::InitValues\n" "tkColorDialog_HandleRGBEntry\011::tk::dialog::color::HandleRGBEntry\n" "tkColorDialog_HandleSelEntry\011::tk::dialog::color::HandleSelEntry\n" "tkColorDialog_LeaveColorBar\011::tk::dialog::color::LeaveColorBar\n" "tkColorDialog_MoveSelector\011::tk::dialog::color::MoveSelector\n" "tkColorDialog_OkCmd\011\011::tk::dialog::color::OkCmd\n" "tkColorDialog_RedrawColorBars\011::tk::dialog::color::RedrawColorBars\n" "tkColorDialog_RedrawFinalColor\011::tk::dialog::color::RedrawFinalColor\n" "tkColorDialog_ReleaseMouse\011::tk::dialog::color::ReleaseMouse\n" "tkColorDialog_ResizeColorBars\011::tk::dialog::color::ResizeColorBars\n" "tkColorDialog_RgbToX\011\011::tk::dialog::color::RgbToX\n" "tkColorDialog_SetRGBValue\011::tk::dialog::color::SetRGBValue\n" "tkColorDialog_StartMove\011\011::tk::dialog::color::StartMove\n" "tkColorDialog_XToRgb\011\011::tk::dialog::color::XToRGB\n" "tkConsoleAbout\011\011\011::tk::ConsoleAbout\n" "tkConsoleBind\011\011\011::tk::ConsoleBind\n" "tkConsoleExit\011\011\011::tk::ConsoleExit\n" "tkConsoleHistory\011\011::tk::ConsoleHistory\n" "tkConsoleInit\011\011\011::tk::ConsoleInit\n" "tkConsoleInsert\011\011\011::tk::ConsoleInsert\n" "tkConsoleInvoke\011\011\011::tk::ConsoleInvoke\n" "tkConsoleOutput\011\011\011::tk::ConsoleOutput\n" "tkConsolePrompt\011\011\011::tk::ConsolePrompt\n" "tkConsoleSource\011\011\011::tk::ConsoleSource\n" "tkDarken\011\011\011::tk::Darken\n" "tkEntryAutoScan\011\011\011::tk::EntryAutoScan\n" "tkEntryBackspace\011\011::tk::EntryBackspace\n" "tkEntryButton1\011\011\011::tk::EntryButton1\n" "tkEntryClosestGap\011\011::tk::EntryClosestGap\n" "tkEntryGetSelection\011\011::tk::EntryGetSelection\n" "tkEntryInsert\011\011\011::tk::EntryInsert\n" "tkEntryKeySelect\011\011::tk::EntryKeySelect\n" "tkEntryMouseSelect\011\011::tk::EntryMouseSelect\n" "tkEntryNextWord\011\011\011::tk::EntryNextWord\n" "tkEntryPaste\011\011\011::tk::EntryPaste\n" "tkEntryPreviousWord\011\011::tk::EntryPreviousWord\n" "tkEntrySeeInsert\011\011::tk::EntrySeeInsert\n" "tkEntrySetCursor\011\011::tk::EntrySetCursor\n" "tkEntryTranspose\011\011::tk::EntryTranspose\n" "tkEventMotifBindings\011\011::tk::EventMotifBindings\n" "tkFDGetFileTypes\011\011::tk::FDGetFileTypes\n" "tkFirstMenu\011\011\011::tk::FirstMenu\n" "tkFocusGroup_BindIn\011\011::tk::FocusGroup_BindIn\n" "tkFocusGroup_BindOut\011\011::tk::FocusGroup_BindOut\n" "tkFocusGroup_Create\011\011::tk::FocusGroup_Create\n" "tkFocusGroup_Destroy\011\011::tk::FocusGroup_Destroy\n" "tkFocusGroup_In\011\011\011::tk::FocusGroup_In\n" "tkFocusGroup_Out\011\011::tk::FocusGroup_Out\n" "tkFocusOK\011\011\011::tk::FocusOK\n" "tkGenerateMenuSelect\011\011::tk::GenerateMenuSelect\n" "tkIconList\011\011\011::tk::IconList\n" "tkIconList_Add\011\011\011::tk::IconList_Add\n" "tkIconList_Arrange\011\011::tk::IconList_Arrange\n" "tkIconList_AutoScan\011\011::tk::IconList_AutoScan\n" "tkIconList_Btn1\011\011\011::tk::IconList_Btn1\n" "tkIconList_Config\011\011::tk::IconList_Config\n" "tkIconList_Create\011\011::tk::IconList_Create\n" "tkIconList_CtrlBtn1\011\011::tk::IconList_CtrlBtn1\n" "tkIconList_Curselection\011\011::tk::IconList_Curselection\n" "tkIconList_DeleteAll\011\011::tk::IconList_DeleteAll\n" "tkIconList_Double1\011\011::tk::IconList_Double1\n" "tkIconList_DrawSelection\011::tk::IconList_DrawSelection\n" "tkIconList_FocusIn\011\011::tk::IconList_FocusIn\n" "tkIconList_FocusOut\011\011::tk::IconList_FocusOut\n" "tkIconList_Get\011\011\011::tk::IconList_Get\n" "tkIconList_Goto\011\011\011::tk::IconList_Goto\n" "tkIconList_Index\011\011::tk::IconList_Index\n" "tkIconList_Invoke\011\011::tk::IconList_Invoke\n" "tkIconList_KeyPress\011\011::tk::IconList_KeyPress\n" "tkIconList_Leave1\011\011::tk::IconList_Leave1\n" "tkIconList_LeftRight\011\011::tk::IconList_LeftRight\n" "tkIconList_Motion1\011\011::tk::IconList_Motion1\n" "tkIconList_Reset\011\011::tk::IconList_Reset\n" "tkIconList_ReturnKey\011\011::tk::IconList_ReturnKey\n" "tkIconList_See\011\011\011::tk::IconList_See\n" "tkIconList_Select\011\011::tk::IconList_Select\n" "tkIconList_Selection\011\011::tk::IconList_Selection\n" "tkIconList_ShiftBtn1\011\011::tk::IconList_ShiftBtn1\n" "tkIconList_UpDown\011\011::tk::IconList_UpDown\n" "tkListbox\011\011\011::tk::Listbox\n" "tkListboxAutoScan\011\011::tk::ListboxAutoScan\n" "tkListboxBeginExtend\011\011::tk::ListboxBeginExtend\n" "tkListboxBeginSelect\011\011::tk::ListboxBeginSelect\n" "tkListboxBeginToggle\011\011::tk::ListboxBeginToggle\n" "tkListboxCancel\011\011\011::tk::ListboxCancel\n" "tkListboxDataExtend\011\011::tk::ListboxDataExtend\n" "tkListboxExtendUpDown\011\011::tk::ListboxExtendUpDown\n" "tkListboxKeyAccel_Goto\011\011::tk::ListboxKeyAccel_Goto\n" "tkListboxKeyAccel_Key\011\011::tk::ListboxKeyAccel_Key\n" "tkListboxKeyAccel_Reset\011\011::tk::ListboxKeyAccel_Reset\n" "tkListboxKeyAccel_Set\011\011::tk::ListboxKeyAccel_Set\n" "tkListboxKeyAccel_Unset\011\011::tk::ListboxKeyAccel_Unxet\n" "tkListboxMotion\011\011\011::tk::ListboxMotion\n" "tkListboxSelectAll\011\011::tk::ListboxSelectAll\n" "tkListboxUpDown\011\011\011::tk::ListboxUpDown\n" "tkListboxBeginToggle\011\011::tk::ListboxBeginToggle\n" "tkMbButtonUp\011\011\011::tk::MbButtonUp\n" "tkMbEnter\011\011\011::tk::MbEnter\n" "tkMbLeave\011\011\011::tk::MbLeave\n" "tkMbMotion\011\011\011::tk::MbMotion\n" "tkMbPost\011\011\011::tk::MbPost\n" "tkMenuButtonDown\011\011::tk::MenuButtonDown\n" "tkMenuDownArrow\011\011\011::tk::MenuDownArrow\n" "tkMenuDup\011\011\011::tk::MenuDup\n" "tkMenuEscape\011\011\011::tk::MenuEscape\n" "tkMenuFind\011\011\011::tk::MenuFind\n" "tkMenuFindName\011\011\011::tk::MenuFindName\n" "tkMenuFirstEntry\011\011::tk::MenuFirstEntry\n" "tkMenuInvoke\011\011\011::tk::MenuInvoke\n" "tkMenuLeave\011\011\011::tk::MenuLeave\n" "tkMenuLeftArrow\011\011\011::tk::MenuLeftArrow\n" "tkMenuMotion\011\011\011::tk::MenuMotion\n" "tkMenuNextEntry\011\011\011::tk::MenuNextEntry\n" "tkMenuNextMenu\011\011\011::tk::MenuNextMenu\n" "tkMenuRightArrow\011\011::tk::MenuRightArrow\n" "tkMenuUnpost\011\011\011::tk::MenuUnpost\n" "tkMenuUpArrow\011\011\011::tk::MenuUpArrow\n" "tkMessageBox\011\011\011::tk::MessageBox\n" "tkMotifFDialog\011\011\011::tk::MotifFDialog\n" "tkMotifFDialog_ActivateDList\011::tk::MotifFDialog_ActivateDList\n" "tkMotifFDialog_ActivateFList\011::tk::MotifFDialog_ActivateFList\n" "tkMotifFDialog_ActivateFEnt\011::tk::MotifFDialog_ActivateFEnt\n" "tkMotifFDialog_ActivateSEnt\011::tk::MotifFDialog_ActivateSEnt\n" "tkMotifFDialog\011\011\011::tk::MotifFDialog\n" "tkMotifFDialog_BrowseDList\011::tk::MotifFDialog_BrowseDList\n" "tkMotifFDialog_BrowseFList\011::tk::MotifFDialog_BrowseFList\n" "tkMotifFDialog_BuildUI\011\011::tk::MotifFDialog_BuildUI\n" "tkMotifFDialog_CancelCmd\011::tk::MotifFDialog_CancelCmd\n" "tkMotifFDialog_Config\011\011::tk::MotifFDialog_Config\n" "tkMotifFDialog_Create\011\011::tk::MotifFDialog_Create\n" "tkMotifFDialog_FileTypes\011::tk::MotifFDialog_FileTypes\n" "tkMotifFDialog_FilterCmd\011::tk::MotifFDialog_FilterCmd\n" "tkMotifFDialog_InterpFilter\011::tk::MotifFDialog_InterpFilter\n" "tkMotifFDialog_LoadFiles\011::tk::MotifFDialog_LoadFiles\n" "tkMotifFDialog_MakeSList\011::tk::MotifFDialog_MakeSList\n" "tkMotifFDialog_OkCmd\011\011::tk::MotifFDialog_OkCmd\n" "tkMotifFDialog_SetFilter\011::tk::MotifFDialog_SetFilter\n" "tkMotifFDialog_SetListMode\011::tk::MotifFDialog_SetListMode\n" "tkMotifFDialog_Update\011\011::tk::MotifFDialog_Update\n" "tkPostOverPoint\011\011\011::tk::PostOverPoint\n" "tkRecolorTree\011\011\011::tk::RecolorTree\n" "tkRestoreOldGrab\011\011::tk::RestoreOldGrab\n" "tkSaveGrabInfo\011\011\011::tk::SaveGrabInfo\n" "tkScaleActivate\011\011\011::tk::ScaleActivate\n" "tkScaleButtonDown\011\011::tk::ScaleButtonDown\n" "tkScaleButton2Down\011\011::tk::ScaleButton2Down\n" "tkScaleControlPress\011\011::tk::ScaleControlPress\n" "tkScaleDrag\011\011\011::tk::ScaleDrag\n" "tkScaleEndDrag\011\011\011::tk::ScaleEndDrag\n" "tkScaleIncrement\011\011::tk::ScaleIncrement\n" "tkScreenChanged\011\011\011::tk::ScreenChanged\n" "tkScrollButtonDown\011\011::tk::ScrollButtonDown\n" "tkScrollButton2Down\011\011::tk::ScrollButton2Down\n" "tkScrollButtonDrag\011\011::tk::ScrollButtonDrag\n" "tkScrollButtonUp\011\011::tk::ScrollButtonUp\n" "tkScrollByPages\011\011\011::tk::ScrollByPages\n" "tkScrollByUnits\011\011\011::tk::ScrollByUnits\n" "tkScrollEndDrag\011\011\011::tk::ScrollEndDrag\n" "tkScrollSelect\011\011\011::tk::ScrollSelect\n" "tkScrollStartDrag\011\011::tk::ScrollStartDrag\n" "tkScrollTopBottom\011\011::tk::ScrollTopBottom\n" "tkScrollToPos\011\011\011::tk::ScrollToPos\n" "tkTabToWindow\011\011\011::tk::TabToWindow\n" "tkTearOffMenu\011\011\011::tk::TearOffMenu\n" "tkTextAutoScan\011\011\011::tk::TextAutoScan\n" "tkTextButton1\011\011\011::tk::TextButton1\n" "tkTextClosestGap\011\011::tk::TextClosestGap\n" "tkTextInsert\011\011\011::tk::TextInsert\n" "tkTextKeyExtend\011\011\011::tk::TextKeyExtend\n" "tkTextKeySelect\011\011\011::tk::TextKeySelect\n" "tkTextNextPara\011\011\011::tk::TextNextPara\n" "tkTextNextPos\011\011\011::tk::TextNextPos\n" "tkTextNextWord\011\011\011::tk::TextNextWord\n" "tkTextPaste\011\011\011::tk::TextPaste\n" "tkTextPrevPara\011\011\011::tk::TextPrevPara\n" "tkTextPrevPos\011\011\011::tk::TextPrevPos\n" "tkTextPrevWord\011\011\011::tk::TextPrevWord\n" "tkTextResetAnchor\011\011::tk::TextResetAnchor\n" "tkTextScrollPages\011\011::tk::TextScrollPages\n" "tkTextSelectTo\011\011\011::tk::TextSelectTo\n" "tkTextSetCursor\011\011\011::tk::TextSetCursor\n" "tkTextTranspose\011\011\011::tk::TextTranspose\n" "tkTextUpDownLine\011\011::tk::TextUpDownLine\n" "tkTraverseToMenu\011\011::tk::TraverseToMenu\n" "tkTraverseWithinMenu\011\011::tk::TraverseWithinMenu\n" "unsupported1\011\011\011::tk::unsupported::MacWindowStyle\n" "}\n" "variable PrivateVariables\n" "array set PrivateVariables {\n" "droped_to_start\011\011::tk::mac::Droped_to_start\n" "histNum\011\011\011::tk::HistNum\n" "stub_location\011\011::tk::mac::Stub_location\n" "tkFocusIn\011\011::tk::FocusIn\n" "tkFocusOut\011\011::tk::FocusOut\n" "tkPalette\011\011::tk::Palette\n" "tkPriv\011\011\011::tk::Priv\n" "tkPrivMsgBox\011\011::tk::PrivMsgBox\n" "}\n" "}\n" "proc ::tk::unsupported::ExposePrivateCommand {cmd} {\n" "variable PrivateCommands\n" "set cmds [array get PrivateCommands $cmd]\n" "if {[llength $cmds] == 0} {\n" "return -code error \"No compatibility support for \\[$cmd]\"\n" "}\n" "foreach {old new} $cmds {\n" "namespace eval :: [list interp alias {} $old {}] $new\n" "}\n" "}\n" "proc ::tk::unsupported::ExposePrivateVariable {var} {\n" "variable PrivateVariables\n" "set vars [array get PrivateVariables $var]\n" "if {[llength $vars] == 0} {\n" "return -code error \"No compatibility support for \\$$var\"\n" "}\n" "namespace eval ::tk::mac {}\n" "foreach {old new} $vars {\n" "namespace eval :: [list upvar \"#0\" $new $old]\n" "}\n" "}\n" ; static unsigned char Et_zFile37[] = "namespace eval ::tk::dialog {}\n" "namespace eval ::tk::dialog::file {}\n" "proc ::tk::MotifFDialog {type args} {\n" "variable ::tk::Priv\n" "set dataName __tk_filedialog\n" "upvar ::tk::dialog::file::$dataName data\n" "set w [MotifFDialog_Create $dataName $type $args]\n" "::tk::SetFocusGrab $w $data(sEnt)\n" "$data(sEnt) selection range 0 end\n" "vwait ::tk::Priv(selectFilePath)\n" "set result $Priv(selectFilePath)\n" "::tk::RestoreFocusGrab $w $data(sEnt) withdraw\n" "return $result\n" "}\n" "proc ::tk::MotifFDialog_Create {dataName type argList} {\n" "upvar ::tk::dialog::file::$dataName data\n" "MotifFDialog_Config $dataName $type $argList\n" "if {$data(-parent) eq \".\"} {\n" "set w .$dataName\n" "} else {\n" "set w $data(-parent).$dataName\n" "}\n" "if {![winfo exists $w]} {\n" "MotifFDialog_BuildUI $w\n" "} elseif {[winfo class $w] ne \"TkMotifFDialog\"} {\n" "destroy $w\n" "MotifFDialog_BuildUI $w\n" "} else {\n" "set data(fEnt) $w.top.f1.ent\n" "set data(dList) $w.top.f2.a.l\n" "set data(fList) $w.top.f2.b.l\n" "set data(sEnt) $w.top.f3.ent\n" "set data(okBtn) $w.bot.ok\n" "set data(filterBtn) $w.bot.filter\n" "set data(cancelBtn) $w.bot.cancel\n" "}\n" "MotifFDialog_SetListMode $w\n" "if {[winfo viewable [winfo toplevel $data(-parent)]] } {\n" "wm transient $w $data(-parent)\n" "}\n" "MotifFDialog_FileTypes $w\n" "MotifFDialog_Update $w\n" "::tk::PlaceWindow $w\n" "wm title $w $data(-title)\n" "return $w\n" "}\n" "proc ::tk::MotifFDialog_FileTypes {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set f $w.top.f3.types\n" "destroy $f\n" "if {$data(-filetypes) eq \"\"} {\n" "set data(filter) *\n" "return\n" "}\n" "set data(fileType) 0\n" "MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]\n" "#don't produce radiobuttons for only one filetype\n" "if {[llength $data(-filetypes)] == 1} {\n" "return\n" "}\n" "frame $f\n" "set cnt 0\n" "if {$data(-filetypes) ne \"\"} {\n" "foreach type $data(-filetypes) {\n" "set title [lindex [lindex $type 0] 0]\n" "set filter [lindex $type 1]\n" "radiobutton $f.b$cnt \\\n" "\011\011-text $title \\\n" "\011\011-variable ::tk::dialog::file::[winfo name $w](fileType) \\\n" "\011\011-value $cnt \\\n" "\011\011-command \"[list tk::MotifFDialog_SetFilter $w $type]\"\n" "pack $f.b$cnt -side left\n" "incr cnt\n" "}\n" "}\n" "$f.b$data(fileType) invoke\n" "pack $f -side bottom -fill both\n" "return\n" "}\n" "proc ::tk::MotifFDialog_SetFilter {w type} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "variable ::tk::Priv\n" "set data(filter) [lindex $type 1]\n" "set Priv(selectFileType) [lindex [lindex $type 0] 0]\n" "MotifFDialog_Update $w\n" "}\n" "proc ::tk::MotifFDialog_Config {dataName type argList} {\n" "upvar ::tk::dialog::file::$dataName data\n" "set data(type) $type\n" "set specs {\n" "{-defaultextension \"\" \"\" \"\"}\n" "{-filetypes \"\" \"\" \"\"}\n" "{-initialdir \"\" \"\" \"\"}\n" "{-initialfile \"\" \"\" \"\"}\n" "{-parent \"\" \"\" \".\"}\n" "{-title \"\" \"\" \"\"}\n" "}\n" "if { $type eq \"open\" } {\n" "lappend specs {-multiple \"\" \"\" \"0\"}\n" "}\n" "set data(-multiple) 0\n" "if {![info exists data(selectPath)]} {\n" "set data(selectPath) [pwd]\n" "set data(selectFile) \"\"\n" "}\n" "tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n" "if {$data(-title) eq \"\"} {\n" "if {$type eq \"open\"} {\n" "if {$data(-multiple) != 0} {\n" "set data(-title) \"[mc {Open Multiple Files}]\"\n" "} else {\n" "set data(-title) [mc \"Open\"]\n" "}\n" "} else {\n" "set data(-title) [mc \"Save As\"]\n" "}\n" "}\n" "if {$data(-initialdir) ne \"\"} {\n" "if {[file isdirectory $data(-initialdir)]} {\n" "set data(selectPath) [lindex [glob $data(-initialdir)] 0]\n" "} else {\n" "set data(selectPath) [pwd]\n" "}\n" "set old [pwd]\n" "cd $data(selectPath)\n" "set data(selectPath) [pwd]\n" "cd $old\n" "}\n" "set data(selectFile) $data(-initialfile)\n" "set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]\n" "if {![info exists data(filter)]} {\n" "set data(filter) *\n" "}\n" "if {![winfo exists $data(-parent)]} {\n" "error \"bad window path name \\\"$data(-parent)\\\"\"\n" "}\n" "}\n" "proc ::tk::MotifFDialog_BuildUI {w} {\n" "set dataName [lindex [split $w .] end]\n" "upvar ::tk::dialog::file::$dataName data\n" "toplevel $w -class TkMotifFDialog\n" "set top [frame $w.top -relief raised -bd 1]\n" "set bot [frame $w.bot -relief raised -bd 1]\n" "pack $w.bot -side bottom -fill x\n" "pack $w.top -side top -expand yes -fill both\n" "set f1 [frame $top.f1]\n" "set f2 [frame $top.f2]\n" "set f3 [frame $top.f3]\n" "pack $f1 -side top -fill x\n" "pack $f3 -side bottom -fill x\n" "pack $f2 -expand yes -fill both\n" "set f2a [frame $f2.a]\n" "set f2b [frame $f2.b]\n" "grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n" "\011-sticky news\n" "grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n" "\011-sticky news\n" "grid rowconfigure $f2 0 -minsize 0 -weight 1\n" "grid columnconfigure $f2 0 -minsize 0 -weight 1\n" "grid columnconfigure $f2 1 -minsize 150 -weight 2\n" "bind [::tk::AmpWidget label $f1.lab -text [mc \"Fil&ter:\"] -anchor w] \\\n" "\011<> [list focus $f1.ent]\n" "entry $f1.ent\n" "pack $f1.lab -side top -fill x -padx 6 -pady 4\n" "pack $f1.ent -side top -fill x -padx 4 -pady 0\n" "set data(fEnt) $f1.ent\n" "set data(dList) [MotifFDialog_MakeSList $w $f2a \\\n" "\011 [mc \"&Directory:\"] DList]\n" "set data(fList) [MotifFDialog_MakeSList $w $f2b \\\n" "\011 [mc \"Fi&les:\"] FList]\n" "bind [::tk::AmpWidget label $f3.lab -text [mc \"&Selection:\"] -anchor w] \\\n" "\011<> [list focus $f3.ent]\n" "entry $f3.ent\n" "pack $f3.lab -side top -fill x -padx 6 -pady 0\n" "pack $f3.ent -side top -fill x -padx 4 -pady 4\n" "set data(sEnt) $f3.ent\n" "set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]\n" "set maxWidth [expr {$maxWidth<6?6:$maxWidth}]\n" "set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc \"&OK\"] \\\n" "\011 -width $maxWidth \\\n" "\011 -command [list tk::MotifFDialog_OkCmd $w]]\n" "set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc \"&Filter\"] \\\n" "\011 -width $maxWidth \\\n" "\011 -command [list tk::MotifFDialog_FilterCmd $w]]\n" "set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc \"&Cancel\"] \\\n" "\011 -width $maxWidth \\\n" "\011 -command [list tk::MotifFDialog_CancelCmd $w]]\n" "pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \\\n" "\011-side left\n" "bind $w [list ::tk::AltKeyInDialog $w %A]\n" "bind $data(fEnt) [list tk::MotifFDialog_ActivateFEnt $w]\n" "bind $data(sEnt) [list tk::MotifFDialog_ActivateSEnt $w]\n" "bind $w [list tk::MotifFDialog_CancelCmd $w]\n" "bind $w.bot {set ::tk::Priv(selectFilePath) {}}\n" "wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]\n" "}\n" "proc ::tk::MotifFDialog_SetListMode {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {$data(-multiple) != 0} {\n" "set selectmode extended\n" "} else {\n" "set selectmode browse\n" "}\n" "set f $w.top.f2.b\n" "$f.l configure -selectmode $selectmode\n" "}\n" "proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {\n" "bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \\\n" "\011<> [list focus $f.l]\n" "listbox $f.l -width 12 -height 5 -exportselection 0\\\n" "\011-xscrollcommand [list $f.h set]\011-yscrollcommand [list $f.v set]\n" "scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]\n" "scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]\n" "grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \\\n" "\011-padx 2 -pady 2\n" "grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news\n" "grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news\n" "grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news\n" "grid rowconfigure $f 0 -weight 0 -minsize 0\n" "grid rowconfigure $f 1 -weight 1 -minsize 0\n" "grid columnconfigure $f 0 -weight 1 -minsize 0\n" "set list $f.l\n" "bind $list <> [list tk::MotifFDialog_Browse$cmdPrefix $w]\n" "bind $list \\\n" "\011 [list tk::MotifFDialog_Activate$cmdPrefix $w]\n" "bind $list \011\"tk::MotifFDialog_Browse$cmdPrefix [list $w]; \\\n" "\011 tk::MotifFDialog_Activate$cmdPrefix [list $w]\"\n" "bindtags $list [list Listbox $list [winfo toplevel $list] all]\n" "ListBoxKeyAccel_Set $list\n" "return $f.l\n" "}\n" "proc ::tk::MotifFDialog_InterpFilter {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set text [string trim [$data(fEnt) get]]\n" "set badTilde 0\n" "if {[string index $text 0] eq \"~\"} {\n" "set list [file split $text]\n" "set tilde [lindex $list 0]\n" "if {[catch {set tilde [glob $tilde]}]} {\n" "set badTilde 1\n" "} else {\n" "set text [eval file join [concat $tilde [lrange $list 1 end]]]\n" "}\n" "}\n" "set relative 0\n" "if {[file pathtype $text] eq \"relative\"} {\n" "set relative 1\n" "} elseif {$badTilde} {\n" "set relative 1\011\n" "}\n" "if {$relative} {\n" "tk_messageBox -icon warning -type ok \\\n" "\011 -message \"\\\"$text\\\" must be an absolute pathname\"\n" "$data(fEnt) delete 0 end\n" "$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n" "\011\011$data(filter)]\n" "return [list $data(selectPath) $data(filter)]\n" "}\n" "set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]\n" "if {[file isdirectory $resolved]} {\n" "set dir $resolved\n" "set fil $data(filter)\n" "} else {\n" "set dir [file dirname $resolved]\n" "set fil [file tail $resolved]\n" "}\n" "return [list $dir $fil]\n" "}\n" "proc ::tk::MotifFDialog_Update {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "$data(fEnt) delete 0 end\n" "$data(fEnt) insert 0 \\\n" " [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n" "$data(sEnt) delete 0 end\n" "$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n" "\011 $data(selectFile)]\n" "MotifFDialog_LoadFiles $w\n" "}\n" "proc ::tk::MotifFDialog_LoadFiles {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "$data(dList) delete 0 end\n" "$data(fList) delete 0 end\n" "set appPWD [pwd]\n" "if {[catch {cd $data(selectPath)}]} {\n" "cd $appPWD\n" "$data(dList) insert end \"..\"\n" "return\n" "}\n" "set top 0\n" "set dlist \"\"\n" "set flist \"\"\n" "foreach f [glob -nocomplain .* *] {\n" "if {[file isdir ./$f]} {\n" "lappend dlist $f\n" "} else {\n" "foreach pat $data(filter) {\n" "if {[string match $pat $f]} {\n" "if {[string match .* $f]} {\n" "incr top\n" "}\n" "lappend flist $f\n" "break\n" "}\n" "}\n" "}\n" "}\n" "eval [list $data(dList) insert end] [lsort -dictionary $dlist]\n" "eval [list $data(fList) insert end] [lsort -dictionary $flist]\n" "$data(fList) yview $top\n" "cd $appPWD\n" "}\n" "proc ::tk::MotifFDialog_BrowseDList {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "focus $data(dList)\n" "if {[$data(dList) curselection] eq \"\"} {\n" "return\n" "}\n" "set subdir [$data(dList) get [$data(dList) curselection]]\n" "if {$subdir eq \"\"} {\n" "return\n" "}\n" "$data(fList) selection clear 0 end\n" "set list [MotifFDialog_InterpFilter $w]\n" "set data(filter) [lindex $list 1]\n" "switch -- $subdir {\n" ". {\n" "set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n" "}\n" ".. {\n" "set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \\\n" "\011\011$data(filter)]\n" "}\n" "default {\n" "set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \\\n" "\011\011 $data(selectPath) $subdir] $data(filter)]\n" "}\n" "}\n" "$data(fEnt) delete 0 end\n" "$data(fEnt) insert 0 $newSpec\n" "}\n" "proc ::tk::MotifFDialog_ActivateDList {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {[$data(dList) curselection] eq \"\"} {\n" "return\n" "}\n" "set subdir [$data(dList) get [$data(dList) curselection]]\n" "if {$subdir eq \"\"} {\n" "return\n" "}\n" "$data(fList) selection clear 0 end\n" "switch -- $subdir {\n" ". {\n" "set newDir $data(selectPath)\n" "}\n" ".. {\n" "set newDir [file dirname $data(selectPath)]\n" "}\n" "default {\n" "set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]\n" "}\n" "}\n" "set data(selectPath) $newDir\n" "MotifFDialog_Update $w\n" "if {$subdir ne \"..\"} {\n" "$data(dList) selection set 0\n" "$data(dList) activate 0\n" "} else {\n" "$data(dList) selection set 1\n" "$data(dList) activate 1\n" "}\n" "}\n" "proc ::tk::MotifFDialog_BrowseFList {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "focus $data(fList)\n" "set data(selectFile) \"\"\n" "foreach item [$data(fList) curselection] {\n" "lappend data(selectFile) [$data(fList) get $item]\n" "}\n" "if {[llength $data(selectFile)] == 0} {\n" "return\n" "}\n" "$data(dList) selection clear 0 end\n" "$data(fEnt) delete 0 end\n" "$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n" "\011 $data(filter)]\n" "$data(fEnt) xview end\n" "$data(sEnt) delete 0 end\n" "if {$data(-multiple) != 0} {\n" "$data(sEnt) insert 0 $data(selectFile)\n" "} else {\n" "$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n" "\011\011\011\011 [lindex $data(selectFile) 0]]\n" "}\n" "$data(sEnt) xview end\n" "}\n" "proc ::tk::MotifFDialog_ActivateFList {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "if {[$data(fList) curselection] eq \"\"} {\n" "return\n" "}\n" "set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n" "if {$data(selectFile) eq \"\"} {\n" "return\n" "} else {\n" "MotifFDialog_ActivateSEnt $w\n" "}\n" "}\n" "proc ::tk::MotifFDialog_ActivateFEnt {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set list [MotifFDialog_InterpFilter $w]\n" "set data(selectPath) [lindex $list 0]\n" "set data(filter) [lindex $list 1]\n" "MotifFDialog_Update $w\n" "}\n" "proc ::tk::MotifFDialog_ActivateSEnt {w} {\n" "variable ::tk::Priv\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "set selectFilePath [string trim [$data(sEnt) get]]\n" "if {$selectFilePath eq \"\"} {\n" "MotifFDialog_FilterCmd $w\n" "return\n" "}\n" "if {$data(-multiple) == 0} {\n" "set selectFilePath [list $selectFilePath]\n" "}\n" "if {[file isdirectory [lindex $selectFilePath 0]]} {\n" "set data(selectPath) [lindex [glob $selectFilePath] 0]\n" "set data(selectFile) \"\"\n" "MotifFDialog_Update $w\n" "return\n" "}\n" "set newFileList \"\"\n" "foreach item $selectFilePath {\n" "if {[file pathtype $item] ne \"absolute\"} {\n" "set item [file join $data(selectPath) $item]\n" "} elseif {![file exists [file dirname $item]]} {\n" "tk_messageBox -icon warning -type ok \\\n" "\011\011 -message [mc {Directory \"%1$s\" does not exist.} \\\n" "\011\011 [file dirname $item]]\n" "return\n" "}\n" "if {![file exists $item]} {\n" "if {$data(type) eq \"open\"} {\n" "tk_messageBox -icon warning -type ok \\\n" "\011\011\011-message [mc {File \"%1$s\" does not exist.} $item]\n" "return\n" "}\n" "} else {\n" "if {$data(type) eq \"save\"} {\n" "set message [format %s%s \\\n" "\011\011\011[mc \"File \\\"%1\\$s\\\" already exists.\\n\\n\" \\\n" "\011\011\011$selectFilePath] \\\n" "\011\011\011[mc {Replace existing file?}]]\n" "set answer [tk_messageBox -icon warning -type yesno \\\n" "\011\011\011-message $message]\n" "if {$answer eq \"no\"} {\n" "return\n" "}\n" "}\n" "}\n" "lappend newFileList $item\n" "}\n" "if {$data(-multiple) != 0} {\n" "set Priv(selectFilePath) $newFileList\n" "} else {\n" "set Priv(selectFilePath) [lindex $newFileList 0]\n" "}\n" "set Priv(selectFile) [file tail [lindex $newFileList 0]]\n" "set Priv(selectPath) [file dirname [lindex $newFileList 0]]\n" "}\n" "proc ::tk::MotifFDialog_OkCmd {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "MotifFDialog_ActivateSEnt $w\n" "}\n" "proc ::tk::MotifFDialog_FilterCmd {w} {\n" "upvar ::tk::dialog::file::[winfo name $w] data\n" "MotifFDialog_ActivateFEnt $w\n" "}\n" "proc ::tk::MotifFDialog_CancelCmd {w} {\n" "variable ::tk::Priv\n" "set Priv(selectFilePath) \"\"\n" "set Priv(selectFile) \"\"\n" "set Priv(selectPath) \"\"\n" "}\n" "proc ::tk::ListBoxKeyAccel_Set {w} {\n" "bind Listbox \"\"\n" "bind $w [list tk::ListBoxKeyAccel_Unset $w]\n" "bind $w [list tk::ListBoxKeyAccel_Key $w %A]\n" "}\n" "proc ::tk::ListBoxKeyAccel_Unset {w} {\n" "variable ::tk::Priv\n" "catch {after cancel $Priv(lbAccel,$w,afterId)}\n" "unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId)\n" "}\n" "proc ::tk::ListBoxKeyAccel_Key {w key} {\n" "variable ::tk::Priv\n" "if { $key eq \"\" } {\n" "return\n" "}\n" "append Priv(lbAccel,$w) $key\n" "ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)\n" "catch {\n" "after cancel $Priv(lbAccel,$w,afterId)\n" "}\n" "set Priv(lbAccel,$w,afterId) [after 500 \\\n" "\011 [list tk::ListBoxKeyAccel_Reset $w]]\n" "}\n" "proc ::tk::ListBoxKeyAccel_Goto {w string} {\n" "variable ::tk::Priv\n" "set string [string tolower $string]\n" "set end [$w index end]\n" "set theIndex -1\n" "for {set i 0} {$i < $end} {incr i} {\n" "set item [string tolower [$w get $i]]\n" "if {[string compare $string $item] >= 0} {\n" "set theIndex $i\n" "}\n" "if {[string compare $string $item] <= 0} {\n" "set theIndex $i\n" "break\n" "}\n" "}\n" "if {$theIndex >= 0} {\n" "$w selection clear 0 end\n" "$w selection set $theIndex $theIndex\n" "$w activate $theIndex\n" "$w see $theIndex\n" "event generate $w <>\n" "}\n" "}\n" "proc ::tk::ListBoxKeyAccel_Reset {w} {\n" "variable ::tk::Priv\n" "unset -nocomplain Priv(lbAccel,$w)\n" "}\n" "proc ::tk_getFileType {} {\n" "variable ::tk::Priv\n" "return $Priv(selectFileType)\n" "}\n" ; static unsigned char Et_zFile38[] = "if {[string compare $tcl_platform(platform) windows] == 0} {\n" "set font_face(list)\011\011terminal\n" "if {[string compare [root_name] Metadatos] == 0} {\n" "set font_face(list)\011\011courier\n" "}\n" "set font_size(list)\011\0119\n" "set font_bold(list)\011\0110\n" "set font_italic(list)\0110\n" "set font_face(value)\011courier\n" "set font_size(value)\0119\n" "set font_bold(value)\0110\n" "set font_italic(value)\0110\n" "set font_face(menu)\011\011arial\n" "set font_size(menu)\011\0119\n" "set font_bold(menu)\011\0110\n" "set font_italic(menu)\0110\n" "set font_face(output)\011courier\n" "set font_size(output)\0119\n" "set font_bold(output)\0110\n" "set font_italic(output)\0110\n" "set font_face(help)\011\011arial\n" "set font_size(help)\011\0119\n" "set font_bold(help)\011\0110\n" "set font_italic(help)\0110\n" "} \\\n" "else {\n" "set font_face(list)\011\011fixed\n" "set font_size(list)\011\01112\n" "set font_bold(list)\011\0110\n" "set font_italic(list)\0110\n" "set font_face(value)\011fixed\n" "set font_size(value)\01112\n" "set font_bold(value)\0110\n" "set font_italic(value)\0110\n" "set font_face(menu)\011\011helvetica\n" "set font_size(menu)\011\01112\n" "set font_bold(menu)\011\0111\n" "set font_italic(menu)\0110\n" "set font_face(output)\011fixed\n" "set font_size(output)\01112\n" "set font_bold(output)\0110\n" "set font_italic(output)\0110\n" "set font_face(help)\011\011helvetica\n" "set font_size(help)\011\01112\n" "set font_bold(help)\011\0110\n" "set font_italic(help)\0110\n" "}\n" "set file_name \"Untitled\"\n" "set changed 0\n" "set current_menu \"\"\n" "set current_item \"\"\n" "set current_element \"\"\n" "set current_index \"\"\n" "proc add_to_recent_files_list {file_name} {\n" "global recent_file\n" "set found 0\n" "set file_list {}\n" "if {[catch \"open $recent_file r\" result]} {\n" "} \\\n" "\011else {\n" "set rf $result\n" "set file_list [split [read -nonewline $rf] \"\\n\"]\n" "foreach f $file_list {\n" "if {[file exists $f]} {\n" "if {[string compare $f $file_name] == 0} {\n" "set found 1\n" "}\n" "}\n" "}\n" "close $rf\n" "}\n" "if {$found == 0} {\n" "set rf [open $recent_file w]\n" "puts $rf \"$file_name\"\n" "set i 1\n" "foreach f $file_list {\n" "if {[file exists $f]} {\n" "puts $rf \"$f\"\n" "incr i\n" "if { $i > 9 } break\n" "}\n" "}\n" "close $rf\n" ".mbar.file.menu.recent add command -label \"$file_name\" -command [list read_metadata \"$file_name\"]\n" "}\n" "}\n" "proc read_metadata {name} {\n" "global file_name changed element_list element_value\n" "set w $element_list\n" "if {[string length $name] > 0} {\n" "set ptree_list [parse_text $name]\n" "if {[llength $ptree_list] > 0} {\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item 0\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "if {[string compare [file pathtype $name] relative] == 0} {\n" "set file_name [file join [pwd] $name]\n" "} \\\n" "\011\011\011else {\n" "set file_name $name\n" "}\n" "wm title . \"Tkme: $file_name\"\n" "set changed 0\n" "add_to_recent_files_list $file_name\n" "focus $element_value\n" ".mbar.file.menu entryconfigure 0 -state disabled\n" ".mbar.file.menu entryconfigure 4 -state disabled\n" ".mbar.file.menu entryconfigure 5 -state disabled\n" "}\n" "}\n" "}\n" "proc file_open {} {\n" "set mf [list {Metadata files} [ext_list]]\n" "set types [list $mf {{Text files} {.txt .text}} {{XML files} {.xml}} {{SGML files} {.sgml .sgm}} {{All files} *}]\n" "set input_file [tk_getOpenFile -title \"Select input file\" -filetypes $types]\n" "if {[llength $input_file] > 0} {\n" "read_metadata $input_file\n" "}\n" "}\n" "set reason {}\n" "proc can_write {name} {\n" "global reason\n" "if {[file exists $name]} {\n" "if {[file writable $name]} {\n" "set q 1\n" "} \\\n" "\011\011else {\n" "set q 0\n" "set reason \"The file exists with Read Only attributes.\"\n" "}\n" "} \\\n" "\011else {\n" "set dir [file dirname $name]\n" "if {[file exists $dir]} {\n" "if {[file writable $dir]} {\n" "set q 1\n" "} \\\n" "\011\011\011else {\n" "set q 0\n" "set reason \"You do not have permission to create files in this directory.\"\n" "}\n" "} \\\n" "\011\011else {\n" "set q 0\n" "set reason \"This directory does not exist.\"\n" "}\n" "}\n" "return $q\n" "}\n" "proc file_save {} {\n" "global file_name changed reason\n" "save_current\n" "if {[string compare $file_name \"Untitled\"] == 0 || [can_write $file_name] == 0} {\n" "file_save_as\n" "} \\\n" "\011else {\n" "write_text 0 $file_name\n" "set changed 0\n" "}\n" "}\n" "proc file_save_as {} {\n" "global file_name changed reason\n" "save_current\n" "set output_file [tk_getSaveFile -title \"Select output file\" -initialfile $file_name]\n" "if {[string length $output_file] == 0} return\n" "if {[can_write $output_file]} {\n" "set ok 1\n" "} \\\n" "\011else {\n" "set ok 0\n" "tk_messageBox -type ok -message \"$output_file\\n$reason\\nPlease use a different file name.\" -icon warning\n" "}\n" "while {$ok == 0} {\n" "set output_file [tk_getSaveFile -title \"Select output file\"]\n" "if {[string length $output_file] == 0} return\n" "if {[can_write $output_file]} {\n" "set ok 1\n" "} \\\n" "\011\011else {\n" "set ok 0\n" "tk_messageBox -type ok -message \"$output_file\\n$reason\\nPlease use a different file name.\" -icon warning\n" "}\n" "}\n" "write_text 0 $output_file\n" "set file_name $output_file\n" "wm title . \"Tkme: $file_name\"\n" "set changed 0\n" "add_to_recent_files_list $file_name\n" "}\n" "proc file_close {} {\n" "global element_list element_value file_name\n" "global changed\n" "save_current\n" "if {[string compare $changed 0] != 0} {\n" "set choice [tk_messageBox -type yesnocancel -default yes -message \"Save changes before closing?\" -icon question]\n" "switch -exact $choice {\n" "yes {\n" "file_save\n" "forget\n" "}\n" "no {\n" "forget\n" "}\n" "cancel {\n" "return\n" "}\n" "}\n" "} \\\n" "\011else {\n" "forget\n" "}\n" "$element_list delete 0 end\n" "$element_value configure -state normal\n" "$element_value delete 1.0 end\n" "$element_value configure -state disabled\n" "$element_value configure -background gray\n" ".mbar.add.menu delete 0 end\n" ".mbar.add.menu add command -label \"[root_name]\" -command \"add_element [root_name]\"\n" "set file_name \"Untitled\"\n" "wm title . \"Tkme: $file_name\"\n" ".mbar.file.menu entryconfigure 0 -state normal\n" "if {[config_read]} {set state disabled} else {set state normal}\n" ".mbar.file.menu entryconfigure 4 -state $state\n" ".mbar.file.menu entryconfigure 5 -state normal\n" "}\n" "proc file_config {} {\n" "set typelist {\n" "{\"Configuration files\"\011{.cfg}\011TEXT}\n" "{\"Text files\"\011\011\011{.txt}\011TEXT}\n" "{\"All files\"\011\011*}\n" "}\n" "set config_file [tk_getOpenFile -filetypes $typelist -title \"Select config file\"]\n" "if {[string length $config_file] > 0} {\n" "read_config $config_file\n" ".mbar.file.menu entryconfigure 4 -state disabled\n" "}\n" "}\n" "proc save_geometry {} {\n" "global recent_file\n" "global font_face font_size font_bold font_italic\n" "set geometry_file [file join [file dirname $recent_file] geometry.tcl]\n" "set out [open $geometry_file w]\n" "puts $out \"# Tcl statements to restore the window size and position\"\n" "puts $out \"# This file is created when you exit Tkme.\"\n" "set g_main {}\n" "if {[string compare [wm state .] normal] == 0} {\n" "catch {wm geometry .} g_main\n" "puts $out \"wm geometry . $g_main\"\n" "}\n" "set g_help {}\n" "if {[string compare [wm state .help] normal] == 0} {\n" "catch {wm geometry .help} g_help\n" "puts $out \"wm deiconify .help\"\n" "puts $out \"wm geometry .help $g_help\"\n" "}\n" "set g_output {}\n" "if {[string compare [wm state .output] normal] == 0} {\n" "catch {wm geometry .output} g_output\n" "puts $out \"wm geometry .output $g_output\"\n" "}\n" "puts $out \"# Font configuration\"\n" "puts $out \"set font_face(list) \\\"$font_face(list)\\\"\"\n" "puts $out \"set font_size(list) $font_size(list)\"\n" "puts $out \"set font_bold(list) $font_bold(list)\"\n" "puts $out \"set font_italic(list) $font_italic(list)\"\n" "puts $out \"set font_face(value) \\\"$font_face(value)\\\"\"\n" "puts $out \"set font_size(value) $font_size(value)\"\n" "puts $out \"set font_bold(value) $font_bold(value)\"\n" "puts $out \"set font_italic(value) $font_italic(value)\"\n" "puts $out \"set font_face(menu) \\\"$font_face(menu)\\\"\"\n" "puts $out \"set font_size(menu) $font_size(menu)\"\n" "puts $out \"set font_bold(menu) $font_bold(menu)\"\n" "puts $out \"set font_italic(menu) $font_italic(menu)\"\n" "puts $out \"set font_face(output) \\\"$font_face(output)\\\"\"\n" "puts $out \"set font_size(output) $font_size(output)\"\n" "puts $out \"set font_bold(output) $font_bold(output)\"\n" "puts $out \"set font_italic(output) $font_italic(output)\"\n" "puts $out \"set font_face(help) \\\"$font_face(help)\\\"\"\n" "puts $out \"set font_size(help) $font_size(help)\"\n" "puts $out \"set font_bold(help) $font_bold(help)\"\n" "puts $out \"set font_italic(help) $font_italic(help)\"\n" "puts $out \"font_apply configure\"\n" "puts $out \"# end\"\n" "close $out\n" "}\n" "proc file_quit {} {\n" "global changed\n" "save_current\n" "save_geometry\n" "if {[string compare $changed 0] != 0} {\n" "set choice [tk_messageBox -type yesnocancel -default yes -message \"Save changes before quitting?\" -icon question]\n" "switch -exact $choice {\n" "yes {\n" "file_save\n" "exit\n" "}\n" "no {\n" "exit\n" "}\n" "cancel {\n" "}\n" "}\n" "} \\\n" "\011else {\n" "exit\n" "}\n" "}\n" "proc edit_cut {widget} {\n" "global changed element_list element_value\n" "set is_list [string compare $widget $element_list]\n" "set is_value [string compare $widget $element_value]\n" "set q [expr $is_list * $is_value]\n" "if {$q != 0} {\n" "tk_textCut $widget\n" "} \\\n" "\011else {\n" "set selected_range [$element_value tag nextrange sel 1.0 end]\n" "if {[string compare [$element_value tag nextrange sel 1.0 end] \"\"]} {\n" "tk_textCut $element_value\n" "} \\\n" "\011\011else {\n" "set w $element_list\n" "save_current\n" "if {[string length [$w curselection]] >= 1} {\n" "set ptree_list [element_cut]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "$element_value configure -insertbackground DarkRed -insertwidth 3\n" "}\n" "clipboard clear\n" "clipboard append \"[clipped_text]\"\n" "}\n" "}\n" "}\n" "}\n" "proc edit_copy {widget} {\n" "global changed element_list element_value\n" "set is_list [string compare $widget $element_list]\n" "set is_value [string compare $widget $element_value]\n" "set q [expr $is_list * $is_value]\n" "if {$q != 0} {\n" "tk_textCopy $widget\n" "} \\\n" "\011else {\n" "if {[string compare [$element_value tag nextrange sel 1.0 end] \"\"]} {\n" "tk_textCopy $element_value\n" "return\n" "} \\\n" "\011\011else {\n" "set w $element_list\n" "save_current\n" "set w $element_list\n" "if {[string length [$w curselection]] >= 1} {\n" "element_copy\n" "clipboard clear\n" "clipboard append \"[clipped_text]\"\n" "} \\\n" "\011\011\011else {\n" "set t $element_value\n" "set q [$t tag ranges sel]\n" "if {[llength q] > 0} {\n" "set b [lindex $q 0]\n" "set e [lindex $q 1]\n" "set stuff [$t get $b $e]\n" "clipboard clear\n" "clipboard append \"$stuff\"\n" "} \\\n" "\011\011\011\011else {\n" "tk_messageBox -type ok -message \"There doesn't seem to be anything selected right now.\" -icon warning\n" "}\n" "}\n" "}\n" "}\n" "}\n" "proc edit_paste {widget} {\n" "global changed element_list element_value\n" "set w $element_list\n" "set is_list [string compare $widget $element_list]\n" "set is_value [string compare $widget $element_value]\n" "set q [expr $is_list * $is_value]\n" "if {$q == 0} {\n" "set the_item [$w index active]\n" "set stuff \"[selection get -selection CLIPBOARD]\"\n" "set q [is_scalar $the_item]\n" "append q [recognized $stuff]\n" "switch -exact $q {\n" "00 {\011# element compound selection plain\n" "tk_messageBox -type ok -message \"Sorry, this information cannot be placed properly\" -icon warning\n" "}\n" "01 {\011# element compound selection subtree\n" "if {[paste_subtree \"$stuff\"] == 1} {\n" "set ptree_list [get_list]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "} \\\n" "\011\011\011\011else {\n" "tk_messageBox -type ok -message \"Sorry, this information cannot be placed properly\" -icon warning\n" "}\n" "}\n" "10 {\011# element scalar selection plain\n" "catch {$element_value delete sel.first sel.last}\n" "$element_value insert insert \"$stuff\"\n" "}\n" "11 {\011# element scalar selection subtree\n" "if {[paste_subtree \"$stuff\"] == 1} {\n" "set ptree_list [get_list]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "} \\\n" "\011\011\011\011else {\n" "tk_messageBox -type ok -message \"Sorry, this information cannot be placed properly\" -icon warning\n" "}\n" "}\n" "}\n" "} \\\n" "\011else {\n" "tk_textPaste $widget\n" "}\n" "}\n" "proc edit_clear {} {\n" "global changed element_list\n" "set w $element_list\n" "clear_subtree [$w index active]\n" "set_current $w\n" "set changed 1\n" "}\n" "proc edit_duplicate {} {\n" "global changed element_list\n" "set w $element_list\n" "save_current\n" "set ptree_list [duplicate]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "}\n" "proc edit_swap {} {\n" "global changed element_list\n" "set w $element_list\n" "save_current\n" "set ptree_list [swap]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "}\n" "proc edit_prune {} {\n" "global changed element_list\n" "set w $element_list\n" "save_current\n" "set ptree_list [prune]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "}\n" "proc edit_revert {} {\n" "global element_list element_value\n" "global previous_value\n" "if {[string length [$element_list get 0]] == 0} {return}\n" "set this_index [$element_list index active]\n" "set this_element [$element_list get $this_index]\n" "if {[is_scalar $this_index] == 1} {\n" "$element_value delete 1.0 end\n" "$element_value insert 1.0 \"$previous_value\"\n" "}\n" "}\n" "proc view_set {number} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set ptree_list [view_levels $number]\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc view_hide {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set ptree_list [hide_element]\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc view_show {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set ptree_list [show_element]\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc view_toggle {} {\n" "global element_list\n" "set w $element_list\n" "set this_index [$w index active]\n" "set this_element [$w get $this_index]\n" "if {[string index $this_element 0] == \"+\"} {\n" "view_show\n" "} \\\n" "\011else {\n" "view_hide\n" "}\n" "}\n" "proc view_wrap {} {\n" "global element_value\n" "set w $element_value\n" "set now [$w cget -wrap]\n" "if {[string compare $now \"word\"] == 0} {\n" "$w configure -wrap none\n" ".mbar.view.menu entryconfigure 6 -label \"Wrap\"\n" ".paned.value.menu entryconfigure 5 -label \"Wrap\"\n" "} \\\n" "\011else {\n" "$w configure -wrap word\n" ".mbar.view.menu entryconfigure 6 -label \"No Wrap\"\n" ".paned.value.menu entryconfigure 5 -label \"No Wrap\"\n" "}\n" "}\n" "proc hard_wrap {} {\n" "global element_value element_list\n" "set this_index [$element_list index active]\n" "if {[is_scalar $this_index] == 1} {\n" "save_current\n" "wrap_current\n" "$element_value configure -state normal\n" "$element_value delete 1.0 end\n" "$element_value insert 1.0 \"[set_text $this_index]\"\n" "}\n" "}\n" "proc add_element {name} {\n" "global changed element_list\n" "save_current\n" "set w $element_list\n" "set ptree_list [element_add $name]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "if {[string compare $name [root_name]] == 0} {\n" ".mbar.file.menu entryconfigure 0 -state disabled\n" ".mbar.file.menu entryconfigure 4 -state disabled\n" ".mbar.file.menu entryconfigure 5 -state disabled\n" "}\n" "}\n" "}\n" "proc add_all {} {\n" "global changed element_list\n" "save_current\n" "set w $element_list\n" "set the_item [$w index active]\n" "if {[is_scalar $the_item] != 1} {\n" "set ptree_list [add_children]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "}\n" "}\n" "proc snippet_store {} {\n" "global snippet_home\n" "set snippet_home_full [glob $snippet_home]\n" "set t [tk_getSaveFile -title \"Name a file to store the snippet\" -initialdir $snippet_home]\n" "set snippet [string map {{ } _} $t]\n" "set snippet_label [file tail $snippet]\n" "if {[string length $snippet] > 0} {\n" "if {[string first $snippet_home_full $snippet] < 3} {\n" "if {[catch \"open $snippet w\" fp]} {\n" "} \\\n" "\011\011\011else {\n" "puts $fp [encode_current]\n" "close $fp\n" "set m .mbar.snip.menu\n" "set h [file split $snippet_home_full]\n" "set lh [llength $h]\n" "set d [file split [file dirname $snippet]]\n" "set ld [llength $d]\n" "if {$lh < $ld} {\n" "for {set i $lh} {$i < $ld} {incr i} {\n" "set t [string tolower [lindex $d $i]]\n" "if {[catch \"menu $m.$t -tearoff false -font menu_font\" err]} {\n" "} \\\n" "\011\011\011\011\011\011else {\n" "$m add cascade -label $t -menu $m.$t\n" "}\n" "set m $m.$t\n" "}\n" "}\n" "$m add command -label $snippet_label -command \"snippet_insert $snippet\"\n" "}\n" "} \\\n" "\011\011else {\n" "tk_messageBox -type ok -icon warning -message \"You must store the snippet within $snippet_home\"\n" "}\n" "}\n" "}\n" "proc snippet_insert {snippet_name} {\n" "global snippet_home element_list\n" "if {[catch \"open $snippet_name r\" fp]} {\n" "} \\\n" "\011else {\n" "set stuff [read -nonewline $fp]\n" "if {[paste_subtree \"$stuff\"] == 1} {\n" "set w $element_list\n" "set ptree_list [get_list]\n" "if {[llength $ptree_list] > 0} {\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "set changed 1\n" "}\n" "} \\\n" "\011\011else {\n" "tk_messageBox -type ok -message \"Sorry, this information cannot be placed properly\" -icon warning\n" "}\n" "close $fp\n" "}\n" "}\n" "proc help_version {} {\n" "set w .help\n" "if [catch {set status [wm state $w]} ok] {\n" "show_help_window\n" "} \\\n" "\011else {\n" "switch -exact $status {\n" "normal {\n" "}\n" "iconic {\n" "wm deiconify $w\n" "}\n" "withdrawn {\n" "wm deiconify $w\n" "}\n" "}\n" ".help.text.text delete 1.0 end\n" ".help.text.text insert end \"[about_text]\"\n" "}\n" "}\n" "proc show_help_window {} {\n" "puts stdout \"show_help_window\"\n" "}\n" "proc help_element {} {\n" "set w .help\n" "if [catch {set status [wm state $w]} ok] {\n" "show_help_window\n" "} \\\n" "\011else {\n" "switch -exact $status {\n" "normal {\n" "}\n" "iconic {\n" "wm deiconify $w\n" "}\n" "withdrawn {\n" "wm deiconify $w\n" "}\n" "}\n" ".help.text.text delete 1.0 end\n" ".help.text.text insert end \"[help_text]\"\n" "}\n" "}\n" "proc show_output_window {} {\n" "puts stdout \"show_output_window\"\n" "}\n" "proc help_output {} {\n" "set w .output\n" "if [catch {set status [wm state $w]} ok] {\n" "show_output_window\n" "} \\\n" "\011else {\n" "switch -exact $status {\n" "normal {\n" "}\n" "iconic {\n" "wm deiconify $w\n" "}\n" "withdrawn {\n" "wm deiconify $w\n" "}\n" "}\n" "output_update\n" "}\n" "}\n" "proc show_font_window {} {\n" "global font_face font_size font_bold font_italic\n" "set w .fonts\n" "toplevel $w\n" "frame $w.mbar -relief flat -bd 3\n" "pack $w.mbar -side top -expand false -fill x\n" "button $w.mbar.close -text \"Close\" -font menu_font -command {font_close}\n" "button $w.mbar.apply -text \"Apply\" -font menu_font -command {font_apply configure}\n" "pack $w.mbar.close $w.mbar.apply -side left\n" "frame $w.f\n" "pack $w.f\n" "label $w.f.which -text \"Place\"\n" "label $w.f.face -text \"Typeface\"\n" "label $w.f.size -text \"Size\"\n" "label $w.f.bold -text \"Bold\"\n" "label $w.f.italic -text \"Slanted\"\n" "grid $w.f.which $w.f.face $w.f.size $w.f.bold $w.f.italic\n" "foreach part {list value menu output help} {\n" "label $w.f.label_$part -text \"$part\"\n" "set cmd [list tk_optionMenu $w.f.face_$part font_face($part)]\n" "foreach name [font families] {\n" "if {[string length $name] > 1} {\n" "if {[string compare $name nil] != 0} {\n" "lappend cmd $name\n" "}\n" "}\n" "}\n" "eval $cmd\n" "tk_optionMenu $w.f.size_$part font_size($part) 7 8 9 10 11 12 14 16 18 21 24\n" "checkbutton $w.f.bold_$part -variable font_bold($part)\n" "checkbutton $w.f.italic_$part -variable font_italic($part)\n" "grid $w.f.label_$part $w.f.face_$part $w.f.size_$part $w.f.bold_$part $w.f.italic_$part\n" "grid $w.f.label_$part $w.f.face_$part $w.f.size_$part -sticky w\n" "}\n" "}\n" "proc help_fonts {} {\n" "set w .fonts\n" "if [catch {set status [wm state $w]} ok] {\n" "show_font_window\n" "} \\\n" "\011else {\n" "switch -exact $status {\n" "normal {\n" "}\n" "iconic {\n" "wm deiconify $w\n" "}\n" "withdrawn {\n" "wm deiconify $w\n" "}\n" "}\n" "}\n" "}\n" "proc font_close {} {\n" "wm withdraw .fonts\n" "}\n" "proc font_apply {task} {\n" "global font_face font_size font_bold font_italic\n" "set weight(0) normal\n" "set weight(1) bold\n" "set slant(0) roman\n" "set slant(1) italic\n" "foreach part {list value menu output help} {\n" "set font_name $part\n" "append font_name _font\n" "set cmd [list font $task $font_name -family $font_face($part) -size $font_size($part) -weight $weight($font_bold($part)) -slant $slant($font_italic($part))]\n" "eval $cmd\n" "}\n" "}\n" "proc list_up {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set the_item [$w index active]\n" "if {$the_item > 0} {\n" "set the_item [expr $the_item - 1]\n" "$w selection clear [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "}\n" "proc list_down {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set item_max [$w index end]\n" "set the_item [$w index active]\n" "if {$the_item < [expr $item_max - 1]} {\n" "set the_item [expr $the_item + 1]\n" "$w selection clear [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "}\n" "proc list_home {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set the_item [$w index active]\n" "if {$the_item > 0} {\n" "set the_item 0\n" "$w selection clear [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "}\n" "proc list_end {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set the_item [expr [$w index end] - 1]\n" "$w selection clear [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc list_pageup {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set h [$w cget -height]\n" "set the_item [$w index active]\n" "set the_item [expr $the_item - $h]\n" "if {$the_item < 0} {\n" "set the_item 0\n" "}\n" "$w selection clear [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc list_pagedown {} {\n" "global element_list\n" "save_current\n" "set w $element_list\n" "set h [$w cget -height]\n" "set the_item [$w index active]\n" "set item_max [$w index end]\n" "set the_item [expr $the_item + $h]\n" "if {$the_item > [expr $item_max - 1]} {\n" "set the_item [expr $item_max - 1]\n" "}\n" "$w selection clear [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc list_expand {} {\n" "global element_list\n" "set w $element_list\n" "set ptree_list [expand_list]\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc list_collapse {} {\n" "global element_list\n" "set w $element_list\n" "set ptree_list [collapse_list]\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc tip {menu_name} {\n" "global current_menu current_item\n" "set this_item [$menu_name index active]\n" "set is_different 1\n" "if {[string compare $current_menu $menu_name] == 0} {\n" "if {[string compare $current_item $this_item] == 0} {\n" "set is_different 0\n" "}\n" "}\n" "if {$is_different} {\n" "set current_menu $menu_name\n" "set current_item $this_item\n" ".tf.tip configure -text [tip_text [$menu_name cget -title] [$menu_name entrycget active -label]]\n" "}\n" "}\n" "proc help_close {} {\n" "wm withdraw .help\n" "}\n" "proc help_wrap {} {\n" "set w .help.text.text\n" "set how [$w cget -wrap]\n" "if {[string compare $how word] == 0} {\n" "$w configure -wrap none\n" ".help.mbar.edit.menu entryconfigure 1 -label \"Wrap\"\n" ".help.text.menu entryconfigure 2 -label \"Wrap\"\n" "} \\\n" "\011else {\n" "$w configure -wrap word\n" ".help.mbar.edit.menu entryconfigure 1 -label \"UnWrap\"\n" ".help.text.menu entryconfigure 2 -label \"UnWrap\"\n" "}\n" "}\n" "proc output_close {} {\n" "wm withdraw .output\n" "}\n" "proc output_update {} {\n" "global tcl_platform file_name\n" "save_current\n" "if {[string compare [wm state .output] \"normal\"] == 0} {\n" "wm title .output \"Tkme output: $file_name\"\n" "set w .output.text.text\n" "$w delete 1.0 end\n" "$w insert end \"[output_text]\"\n" "$w mark set insert \"1.0\"\n" "}\n" "}\n" "proc output_wrap {} {\n" "set w .output.text.text\n" "set how [$w cget -wrap]\n" "if {[string compare $how word] == 0} {\n" "$w configure -wrap none\n" ".output.mbar.view.menu entryconfigure 1 -label \"Wrap\"\n" "} \\\n" "\011else {\n" "$w configure -wrap word\n" ".output.mbar.view.menu entryconfigure 1 -label \"No Wrap\"\n" "}\n" "}\n" "proc output_search {pattern} {\n" "set w .output.text.text\n" "focus $w\n" "set old [$w index insert]\n" "set pos [$w search -count cnt -nocase -forward \"$pattern\" insert end]\n" "if {[string compare $old $pos] == 0} {\n" "$w mark set insert \"$old + 1 char\"\n" "set pos [$w search -count cnt -nocase -forward \"$pattern\" insert end]\n" "}\n" "if {[string length $pos] > 0} {\n" "$w mark set insert $pos\n" "$w see $pos\n" "$w tag remove sel 1.0 end\n" "$w tag add sel $pos \"$pos + $cnt chars\"\n" "}\n" "}\n" "proc output_edit {} {\n" "save_current\n" "set t .output.text.text\n" "set s \"[$t index insert]\"\n" "set k [string first \".\" $s]\n" "if {$k > 0} {\n" "set the_line [string range $s 0 [expr $k - 1]]\n" "} \\\n" "\011else {\n" "set the_line 0\n" "}\n" "global element_list\n" "set w $element_list\n" "set ptree_list [edit_line $the_line]\n" "$w delete 0 end\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "}\n" "set the_item [get_current]\n" "$w selection set $the_item\n" "$w activate $the_item\n" "$w see $the_item\n" "set_current $w\n" "}\n" "proc today {} {\n" "global element_value\n" "$element_value insert insert \"[clock format [clock seconds] -format \"%Y%m%d\"]\"\n" "}\n" "proc replace_list {ptree_list} {\n" "global element_list element_color\n" "set w $element_list\n" "$w delete 0 end\n" "set i 0\n" "foreach item $ptree_list {\n" "$w insert end $item\n" "set t [string trim $item]\n" "set s [array names element_color $t]\n" "if {[llength $s] > 0} {\n" "if {[string length [lindex $s 0]] > 0} {\n" "}\n" "}\n" "incr i\n" "}\n" "}\n" "proc save_current {} {\n" "global changed element_value\n" "set changed [expr $changed + [get_text [$element_value get 1.0 end]]]\n" "}\n" "proc set_current {the_listbox} {\n" "global current_element current_index changed element_value\n" "global previous_value\n" "if {[string length [$the_listbox get 0]] == 0} {return}\n" "set this_index [$the_listbox index active]\n" "set this_element [$the_listbox get $this_index]\n" "set is_different 1\n" "if {[string compare $current_element $this_element] == 0} {\n" "if {[string compare $current_index $this_index] == 0} {\n" "set is_different 0\n" "}\n" "}\n" "if {$is_different} {\n" "$element_value configure -state normal\n" "$element_value delete 1.0 end\n" "if {[is_scalar $this_index] == 1} {\n" "set previous_value \"[set_text $this_index]\"\n" "$element_value insert 1.0 \"$previous_value\"\n" "$element_value configure -background white\n" "} \\\n" "\011\011else {\n" "$element_value insert 1.0 \"[set_text $this_index]\"\n" "$element_value configure -state disabled -background gray\n" "}\n" "set current_element $this_element\n" "set add_menu_list [add_menu_items $current_element]\n" ".mbar.add.menu delete 0 end\n" "if {[llength $add_menu_list] > 0} {\n" "foreach item $add_menu_list {\n" ".mbar.add.menu add command -label $item -command \"add_element $item\"\n" "}\n" ".mbar.add.menu add command -label \"(All of the above)\" -command {add_all}\n" "bind .mbar.add.menu <> {tip .mbar.add.menu}\n" "} \\\n" "\011\011else {\n" ".mbar.add.menu add command -label \"Enter value below\" -command {}\n" "}\n" "if {[string compare [wm state .help] \"normal\"] == 0} {\n" ".help.text.text delete 1.0 end\n" ".help.text.text insert end \"[help_text]\"\n" "}\n" "}\n" "}\n" "proc ScrolledListbox { parent args } {\n" "frame $parent\n" "eval {listbox $parent.list \\\n" "\011\011-selectmode \"single\" \\\n" "\011\011-yscrollcommand [list $parent.sy set] \\\n" "\011\011-relief flat \\\n" "\011\011} $args\n" "scrollbar $parent.sy -orient vertical -width 10 -command [list $parent.list yview]\n" "pack $parent.sy -side right -fill y\n" "pack $parent.list -side left -fill both -expand true\n" "}\n" "proc ScrolledText { f width height } {\n" "frame $f\n" "text $f.text -width $width -height $height \\\n" "\011\011-setgrid true -wrap none -padx 2 \\\n" "\011\011-yscrollcommand [list $f.yscroll set]\n" "scrollbar $f.yscroll -orient vertical -width 10 -command [list $f.text yview]\n" "pack $f.yscroll -side right -fill y\n" "pack $f.text -side left -fill both -expand true\n" "pack $f -side top -fill both -expand true\n" "return $f.text\n" "}\n" "proc Pane_Create {f1 f2 args} {\n" "set t(-orient) vertical\n" "set t(-percent) 0.333\n" "set t(-in) [winfo parent $f1]\n" "array set t $args\n" "set master $t(-in)\n" "upvar #0 Pane$master pane\n" "array set pane [array get t]\n" "set pane(1) $f1\n" "set pane(2) $f2\n" "set pane(grip) [frame $master.grip -background gray50 \\\n" "\011\011-width 10 -height 10 -bd 1 -relief raised \\\n" "\011\011-cursor crosshair]\n" "if {[string match vert* $pane(-orient)]} {\n" "set pane(D) Y\011\011;# Adjust boundary in Y direction\n" "place $pane(1) -in $master -x 0 -rely 0.0 -anchor nw \\\n" "\011\011\011-relwidth 1.0 -height -1\n" "place $pane(2) -in $master -x 0 -rely 1.0 -anchor sw \\\n" "\011\011\011-relwidth 1.0 -height -1\n" "place $pane(grip) -in $master -anchor c -relx 0.9\n" "} else {\n" "set pane(D) X \011\011;# Adjust boundary in X direction\n" "place $pane(1) -in $master -relx 0.0 -y 0 -anchor nw \\\n" "\011\011\011-relheight 1.0 -width -1\n" "place $pane(2) -in $master -relx 1.0 -y 0 -anchor ne \\\n" "\011\011\011-relheight 1.0 -width -1\n" "place $pane(grip) -in $master -anchor c -rely 0.9\n" "}\n" "$master configure -background black\n" "bind $master [list PaneGeometry $master]\n" "bind $pane(grip) \\\n" "\011\011[list PaneDrag $master %$pane(D)]\n" "bind $pane(grip) \\\n" "\011\011[list PaneDrag $master %$pane(D)]\n" "bind $pane(grip) \\\n" "\011\011[list PaneStop $master]\n" "PaneGeometry $master\n" "}\n" "proc PaneDrag {master D} {\n" "upvar #0 Pane$master pane\n" "if [info exists pane(lastD)] {\n" "set delta [expr double($pane(lastD) - $D) \\\n" "\011\011\011\011\011\011\011\011\011/ $pane(size)]\n" "set pane(-percent) [expr $pane(-percent) - $delta]\n" "if {$pane(-percent) < 0.0} {\n" "set pane(-percent) 0.0\n" "} elseif {$pane(-percent) > 1.0} {\n" "set pane(-percent) 1.0\n" "}\n" "PaneGeometry $master\n" "}\n" "set pane(lastD) $D\n" "}\n" "proc PaneStop {master} {\n" "upvar #0 Pane$master pane\n" "catch {unset pane(lastD)}\n" "}\n" "proc PaneGeometry {master} {\n" "upvar #0 Pane$master pane\n" "if {$pane(D) == \"X\"} {\n" "place $pane(1) -relwidth $pane(-percent)\n" "place $pane(2) -relwidth [expr 1.0 - $pane(-percent)]\n" "place $pane(grip) -relx $pane(-percent)\n" "set pane(size) [winfo width $master]\n" "} else {\n" "place $pane(1) -relheight $pane(-percent)\n" "place $pane(2) -relheight [expr 1.0 - $pane(-percent)]\n" "place $pane(grip) -rely $pane(-percent)\n" "set pane(size) [winfo height $master]\n" "}\n" "}\n" "font_apply create\n" "frame .mbar -relief flat -bd 3\n" ".mbar configure -background navy\n" "pack .mbar -side top -expand false -fill x\n" "menubutton .mbar.file -text \"File\" -menu .mbar.file.menu -font menu_font\n" "menubutton .mbar.edit -text \"Edit\" -menu .mbar.edit.menu -font menu_font\n" "menubutton .mbar.view -text \"View\" -menu .mbar.view.menu -font menu_font\n" "menubutton .mbar.add -text \"Add\" -menu .mbar.add.menu -font menu_font\n" "menubutton .mbar.snip -text \"Snippets\" -menu .mbar.snip.menu -font menu_font\n" "menubutton .mbar.help -text \"Help\" -menu .mbar.help.menu -font menu_font\n" ".mbar.file configure -bg navy -fg white\n" ".mbar.edit configure -bg navy -fg white\n" ".mbar.view configure -bg navy -fg white\n" ".mbar.add configure -bg navy -fg white\n" ".mbar.snip configure -bg navy -fg white\n" ".mbar.help configure -bg navy -fg white\n" "pack .mbar.file .mbar.edit .mbar.view .mbar.add .mbar.snip .mbar.help -side left\n" "menu .mbar.file.menu -tearoff false -font menu_font -title \"File\"\n" ".mbar.file.menu configure -bg blue -fg white\n" ".mbar.file.menu add command -label \"Open\" -command {file_open}\n" ".mbar.file.menu add command -label \"Save\" -command {file_save}\n" ".mbar.file.menu add command -label \"Save As\" -command {file_save_as}\n" ".mbar.file.menu add command -label \"Close\" -command {file_close}\n" ".mbar.file.menu add command -label \"Configure\" -command {file_config}\n" ".mbar.file.menu add cascade -label \"Recent\" -menu {.mbar.file.menu.recent}\n" ".mbar.file.menu add command -label \"Quit\" -command {file_quit}\n" "menu .mbar.file.menu.recent -tearoff false -font menu_font -title \"Recent\"\n" ".mbar.file.menu.recent configure -bg blue -fg white\n" "set recent_file [rc_file_spec]\n" "if {[catch \"open $recent_file r\" rf]} {\n" "if {[catch {file mkdir [file dirname $recent_file]} q]} {\n" "if {[string equal windows $tcl_platform(platform)]} {\n" "tk_messageBox -type ok -message \"Warning: the file $recent_file could not be opened because the folder does not exist, and the folder could not be created.\"\n" "}\n" "}\n" "} \\\n" "else {\n" "foreach f [split [read -nonewline $rf] \"\\n\"] {\n" "set f [string trim $f]\n" "if {[file exists $f]} {\n" ".mbar.file.menu.recent add command -label \"$f\" -command [list read_metadata \"$f\"]\n" "}\n" "}\n" "close $rf\n" "}\n" "menu .mbar.edit.menu -tearoff false -font menu_font -title \"Edit\"\n" ".mbar.edit.menu configure -bg blue -fg white\n" ".mbar.edit.menu add command -label \"Cut\" -command {edit_cut .paned.value.text}\n" ".mbar.edit.menu add command -label \"Copy\" -command {edit_copy .paned.value.text}\n" ".mbar.edit.menu add command -label \"Paste\" -command {edit_paste .paned.tree.list}\n" ".mbar.edit.menu add command -label \"Clear\" -command {edit_clear}\n" ".mbar.edit.menu add command -label \"Duplicate\" -command {edit_duplicate}\n" ".mbar.edit.menu add command -label \"Swap\" -command {edit_swap}\n" ".mbar.edit.menu add command -label \"Prune\" -command {edit_prune}\n" ".mbar.edit.menu add command -label \"Replace\" -command {wm deiconify .replace}\n" "menu .mbar.view.menu -tearoff false -font menu_font -title \"View\"\n" ".mbar.view.menu configure -bg blue -fg white\n" ".mbar.view.menu add command -label \"All levels\" -command {view_set 0}\n" ".mbar.view.menu add command -label \"1 level\" -command {view_set 1}\n" ".mbar.view.menu add command -label \"2 levels\" -command {view_set 2}\n" ".mbar.view.menu add command -label \"3 levels\" -command {view_set 3}\n" ".mbar.view.menu add command -label \"Hide\" -command {view_hide}\n" ".mbar.view.menu add command -label \"Show\" -command {view_show}\n" ".mbar.view.menu add command -label \"Wrap\" -command {view_wrap}\n" "menu .mbar.add.menu -tearoff false -font menu_font -title \"Add\"\n" ".mbar.add.menu configure -bg blue -fg white\n" ".mbar.add.menu add command -label \"[root_name]\" -command \"add_element [root_name]\"\n" "menu .mbar.snip.menu -tearoff false -font menu_font -title \"Snippets\"\n" ".mbar.snip.menu configure -bg blue -fg white\n" ".mbar.snip.menu add command -label \"Save as snippet\" -command {snippet_store}\n" ".mbar.snip.menu add separator\n" "set snippet_home [file join [file dirname $recent_file] snippets]\n" "if {[file exists $snippet_home] == 0} {\n" "file mkdir $snippet_home\n" "} \\\n" "\011else {\n" "if {[file isdirectory $snippet_home] == 0} {\n" "set snippet_home [tk_chooseDirectory -title \"Choose a directory for snippets\"]\n" "if {[file exists $snippet_home] == 0} {\n" "file mkdir $snippet_home\n" "}\n" "}\n" "}\n" "proc add_snippets {m d} {\n" "if {[catch \"glob [file join $d *]\" unsorted]} {\n" "} \\\n" "\011else {\n" "set the_list [lsort $unsorted]\n" "foreach snippet $the_list {\n" "set snippet_label [file tail $snippet]\n" "if {[file isdirectory $snippet]} {\n" "set snippet_label [string tolower $snippet_label]\n" "$m add cascade -label $snippet_label -menu $m.$snippet_label\n" "menu $m.$snippet_label -tearoff false -font menu_font\n" "add_snippets $m.$snippet_label $snippet\n" "} \\\n" "\011\011\011else {\n" "$m add command -label $snippet_label -command \"snippet_insert $snippet\"\n" "}\n" "}\n" "}\n" "}\n" "add_snippets .mbar.snip.menu $snippet_home\n" "menu .mbar.help.menu -tearoff false -font menu_font -title \"Help\"\n" ".mbar.help.menu configure -bg blue -fg white\n" ".mbar.help.menu add command -label \"Version\" -command {help_version}\n" ".mbar.help.menu add command -label \"Element\" -command {help_element}\n" ".mbar.help.menu add command -label \"Output\" -command {help_output}\n" ".mbar.help.menu add command -label \"Fonts\" -command {help_fonts}\n" "frame .paned\n" ".paned configure -height 400 -width 640\n" "pack .paned -fill both -expand true\n" "ScrolledListbox .paned.tree -height 10 -setgrid true\n" ".paned.tree configure\n" "set element_list .paned.tree.list\n" "$element_list configure -font list_font\n" "$element_list configure -selectbackground navy -selectforeground white\n" "$element_list configure -exportselection false\n" "bind $element_list {save_current; %W activate @%x,%y; set_current %W}\n" "bind $element_list {view_toggle}\n" "menu .paned.tree.menu -tearoff false -font menu_font -title \"Tree\" -disabledforeground Navy\n" ".paned.tree.menu add command -label \"Element\" -command {} -state disabled\n" ".paned.tree.menu add command -label \"Cut\" -command {edit_cut .paned.tree.list}\n" ".paned.tree.menu add command -label \"Copy\" -command {edit_copy .paned.tree.list}\n" ".paned.tree.menu add command -label \"Paste\" -command {edit_paste .paned.tree.list}\n" ".paned.tree.menu add separator\n" ".paned.tree.menu add command -label \"Duplicate\" -command {edit_duplicate}\n" ".paned.tree.menu add command -label \"Clear\" -command {edit_clear}\n" ".paned.tree.menu add command -label \"Prune\" -command {edit_prune}\n" ".paned.tree.menu add command -label \"Save as snippet\" -command {snippet_store}\n" "bind $element_list {tk_popup .paned.tree.menu %X %Y 0}\n" "ScrolledText .paned.value 64 10\n" ".paned.value configure\n" "set element_value .paned.value.text\n" "$element_value configure -font value_font\n" "$element_value configure -insertbackground DarkRed\n" "$element_value configure -insertborderwidth 0\n" "$element_value configure -insertwidth 3\n" "menu .paned.value.menu -tearoff false -font menu_font -title \"Value\" -disabledforeground Navy\n" ".paned.value.menu add command -label \"Value\" -command {} -state disabled\n" ".paned.value.menu add command -label \"Cut\" -command {tk_textCut .paned.value.text}\n" ".paned.value.menu add command -label \"Copy\" -command {tk_textCopy .paned.value.text}\n" ".paned.value.menu add command -label \"Paste\" -command {tk_textPaste .paned.value.text}\n" ".paned.value.menu add command -label \"Revert\" -command {edit_revert}\n" ".paned.value.menu add command -label \"Wrap\" -command {view_wrap}\n" ".paned.value.menu add command -label \"HardWrap\" -command {hard_wrap}\n" "bind $element_value {tk_popup .paned.value.menu %X %Y 0}\n" "Pane_Create .paned.tree .paned.value -in .paned -orient horizontal\n" "foreach w {.mbar.file.menu .mbar.edit.menu .mbar.view.menu .mbar.add.menu .mbar.snip.menu .mbar.help.menu .paned.tree.menu .paned.value.menu} {\n" "bind $w <> {tip %W}\n" "}\n" "frame .tf -relief flat -bd 1\n" ".tf config -background navy\n" "pack .tf -side bottom -expand false -fill x\n" "label .tf.tip -bg navy -fg white -text \"Tkme: Tk Metadata Editor by Peter Schweitzer (USGS)\"\n" "pack .tf.tip -fill both -expand false -side left\n" "toplevel .help\n" "frame .help.mbar -relief flat -bd 3\n" ".help.mbar config -background navy\n" "pack .help.mbar -side top -expand false -fill x\n" "button .help.mbar.close -text \"Close\" -font menu_font -bg navy -fg white -highlightthickness 0 -relief flat -command {help_close}\n" "menubutton .help.mbar.edit -text \"Edit\" -menu .help.mbar.edit.menu -bg navy -fg white -highlightthickness 0 -relief flat -font menu_font\n" "menu .help.mbar.edit.menu -tearoff false -bg blue -fg white -font menu_font -title \"Help-Edit\"\n" ".help.mbar.edit.menu add command -label \"Copy\" -command {tk_textCopy .help.text.text}\n" ".help.mbar.edit.menu add command -label \"Wrap\" -command {help_wrap}\n" "pack .help.mbar.close .help.mbar.edit -side left\n" "ScrolledText .help.text 40 10\n" ".help.text.text configure -font help_font\n" "pack .help.text -fill both -expand true\n" ".help.text.text configure -tabs {32}\n" ".help.text.text configure -wrap none\n" "menu .help.text.menu -tearoff false -font menu_font -title \"Help-context\"\n" ".help.text.menu add command -label \"Copy\" -command {tk_textCopy .help.text.text}\n" ".help.text.menu add command -label \"Wrap\" -command {help_wrap}\n" "bind .help.text.text {tk_popup .help.text.menu %X %Y 0}\n" "wm protocol .help WM_DELETE_WINDOW {wm withdraw .help}\n" "wm withdraw .help\n" "toplevel .output\n" "frame .output.mbar -relief flat -bd 3\n" ".output.mbar config -background navy\n" "pack .output.mbar -side top -expand false -fill x\n" "menubutton .output.mbar.view -text \"View\" -bg navy -fg white -menu .output.mbar.view.menu -font menu_font\n" "button .output.mbar.edit -text \"Edit\" -font menu_font -bg navy -fg white -relief flat -highlightthickness 0 -command {output_edit}\n" "pack .output.mbar.view .output.mbar.edit -side left\n" "menu .output.mbar.view.menu -bg blue -fg white -tearoff false -font menu_font -title \"Output-View\"\n" ".output.mbar.view.menu add command -label \"Update\" -command {output_update}\n" ".output.mbar.view.menu add command -label \"Wrap\" -command {output_wrap}\n" ".output.mbar.view.menu add command -label \"Dismiss\" -command {output_close}\n" "ScrolledText .output.text 80 20\n" ".output.text.text configure -font output_font\n" ".output.text.text configure -selectbackground navy -selectforeground white\n" ".output.text.text configure -exportselection false\n" "pack .output.text -fill both -expand true\n" ".output.text.text configure -tabs {32}\n" ".output.text.text configure -wrap none\n" ".output.text.text configure -insertbackground DarkRed\n" ".output.text.text configure -insertborderwidth 0\n" ".output.text.text configure -insertwidth 3\n" "bindtags .output.text.text {.output.text.text .output all}\n" "bind .output.text.text {}\n" "bind .output.text.text <> {}\n" "bind .output.text.text <> {tk_textCopy %W}\n" "bind .output.text.text <> {}\n" "if {[string equal $tcl_version 8.3]} {\n" "bind .output.text.text <1> { tkTextButton1 %W %x %y; %W tag remove sel 0.0 end }\n" "bind .output.text.text { set tkPriv(x) %x; set tkPriv(y) %y; tkTextSelectTo %W %x %y }\n" "bind .output.text.text { set tkPriv(selectMode) word; tkTextSelectTo %W %x %y; catch {%W mark set insert sel.first} }\n" "bind .output.text.text { set tkPriv(selectMode) line; tkTextSelectTo %W %x %y; catch {%W mark set insert sel.first} }\n" "bind .output.text.text { tkTextResetAnchor %W @%x,%y; set tkPriv(selectMode) char; tkTextSelectTo %W %x %y }\n" "bind .output.text.text \011{ set tkPriv(selectMode) word; tkTextSelectTo %W %x %y }\n" "bind .output.text.text \011{ set tkPriv(selectMode) line; tkTextSelectTo %W %x %y }\n" "bind .output.text.text { set tkPriv(x) %x; set tkPriv(y) %y; tkTextAutoScan %W }\n" "bind .output.text.text { tkCancelRepeat }\n" "bind .output.text.text { tkCancelRepeat }\n" "bind .output.text.text { %W mark set insert @%x,%y }\n" "bind .output.text.text { tkTextSetCursor %W insert-1c }\n" "bind .output.text.text { tkTextSetCursor %W insert+1c }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextUpDownLine %W -1] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextUpDownLine %W 1] }\n" "bind .output.text.text { tkTextKeySelect %W [%W index {insert - 1c}] }\n" "bind .output.text.text { tkTextKeySelect %W [%W index {insert + 1c}] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextUpDownLine %W -1] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextUpDownLine %W 1] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextNextWord %W insert] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextPrevPara %W insert] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextNextPara %W insert] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextNextWord %W insert] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextPrevPara %W insert] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextNextPara %W insert] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextScrollPages %W -1] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextScrollPages %W -1] }\n" "bind .output.text.text { tkTextSetCursor %W [tkTextScrollPages %W 1] }\n" "bind .output.text.text { tkTextKeySelect %W [tkTextScrollPages %W 1] }\n" "bind .output.text.text { %W xview scroll -1 page }\n" "bind .output.text.text { %W xview scroll 1 page }\n" "bind .output.text.text { tkTextSetCursor %W {insert linestart} }\n" "bind .output.text.text { tkTextKeySelect %W {insert linestart} }\n" "bind .output.text.text { tkTextSetCursor %W {insert lineend} }\n" "bind .output.text.text { tkTextKeySelect %W {insert lineend} }\n" "bind .output.text.text { tkTextSetCursor %W 1.0 }\n" "bind .output.text.text { tkTextKeySelect %W 1.0 }\n" "bind .output.text.text { tkTextSetCursor %W {end - 1 char} }\n" "bind .output.text.text { tkTextKeySelect %W {end - 1 char} }\n" "}\n" "if {[string equal $tcl_version 8.4]} {\n" "bind .output.text.text <1> { tk::TextButton1 %W %x %y; %W tag remove sel 0.0 end }\n" "bind .output.text.text { set tk::Priv(x) %x; set tk::Priv(y) %y; tk::TextSelectTo %W %x %y }\n" "bind .output.text.text { set tk::Priv(selectMode) word; tk::TextSelectTo %W %x %y; catch {%W mark set insert sel.last} }\n" "bind .output.text.text { set tk::Priv(selectMode) line; tk::TextSelectTo %W %x %y; catch {%W mark set insert sel.last} }\n" "bind .output.text.text { tk::TextResetAnchor %W @%x,%y; set tk::Priv(selectMode) char; tk::TextSelectTo %W %x %y }\n" "bind .output.text.text \011{ set tk::Priv(selectMode) word; tk::TextSelectTo %W %x %y 1 }\n" "bind .output.text.text \011{ set tk::Priv(selectMode) line; tk::TextSelectTo %W %x %y }\n" "bind .output.text.text { set tk::Priv(x) %x; set tk::Priv(y) %y; tk::TextAutoScan %W }\n" "bind .output.text.text { tk::CancelRepeat }\n" "bind .output.text.text { tk::CancelRepeat }\n" "bind .output.text.text { %W mark set insert @%x,%y }\n" "bind .output.text.text { tk::TextSetCursor %W insert-1c }\n" "bind .output.text.text { tk::TextSetCursor %W insert+1c }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] }\n" "bind .output.text.text { tk::TextKeySelect %W [%W index {insert - 1c}] }\n" "bind .output.text.text { tk::TextKeySelect %W [%W index {insert + 1c}] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextUpDownLine %W 1] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextNextWord %W insert] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextPrevPara %W insert] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextNextPara %W insert] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextNextWord %W insert] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextPrevPara %W insert] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextNextPara %W insert] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextScrollPages %W -1] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextScrollPages %W -1] }\n" "bind .output.text.text { tk::TextSetCursor %W [tk::TextScrollPages %W 1] }\n" "bind .output.text.text { tk::TextKeySelect %W [tk::TextScrollPages %W 1] }\n" "bind .output.text.text { %W xview scroll -1 page }\n" "bind .output.text.text { %W xview scroll 1 page }\n" "bind .output.text.text { tk::TextSetCursor %W {insert linestart} }\n" "bind .output.text.text { tk::TextKeySelect %W {insert linestart} }\n" "bind .output.text.text { tk::TextSetCursor %W {insert lineend} }\n" "bind .output.text.text { tk::TextKeySelect %W {insert lineend} }\n" "bind .output.text.text { tk::TextSetCursor %W 1.0 }\n" "bind .output.text.text { tk::TextKeySelect %W 1.0 }\n" "bind .output.text.text { tk::TextSetCursor %W {end - 1 char} }\n" "bind .output.text.text { tk::TextKeySelect %W {end - 1 char} }\n" "}\n" "wm protocol .output WM_DELETE_WINDOW {wm withdraw .output}\n" "wm withdraw .output\n" "button .output.mbar.find -bg navy -fg white -relief flat -highlightthickness 0 -text \"Find:\" -command {output_search \"$search_string\"}\n" "entry .output.mbar.entry -textvariable search_string\n" "bind .output.mbar.entry {output_search \"$search_string\"}\n" "pack .output.mbar.find .output.mbar.entry -side left\n" "proc replace_text {find_text find_case repl_text repl_which} {\n" "global changed element_value element_list\n" "set where [$element_value index insert]\n" "save_current\n" "replace \"$find_text\" $find_case \"$repl_text\" \"$repl_which\"\n" "set_current $element_list\n" "$element_value mark set insert $where\n" "}\n" "set repl_which this\n" "toplevel .replace\n" "label .replace.intro -text \"Change text in element values\"\n" "radiobutton .replace.this -text \"just this element\" -variable repl_which -value this\n" "radiobutton .replace.within -text \"this subtree\" -variable repl_which -value within\n" "radiobutton .replace.all -text \"the whole file\" -variable repl_which -value all\n" "label .replace.findlabel -text \"Find what:\"\n" "entry .replace.findentry -textvariable find_text\n" "label .replace.repllabel -text \"Replace with:\"\n" "entry .replace.replentry -textvariable repl_text\n" "checkbutton .replace.usecase -text \"Match Case\" -variable find_case\n" "button .replace.exec -text \"Replace All\" -command {replace_text $find_text $find_case $repl_text $repl_which}\n" "button .replace.dismiss -text \"Close\" -command {wm withdraw .replace}\n" "grid .replace.intro -columnspan 2 -pady 8 -padx 4\n" "grid .replace.findlabel .replace.findentry -padx 4 -pady 2\n" "grid .replace.repllabel .replace.replentry -padx 4 -pady 2\n" "grid .replace.findlabel -sticky w\n" "grid .replace.repllabel -sticky w\n" "grid .replace.this .replace.usecase -padx 4 -pady 2\n" "grid .replace.within .replace.exec -padx 4 -pady 2\n" "grid .replace.all .replace.dismiss -padx 4 -pady 2\n" "grid .replace.this -sticky w\n" "grid .replace.within -sticky w\n" "grid .replace.all -sticky w\n" "grid .replace.exec -sticky e\n" "grid .replace.dismiss -sticky e\n" "wm title .replace \"Tkme: Replace\"\n" "wm protocol .replace WM_DELETE_WINDOW {wm withdraw .replace}\n" "wm withdraw .replace\n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "event add <> \n" "bind . <> {list_up}\n" "bind . <> {list_down}\n" "bind . <> {list_home}\n" "bind . <> {list_end}\n" "bind . <> {list_pageup}\n" "bind . <> {list_pagedown}\n" "bind . <> {view_hide}\n" "bind . <> {view_show}\n" "bind . <> {list_expand}\n" "bind . <> {list_collapse}\n" "bind . <> {file_open}\n" "bind . <> {file_save}\n" "bind . <> {file_quit}\n" "bind Text <> {edit_cut %W}\n" "bind Text <> {edit_copy %W}\n" "bind Text <> {edit_paste %W}\n" "bind . <> {edit_duplicate}\n" "bind . <> {edit_swap}\n" "bind . <> {edit_prune}\n" "bind . <> {help_element}\n" "bind . <> {help_output}\n" "bind . <> {add_all}\n" "bind . <> {today}\n" "if {[string equal $tcl_version 8.3]} {\n" "bind $element_value { tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind $element_value { tkTextSetCursor %W [tkTextNextWord %W insert] }\n" "bind $element_value { tkTextSetCursor %W [tkTextPrevPara %W insert] }\n" "bind $element_value { tkTextSetCursor %W [tkTextNextPara %W insert] }\n" "bind $element_value { tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind $element_value { tkTextKeySelect %W [tkTextNextWord %W insert] }\n" "bind $element_value { tkTextKeySelect %W [tkTextPrevPara %W insert] }\n" "bind $element_value { tkTextKeySelect %W [tkTextNextPara %W insert] }\n" "bind $element_value { tkTextSetCursor %W 1.0 }\n" "bind $element_value { tkTextKeySelect %W 1.0 }\n" "bind $element_value { tkTextSetCursor %W {end - 1 char} }\n" "bind $element_value { tkTextKeySelect %W {end - 1 char} }\n" "}\n" "if {[string equal $tcl_version 8.4]} {\n" "bind $element_value { tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind $element_value { tk::TextSetCursor %W [tk::TextNextWord %W insert] }\n" "bind $element_value { tk::TextSetCursor %W [tk::TextPrevPara %W insert] }\n" "bind $element_value { tk::TextSetCursor %W [tk::TextNextPara %W insert] }\n" "bind $element_value { tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] }\n" "bind $element_value { tk::TextKeySelect %W [tk::TextNextWord %W insert] }\n" "bind $element_value { tk::TextKeySelect %W [tk::TextPrevPara %W insert] }\n" "bind $element_value { tk::TextKeySelect %W [tk::TextNextPara %W insert] }\n" "bind $element_value { tk::TextSetCursor %W 1.0 }\n" "bind $element_value { tk::TextKeySelect %W 1.0 }\n" "bind $element_value { tk::TextSetCursor %W {end - 1 char} }\n" "bind $element_value { tk::TextKeySelect %W {end - 1 char} }\n" "}\n" "bind . {focus .paned.value.text}\n" "bind . {.paned.value.text configure -insertbackground DarkRed -insertborderwidth 0 -insertwidth 3}\n" "if {[string equal $tcl_version 8.3]} {\n" "bind . {tkTextSetCursor .paned.value.text insert}\n" "}\n" "if {[string equal $tcl_version 8.4]} {\n" "bind . {tk::TextSetCursor .paned.value.text insert}\n" "}\n" "bind . {topology}\n" "wm protocol . WM_DELETE_WINDOW {file_quit}\n" "wm title . \"Tkme: $file_name\"\n" "read_metadata [cmdline_file]\n" "if {[config_read]} {\n" ".mbar.file.menu entryconfigure 4 -state disabled\n" "}\n" "if {[string length [cfg_messages]] > 0 || [string length [ext_messages]] > 0} {\n" "toplevel .messages\n" "frame .messages.mbar -relief flat -bd 3\n" ".messages.mbar config -background navy\n" "pack .messages.mbar -side top -expand false -fill x\n" "button .messages.mbar.close -text \"Close\" -font menu_font -bg navy -fg white -relief flat -highlightthickness 0 -command {wm withdraw .messages}\n" "pack .messages.mbar.close -side left\n" "ScrolledText .messages.text 80 20\n" ".messages.text.text configure -font output_font\n" ".messages.text.text configure -selectbackground navy -selectforeground white\n" ".messages.text.text configure -exportselection false\n" "pack .messages.text -fill both -expand true\n" ".messages.text.text configure -wrap word\n" "if {[string length [cfg_messages]] > 0} {\n" ".messages.text.text insert end \"Errors or warnings while reading the config file:\\n\"\n" ".messages.text.text insert end \"[cfg_messages]\"\n" "}\n" "if {[string length [ext_messages]] > 0} {\n" ".messages.text.text insert end \"Errors or warnings while reading extension files:\\n\"\n" ".messages.text.text insert end \"[ext_messages]\"\n" "}\n" "}\n" "set geometry_file [file join [file dirname $recent_file] geometry.tcl]\n" "if {[file exists $geometry_file]} {\n" "source $geometry_file\n" "}\n" ; struct EtFile { char *zName; unsigned char *zData; int nData; int shrouded; struct EtFile *pNext; }; static struct EtFile Et_FileSet[] = { { "/usr/lib/tcl8.4/auto.tcl", Et_zFile0, sizeof(Et_zFile0)-1, 0, 0 }, { "/usr/lib/tcl8.4/history.tcl", Et_zFile1, sizeof(Et_zFile1)-1, 0, 0 }, { "/usr/lib/tcl8.4/init.tcl", Et_zFile2, sizeof(Et_zFile2)-1, 0, 0 }, { "/usr/lib/tcl8.4/ldAout.tcl", Et_zFile3, sizeof(Et_zFile3)-1, 0, 0 }, { "/usr/lib/tcl8.4/package.tcl", Et_zFile4, sizeof(Et_zFile4)-1, 0, 0 }, { "/usr/lib/tcl8.4/parray.tcl", Et_zFile5, sizeof(Et_zFile5)-1, 0, 0 }, { "/usr/lib/tcl8.4/safe.tcl", Et_zFile6, sizeof(Et_zFile6)-1, 0, 0 }, { "/usr/lib/tcl8.4/tclIndex", Et_zFile7, sizeof(Et_zFile7)-1, 0, 0 }, { "/usr/lib/tcl8.4/word.tcl", Et_zFile8, sizeof(Et_zFile8)-1, 0, 0 }, { "/usr/lib/tk8.4/bgerror.tcl", Et_zFile9, sizeof(Et_zFile9)-1, 0, 0 }, { "/usr/lib/tk8.4/button.tcl", Et_zFile10, sizeof(Et_zFile10)-1, 0, 0 }, { "/usr/lib/tk8.4/choosedir.tcl", Et_zFile11, sizeof(Et_zFile11)-1, 0, 0 }, { "/usr/lib/tk8.4/clrpick.tcl", Et_zFile12, sizeof(Et_zFile12)-1, 0, 0 }, { "/usr/lib/tk8.4/comdlg.tcl", Et_zFile13, sizeof(Et_zFile13)-1, 0, 0 }, { "/usr/lib/tk8.4/console.tcl", Et_zFile14, sizeof(Et_zFile14)-1, 0, 0 }, { "/usr/lib/tk8.4/dialog.tcl", Et_zFile15, sizeof(Et_zFile15)-1, 0, 0 }, { "/usr/lib/tk8.4/entry.tcl", Et_zFile16, sizeof(Et_zFile16)-1, 0, 0 }, { "/usr/lib/tk8.4/focus.tcl", Et_zFile17, sizeof(Et_zFile17)-1, 0, 0 }, { "/usr/lib/tk8.4/listbox.tcl", Et_zFile18, sizeof(Et_zFile18)-1, 0, 0 }, { "/usr/lib/tk8.4/menu.tcl", Et_zFile19, sizeof(Et_zFile19)-1, 0, 0 }, { "/usr/lib/tk8.4/mkpsenc.tcl", Et_zFile20, sizeof(Et_zFile20)-1, 0, 0 }, { "/usr/lib/tk8.4/msgbox.tcl", Et_zFile21, sizeof(Et_zFile21)-1, 0, 0 }, { "/usr/lib/tk8.4/obsolete.tcl", Et_zFile22, sizeof(Et_zFile22)-1, 0, 0 }, { "/usr/lib/tk8.4/optMenu.tcl", Et_zFile23, sizeof(Et_zFile23)-1, 0, 0 }, { "/usr/lib/tk8.4/palette.tcl", Et_zFile24, sizeof(Et_zFile24)-1, 0, 0 }, { "/usr/lib/tk8.4/panedwindow.tcl", Et_zFile25, sizeof(Et_zFile25)-1, 0, 0 }, { "/usr/lib/tk8.4/pkgIndex.tcl", Et_zFile26, sizeof(Et_zFile26)-1, 0, 0 }, { "/usr/lib/tk8.4/safetk.tcl", Et_zFile27, sizeof(Et_zFile27)-1, 0, 0 }, { "/usr/lib/tk8.4/scale.tcl", Et_zFile28, sizeof(Et_zFile28)-1, 0, 0 }, { "/usr/lib/tk8.4/scrlbar.tcl", Et_zFile29, sizeof(Et_zFile29)-1, 0, 0 }, { "/usr/lib/tk8.4/spinbox.tcl", Et_zFile30, sizeof(Et_zFile30)-1, 0, 0 }, { "/usr/lib/tk8.4/tclIndex", Et_zFile31, sizeof(Et_zFile31)-1, 0, 0 }, { "/usr/lib/tk8.4/tearoff.tcl", Et_zFile32, sizeof(Et_zFile32)-1, 0, 0 }, { "/usr/lib/tk8.4/text.tcl", Et_zFile33, sizeof(Et_zFile33)-1, 0, 0 }, { "/usr/lib/tk8.4/tk.tcl", Et_zFile34, sizeof(Et_zFile34)-1, 0, 0 }, { "/usr/lib/tk8.4/tkfbox.tcl", Et_zFile35, sizeof(Et_zFile35)-1, 0, 0 }, { "/usr/lib/tk8.4/unsupported.tcl", Et_zFile36, sizeof(Et_zFile36)-1, 0, 0 }, { "/usr/lib/tk8.4/xmfbox.tcl", Et_zFile37, sizeof(Et_zFile37)-1, 0, 0 }, { "tkmerc.tcl", Et_zFile38, sizeof(Et_zFile38)-1, 0, 0 }, {0, 0}}; static struct EtFile *Et_FileHashTable[79]; /* The following copyright notice applies to code generated by ** "mktclapp". The "mktclapp" program itself is covered by the ** GNU Public License. ** ** Copyright (c) 1998 D. Richard Hipp ** ** The author hereby grants permission to use, copy, modify, distribute, ** and license this software and its documentation for any purpose, provided ** that existing copyright notices are retained in all copies and that this ** notice is included verbatim in any distributions. No written agreement, ** license, or royalty fee is required for any of the authorized uses. ** Modifications to this software may be copyrighted by their authors ** and need not follow the licensing terms described here, provided that ** the new terms are clearly indicated on the first page of each file where ** they apply. ** ** In no event shall the author or the distributors be liable to any party ** for direct, indirect, special, incidental, or consequential damages ** arising out of the use of this software, its documentation, or any ** derivatives thereof, even if the author has been advised of the ** possibility of such damage. The author and distributors specifically ** disclaim any warranties, including but not limited to the implied ** warranties of merchantability, fitness for a particular purpose, and ** non-infringment. This software is provided at no fee on an ** "as is" basis. The author and/or distritutors have no obligation ** to provide maintenance, support, updates, enhancements and/or ** modifications. ** ** GOVERNMENT USE: If you are acquiring this software on behalf of the ** U.S. government, the Government shall have only "Restricted Rights" ** in the software and related documentation as defined in the Federal ** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you ** are acquiring the software on behalf of the Department of Defense, the ** software shall be classified as "Commercial Computer Software" and the ** Government shall have only "Restricted Rights" as defined in Clause ** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the ** author grants the U.S. Government and others acting in its behalf ** permission to use and distribute the software in accordance with the ** terms specified in this license. */ #include #include #include #include #include #include #include #include /* Include either the Tcl or the Tk header file. Use the "Internal" ** version of the header file if and only if we are generating an ** extension that is linking against the Stub library. ** Many installations do not have the internal header files ** available, so using the internal headers only when absolutely ** necessary will help to reduce compilation problems. */ #if ET_EXTENSION && defined(TCL_USE_STUBS) # if ET_ENABLE_TK # include # else # include # endif #else # if ET_ENABLE_TK # include # else # include # endif #endif /* ** ET_WIN32 is true if we are running Tk under windows. The ** module will define __WIN32__ for us if we are compiling ** for windows. */ #if defined(__WIN32__) && ET_ENABLE_TK # define ET_WIN32 1 # define ET_DOS 1 # include #else # ifdef __WIN32__ # define ET_DOS 1 # else # define ET_DOS 0 # endif # define ET_WIN32 0 #endif /* ** Always disable ET_AUTO_FORK under windows. Windows doesn't ** fork well. */ #if defined(__WIN32__) # undef ET_AUTO_FORK # define ET_AUTO_FORK 0 #endif /* ** Omit under windows. But we need it for Unix. */ #if !defined(__WIN32__) # include #endif /* ** The Tcl*InsertProc functions allow the system calls "stat", ** "access" and "open" to be overloaded. This in turns allows us ** to substituted compiled-in strings for files in the filesystem. ** But the Tcl*InsertProc functions are only available in Tcl8.0.3 ** and later. ** ** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing ** with Tcl8.0.3 or later. */ #if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 || TCL_RELEASE_SERIAL>=3) # define ET_HAVE_INSERTPROC #endif /* ** The Tk_InitConsoleChannels() function is not available in older ** versions of Tk. (I think.) So turn it off for versions prior ** to Tk8.3 */ #if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=3 # define ET_USE_BUILTIN_CONSOLE 1 #else # define ET_USE_BUILTIN_CONSOLE 0 #endif /* ** If we are using the Tcl*InsertProc() functions, we should provide ** prototypes for them. But the prototypes are in the tclInt.h include ** file, which we don't want to require the user to have on hand. So ** we provide our own prototypes here. ** ** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required ** anyway, so these prototypes are not included if TCL_USE_STUBS is ** defined. */ #if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS) #ifdef __cplusplus extern "C" int TclStatInsertProc(int (*)(char*, struct stat *)); extern "C" int TclAccessInsertProc(int (*)(char*, int)); extern "C" int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*, char*,int)); #else extern int TclStatInsertProc(int (*)(char*, struct stat *)); extern int TclAccessInsertProc(int (*)(char*, int)); extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*, char*,int)); #endif #endif /* ** Don't allow Win32 applications to read from stdin. Nor ** programs that automatically go into the background. Force ** the use of a console in these cases. */ #if (ET_WIN32 || ET_AUTO_FORK) && ET_READ_STDIN # undef ET_READ_STDIN # undef ET_CONSOLE # undef ET_TKCONSOLE # define ET_READ_STDIN 0 # define ET_CONSOLE 0 # define ET_TKCONSOLE 1 #endif /* ** The console won't work without Tk. */ #if ET_ENABLE_TK==0 && (ET_CONSOLE || ET_TKCONSOLE) # undef ET_CONSOLE # define ET_CONSOLE 0 # undef ET_TKCONSOLE # define ET_TKCONSOLE 0 # undef ET_READ_STDIN # define ET_READ_STDIN 1 #endif /* ** Use the mktclapp console if the built-in console is missing */ #if ET_TKCONSOLE && !ET_USE_BUILTIN_CONSOLE # undef ET_TKCONSOLE # define ET_TKCONSOLE 0 # undef ET_CONSOLE # define ET_CONSOLE 1 #endif /* ** Disable the built-in console unless the -tkconsole switch is used. */ #if !ET_TKCONSOLE && ET_USE_BUILTIN_CONSOLE # undef ET_USE_BUILTIN_CONSOLE # define ET_USE_BUILTIN_CONSOLE 0 #endif /* ** We MUST start using Tcl_GetStringResult() in Tcl8.3 ** But these functions didn't exists in Tcl 7.6. So make ** them macros. */ #if TCL_MAJOR_VERSION<8 # define Tcl_GetStringResult(I) ((I)->result) #endif /* ** Set ET_HAVE_OBJ to true if we are able to link against the ** new Tcl_Obj interface. This is only the case for Tcl version ** 8.0 and later. */ #if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8 # define ET_HAVE_OBJ 1 #else # define ET_HAVE_OBJ 0 #endif /* ** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1 ** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X */ #if ET_HAVE_OBJ && TCL_MINOR_VERSION==0 # define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj #endif /* ** Tcl code to implement the console. ** ** This code is written and tested separately, then run through ** "mktclapp -stringify" and then pasted in here. */ #if ET_ENABLE_TK && !ET_EXTENSION static char zEtConsole[] = "proc console:create {w prompt title} {\n" "upvar #0 $w.t v\n" "if {[winfo exists $w]} {destroy $w}\n" "if {[info exists v]} {unset v}\n" "toplevel $w\n" "wm title $w $title\n" "wm iconname $w $title\n" "frame $w.mb -bd 2 -relief raised\n" "pack $w.mb -side top -fill x\n" "menubutton $w.mb.file -text File -menu $w.mb.file.m\n" "menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\n" "pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\n" "set m [menu $w.mb.file.m]\n" "$m add command -label {Close} -command \"destroy $w\"\n" "$m add command -label {Exit} -command exit\n" "console:create_child $w $prompt $w.mb.edit.m\n" "}\n" "proc console:create_child {w prompt editmenu} {\n" "upvar #0 $w.t v\n" "if {$editmenu!=\"\"} {\n" "set m [menu $editmenu]\n" "$m add command -label Cut -command \"console:Cut $w.t\"\n" "$m add command -label Copy -command \"console:Copy $w.t\"\n" "$m add command -label Paste -command \"console:Paste $w.t\"\n" "$m add command -label {Clear Screen} -command \"console:Clear $w.t\"\n" "$m add separator\n" "$m add command -label {Source...} -command \"console:SourceFile $w.t\"\n" "$m add command -label {Save As...} -command \"console:SaveFile $w.t\"\n" "catch {$editmenu config -postcommand \"console:EnableEditMenu $w\"}\n" "}\n" "scrollbar $w.sb -orient vertical -command \"$w.t yview\"\n" "pack $w.sb -side right -fill y\n" "text $w.t -font fixed -yscrollcommand \"$w.sb set\"\n" "pack $w.t -side right -fill both -expand 1\n" "bindtags $w.t Console\n" "set v(editmenu) $editmenu\n" "set v(text) $w.t\n" "set v(history) 0\n" "set v(historycnt) 0\n" "set v(current) -1\n" "set v(prompt) $prompt\n" "set v(prior) {}\n" "set v(plength) [string length $v(prompt)]\n" "set v(x) 0\n" "set v(y) 0\n" "$w.t mark set insert end\n" "$w.t tag config ok -foreground blue\n" "$w.t tag config err -foreground red\n" "$w.t insert end $v(prompt)\n" "$w.t mark set out 1.0\n" "catch {rename puts console:oldputs$w}\n" "proc puts args [format {\n" "if {![winfo exists %s]} {\n" "rename puts {}\n" "rename console:oldputs%s puts\n" "return [uplevel #0 puts $args]\n" "}\n" "switch -glob -- \"[llength $args] $args\" {\n" "{1 *} {\n" "set msg [lindex $args 0]\\n\n" "set tag ok\n" "}\n" "{2 stdout *} {\n" "set msg [lindex $args 1]\\n\n" "set tag ok\n" "}\n" "{2 stderr *} {\n" "set msg [lindex $args 1]\\n\n" "set tag err\n" "}\n" "{2 -nonewline *} {\n" "set msg [lindex $args 1]\n" "set tag ok\n" "}\n" "{3 -nonewline stdout *} {\n" "set msg [lindex $args 2]\n" "set tag ok\n" "}\n" "{3 -nonewline stderr *} {\n" "set msg [lindex $args 2]\n" "set tag err\n" "}\n" "default {\n" "uplevel #0 console:oldputs%s $args\n" "return\n" "}\n" "}\n" "console:Puts %s $msg $tag\n" "} $w $w $w $w.t]\n" "after idle \"focus $w.t\"\n" "}\n" "bind Console <1> {console:Button1 %W %x %y}\n" "bind Console {console:B1Motion %W %x %y}\n" "bind Console {console:B1Leave %W %x %y}\n" "bind Console {console:cancelMotor %W}\n" "bind Console {console:cancelMotor %W}\n" "bind Console {console:Insert %W %A}\n" "bind Console {console:Left %W}\n" "bind Console {console:Left %W}\n" "bind Console {console:Right %W}\n" "bind Console {console:Right %W}\n" "bind Console {console:Backspace %W}\n" "bind Console {console:Backspace %W}\n" "bind Console {console:Delete %W}\n" "bind Console {console:Delete %W}\n" "bind Console {console:Home %W}\n" "bind Console {console:Home %W}\n" "bind Console {console:End %W}\n" "bind Console {console:End %W}\n" "bind Console {console:Enter %W}\n" "bind Console {console:Enter %W}\n" "bind Console {console:Prior %W}\n" "bind Console {console:Prior %W}\n" "bind Console {console:Next %W}\n" "bind Console {console:Next %W}\n" "bind Console {console:EraseEOL %W}\n" "bind Console <> {console:Cut %W}\n" "bind Console <> {console:Copy %W}\n" "bind Console <> {console:Paste %W}\n" "bind Console <> {console:Clear %W}\n" "proc console:Puts {w t tag} {\n" "set nc [string length $t]\n" "set endc [string index $t [expr $nc-1]]\n" "if {$endc==\"\\n\"} {\n" "if {[$w index out]<[$w index {insert linestart}]} {\n" "$w insert out [string range $t 0 [expr $nc-2]] $tag\n" "$w mark set out {out linestart +1 lines}\n" "} else {\n" "$w insert out $t $tag\n" "}\n" "} else {\n" "if {[$w index out]<[$w index {insert linestart}]} {\n" "$w insert out $t $tag\n" "} else {\n" "$w insert out $t\\n $tag\n" "$w mark set out {out -1 char}\n" "}\n" "}\n" "$w yview insert\n" "}\n" "proc console:Insert {w a} {\n" "$w insert insert $a\n" "$w yview insert\n" "}\n" "proc console:Left {w} {\n" "upvar #0 $w v\n" "scan [$w index insert] %d.%d row col\n" "if {$col>$v(plength)} {\n" "$w mark set insert \"insert -1c\"\n" "}\n" "}\n" "proc console:Backspace {w} {\n" "upvar #0 $w v\n" "scan [$w index insert] %d.%d row col\n" "if {$col>$v(plength)} {\n" "$w delete {insert -1c}\n" "}\n" "}\n" "proc console:EraseEOL {w} {\n" "upvar #0 $w v\n" "scan [$w index insert] %d.%d row col\n" "if {$col>=$v(plength)} {\n" "$w delete insert {insert lineend}\n" "}\n" "}\n" "proc console:Right {w} {\n" "$w mark set insert \"insert +1c\"\n" "}\n" "proc console:Delete w {\n" "$w delete insert\n" "}\n" "proc console:Home w {\n" "upvar #0 $w v\n" "scan [$w index insert] %d.%d row col\n" "$w mark set insert $row.$v(plength)\n" "}\n" "proc console:End w {\n" "$w mark set insert {insert lineend}\n" "}\n" "proc console:Enter w {\n" "upvar #0 $w v\n" "scan [$w index insert] %d.%d row col\n" "set start $row.$v(plength)\n" "set line [$w get $start \"$start lineend\"]\n" "if {$v(historycnt)>0} {\n" "set last [lindex $v(history) [expr $v(historycnt)-1]]\n" "if {[string compare $last $line]} {\n" "lappend v(history) $line\n" "incr v(historycnt)\n" "}\n" "} else {\n" "set v(history) [list $line]\n" "set v(historycnt) 1\n" "}\n" "set v(current) $v(historycnt)\n" "$w insert end \\n\n" "$w mark set out end\n" "if {$v(prior)==\"\"} {\n" "set cmd $line\n" "} else {\n" "set cmd $v(prior)\\n$line\n" "}\n" "if {[info complete $cmd]} {\n" "set rc [catch {uplevel #0 $cmd} res]\n" "if {![winfo exists $w]} return\n" "if {$rc} {\n" "$w insert end $res\\n err\n" "} elseif {[string length $res]>0} {\n" "$w insert end $res\\n ok\n" "}\n" "set v(prior) {}\n" "$w insert end $v(prompt)\n" "} else {\n" "set v(prior) $cmd\n" "regsub -all {[^ ]} $v(prompt) . x\n" "$w insert end $x\n" "}\n" "$w mark set insert end\n" "$w mark set out {insert linestart}\n" "$w yview insert\n" "}\n" "proc console:Prior w {\n" "upvar #0 $w v\n" "if {$v(current)<=0} return\n" "incr v(current) -1\n" "set line [lindex $v(history) $v(current)]\n" "console:SetLine $w $line\n" "}\n" "proc console:Next w {\n" "upvar #0 $w v\n" "if {$v(current)>=$v(historycnt)} return\n" "incr v(current) 1\n" "set line [lindex $v(history) $v(current)]\n" "console:SetLine $w $line\n" "}\n" "proc console:SetLine {w line} {\n" "upvar #0 $w v\n" "scan [$w index insert] %d.%d row col\n" "set start $row.$v(plength)\n" "$w delete $start end\n" "$w insert end $line\n" "$w mark set insert end\n" "$w yview insert\n" "}\n" "proc console:Button1 {w x y} {\n" "global tkPriv\n" "upvar #0 $w v\n" "set v(mouseMoved) 0\n" "set v(pressX) $x\n" "set p [console:nearestBoundry $w $x $y]\n" "scan [$w index insert] %d.%d ix iy\n" "scan $p %d.%d px py\n" "if {$px==$ix} {\n" "$w mark set insert $p\n" "}\n" "$w mark set anchor $p\n" "focus $w\n" "}\n" "proc console:nearestBoundry {w x y} {\n" "set p [$w index @$x,$y]\n" "set bb [$w bbox $p]\n" "if {![string compare $bb \"\"]} {return $p}\n" "if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\n" "$w index \"$p + 1 char\"\n" "}\n" "proc console:SelectTo {w x y} {\n" "upvar #0 $w v\n" "set cur [console:nearestBoundry $w $x $y]\n" "if {[catch {$w index anchor}]} {\n" "$w mark set anchor $cur\n" "}\n" "set anchor [$w index anchor]\n" "if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {\n" "if {$v(mouseMoved)==0} {\n" "$w tag remove sel 0.0 end\n" "}\n" "set v(mouseMoved) 1\n" "}\n" "if {[$w compare $cur < anchor]} {\n" "set first $cur\n" "set last anchor\n" "} else {\n" "set first anchor\n" "set last $cur\n" "}\n" "if {$v(mouseMoved)} {\n" "$w tag remove sel 0.0 $first\n" "$w tag add sel $first $last\n" "$w tag remove sel $last end\n" "update idletasks\n" "}\n" "}\n" "proc console:B1Motion {w x y} {\n" "upvar #0 $w v\n" "set v(y) $y\n" "set v(x) $x\n" "console:SelectTo $w $x $y\n" "}\n" "proc console:B1Leave {w x y} {\n" "upvar #0 $w v\n" "set v(y) $y\n" "set v(x) $x\n" "console:motor $w\n" "}\n" "proc console:motor w {\n" "upvar #0 $w v\n" "if {![winfo exists $w]} return\n" "if {$v(y)>=[winfo height $w]} {\n" "$w yview scroll 1 units\n" "} elseif {$v(y)<0} {\n" "$w yview scroll -1 units\n" "} else {\n" "return\n" "}\n" "console:SelectTo $w $v(x) $v(y)\n" "set v(timer) [after 50 console:motor $w]\n" "}\n" "proc console:cancelMotor w {\n" "upvar #0 $w v\n" "catch {after cancel $v(timer)}\n" "catch {unset v(timer)}\n" "}\n" "proc console:Copy w {\n" "if {![catch {set text [$w get sel.first sel.last]}]} {\n" "clipboard clear -displayof $w\n" "clipboard append -displayof $w $text\n" "}\n" "}\n" "proc console:canCut w {\n" "set r [catch {\n" "scan [$w index sel.first] %d.%d s1x s1y\n" "scan [$w index sel.last] %d.%d s2x s2y\n" "scan [$w index insert] %d.%d ix iy\n" "}]\n" "if {$r==1} {return 0}\n" "if {$s1x==$ix && $s2x==$ix} {return 1}\n" "return 2\n" "}\n" "proc console:Cut w {\n" "if {[console:canCut $w]==1} {\n" "console:Copy $w\n" "$w delete sel.first sel.last\n" "}\n" "}\n" "proc console:Paste w {\n" "if {[console:canCut $w]==1} {\n" "$w delete sel.first sel.last\n" "}\n" "if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\n" "return\n" "}\n" "set prior 0\n" "foreach line [split $topaste \\n] {\n" "if {$prior} {\n" "console:Enter $w\n" "update\n" "}\n" "set prior 1\n" "$w insert insert $line\n" "}\n" "}\n" "proc console:EnableEditMenu w {\n" "upvar #0 $w.t v\n" "set m $v(editmenu)\n" "if {$m==\"\" || ![winfo exists $m]} return\n" "switch [console:canCut $w.t] {\n" "0 {\n" "$m entryconf Copy -state disabled\n" "$m entryconf Cut -state disabled\n" "}\n" "1 {\n" "$m entryconf Copy -state normal\n" "$m entryconf Cut -state normal\n" "}\n" "2 {\n" "$m entryconf Copy -state normal\n" "$m entryconf Cut -state disabled\n" "}\n" "}\n" "}\n" "proc console:SourceFile w {\n" "set types {\n" "{{TCL Scripts} {.tcl}}\n" "{{All Files} *}\n" "}\n" "set f [tk_getOpenFile -filetypes $types -title \"TCL Script To Source...\"]\n" "if {$f!=\"\"} {\n" "uplevel #0 source $f\n" "}\n" "}\n" "proc console:SaveFile w {\n" "set types {\n" "{{Text Files} {.txt}}\n" "{{All Files} *}\n" "}\n" "set f [tk_getSaveFile -filetypes $types -title \"Write Screen To...\"]\n" "if {$f!=\"\"} {\n" "if {[catch {open $f w} fd]} {\n" "tk_messageBox -type ok -icon error -message $fd\n" "} else {\n" "puts $fd [string trimright [$w get 1.0 end] \\n]\n" "close $fd\n" "}\n" "}\n" "}\n" "proc console:Clear w {\n" "$w delete 1.0 {insert linestart}\n" "}\n" ; /* End of the console code */ #endif /* ET_ENABLE_TK */ /* ** The "printf" code that follows dates from the 1980's. It is in ** the public domain. The original comments are included here for ** completeness. They are slightly out-of-date. ** ** The following modules is an enhanced replacement for the "printf" programs ** found in the standard library. The following enhancements are ** supported: ** ** + Additional functions. The standard set of "printf" functions ** includes printf, fprintf, sprintf, vprintf, vfprintf, and ** vsprintf. This module adds the following: ** ** * snprintf -- Works like sprintf, but has an extra argument ** which is the size of the buffer written to. ** ** * mprintf -- Similar to sprintf. Writes output to memory ** obtained from malloc. ** ** * xprintf -- Calls a function to dispose of output. ** ** * nprintf -- No output, but returns the number of characters ** that would have been output by printf. ** ** * A v- version (ex: vsnprintf) of every function is also ** supplied. ** ** + A few extensions to the formatting notation are supported: ** ** * The "=" flag (similar to "-") causes the output to be ** be centered in the appropriately sized field. ** ** * The %b field outputs an integer in binary notation. ** ** * The %c field now accepts a precision. The character output ** is repeated by the number of times the precision specifies. ** ** * The %' field works like %c, but takes as its character the ** next character of the format string, instead of the next ** argument. For example, printf("%.78'-") prints 78 minus ** signs, the same as printf("%.78c",'-'). ** ** + When compiled using GCC on a SPARC, this version of printf is ** faster than the library printf for SUN OS 4.1. ** ** + All functions are fully reentrant. ** */ /* ** Undefine COMPATIBILITY to make some slight changes in the way things ** work. I think the changes are an improvement, but they are not ** backwards compatible. */ /* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */ /* ** Characters that need to be escaped inside a TCL string. */ static char NeedEsc[] = { 1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, '"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[','\\', ']', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, }; /* ** Conversion types fall into various categories as defined by the ** following enumeration. */ enum et_type { /* The type of the format field */ etRADIX, /* Integer types. %d, %x, %o, and so forth */ etFLOAT, /* Floating point. %f */ etEXP, /* Exponentional notation. %e and %E */ etGENERIC, /* Floating or exponential, depending on exponent. %g */ etSIZE, /* Return number of characters processed so far. %n */ etSTRING, /* Strings. %s */ etPERCENT, /* Percent symbol. %% */ etCHARX, /* Characters. %c */ etERROR, /* Used to indicate no such conversion type */ /* The rest are extensions, not normally found in printf() */ etCHARLIT, /* Literal characters. %' */ etTCLESCAPE, /* Strings with special characters escaped. %q */ etMEMSTRING, /* A string which should be deleted after use. %z */ etORDINAL /* 1st, 2nd, 3rd and so forth */ }; /* ** Each builtin conversion character (ex: the 'd' in "%d") is described ** by an instance of the following structure */ typedef struct et_info { /* Information about each format field */ int fmttype; /* The format field code letter */ int base; /* The base for radix conversion */ char *charset; /* The character set for conversion */ int flag_signed; /* Is the quantity signed? */ char *prefix; /* Prefix on non-zero values in alt format */ enum et_type type; /* Conversion paradigm */ } et_info; /* ** The following table is searched linearly, so it is good to put the ** most frequently used conversion types first. */ static et_info fmtinfo[] = { { 'd', 10, "0123456789", 1, 0, etRADIX, }, { 's', 0, 0, 0, 0, etSTRING, }, { 'q', 0, 0, 0, 0, etTCLESCAPE, }, { 'z', 0, 0, 0, 0, etMEMSTRING, }, { 'c', 0, 0, 0, 0, etCHARX, }, { 'o', 8, "01234567", 0, "0", etRADIX, }, { 'u', 10, "0123456789", 0, 0, etRADIX, }, { 'x', 16, "0123456789abcdef", 0, "x0", etRADIX, }, { 'X', 16, "0123456789ABCDEF", 0, "X0", etRADIX, }, { 'r', 10, "0123456789", 0, 0, etORDINAL, }, { 'f', 0, 0, 1, 0, etFLOAT, }, { 'e', 0, "e", 1, 0, etEXP, }, { 'E', 0, "E", 1, 0, etEXP, }, { 'g', 0, "e", 1, 0, etGENERIC, }, { 'G', 0, "E", 1, 0, etGENERIC, }, { 'i', 10, "0123456789", 1, 0, etRADIX, }, { 'n', 0, 0, 0, 0, etSIZE, }, { '%', 0, 0, 0, 0, etPERCENT, }, { 'b', 2, "01", 0, "b0", etRADIX, }, /* Binary */ { 'p', 10, "0123456789", 0, 0, etRADIX, }, /* Pointers */ { '\'', 0, 0, 0, 0, etCHARLIT, }, /* Literal char */ }; #define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0])) /* ** If NOFLOATINGPOINT is defined, then none of the floating point ** conversions will work. */ #ifndef etNOFLOATINGPOINT /* ** "*val" is a double such that 0.1 <= *val < 10.0 ** Return the ascii code for the leading digit of *val, then ** multiply "*val" by 10.0 to renormalize. ** ** Example: ** input: *val = 3.14159 ** output: *val = 1.4159 function return = '3' ** ** The counter *cnt is incremented each time. After counter exceeds ** 16 (the number of significant digits in a 64-bit float) '0' is ** always returned. */ static int et_getdigit(double *val, int *cnt){ int digit; double d; if( (*cnt)++ >= 16 ) return '0'; digit = (int)*val; d = digit; digit += '0'; *val = (*val - d)*10.0; return digit; } #endif #define etBUFSIZE 1000 /* Size of the output buffer */ /* ** The root program. All variations call this core. ** ** INPUTS: ** func This is a pointer to a function taking three arguments ** 1. A pointer to anything. Same as the "arg" parameter. ** 2. A pointer to the list of characters to be output ** (Note, this list is NOT null terminated.) ** 3. An integer number of characters to be output. ** (Note: This number might be zero.) ** ** arg This is the pointer to anything which will be passed as the ** first argument to "func". Use it for whatever you like. ** ** fmt This is the format string, as in the usual print. ** ** ap This is a pointer to a list of arguments. Same as in ** vfprint. ** ** OUTPUTS: ** The return value is the total number of characters sent to ** the function "func". Returns -1 on a error. ** ** Note that the order in which automatic variables are declared below ** seems to make a big difference in determining how fast this beast ** will run. */ int vxprintf( void (*func)(void*,char*,int), void *arg, const char *format, va_list ap ){ register const char *fmt; /* The format string. */ register int c; /* Next character in the format string */ register char *bufpt; /* Pointer to the conversion buffer */ register int precision; /* Precision of the current field */ register int length; /* Length of the field */ register int idx; /* A general purpose loop counter */ int count; /* Total number of characters output */ int width; /* Width of the current field */ int flag_leftjustify; /* True if "-" flag is present */ int flag_plussign; /* True if "+" flag is present */ int flag_blanksign; /* True if " " flag is present */ int flag_alternateform; /* True if "#" flag is present */ int flag_zeropad; /* True if field width constant starts with zero */ int flag_long; /* True if "l" flag is present */ int flag_center; /* True if "=" flag is present */ unsigned long longvalue; /* Value for integer types */ double realvalue; /* Value for real types */ et_info *infop; /* Pointer to the appropriate info structure */ char buf[etBUFSIZE]; /* Conversion buffer */ char prefix; /* Prefix character. "+" or "-" or " " or '\0'. */ int errorflag = 0; /* True if an error is encountered */ enum et_type xtype; /* Conversion paradigm */ char *zMem; /* String to be freed */ char *zExtra; /* Extra memory used for etTCLESCAPE conversions */ static char spaces[] = " " " "; #define etSPACESIZE (sizeof(spaces)-1) #ifndef etNOFLOATINGPOINT int exp; /* exponent of real numbers */ double rounder; /* Used for rounding floating point values */ int flag_dp; /* True if decimal point should be shown */ int flag_rtz; /* True if trailing zeros should be removed */ int flag_exp; /* True to force display of the exponent */ int nsd; /* Number of significant digits returned */ #endif fmt = format; /* Put in a register for speed */ count = length = 0; bufpt = 0; for(; (c=(*fmt))!=0; ++fmt){ if( c!='%' ){ register int amt; bufpt = (char *)fmt; amt = 1; while( (c=(*++fmt))!='%' && c!=0 ) amt++; (*func)(arg,bufpt,amt); count += amt; if( c==0 ) break; } if( (c=(*++fmt))==0 ){ errorflag = 1; (*func)(arg,"%",1); count++; break; } /* Find out what flags are present */ flag_leftjustify = flag_plussign = flag_blanksign = flag_alternateform = flag_zeropad = flag_center = 0; do{ switch( c ){ case '-': flag_leftjustify = 1; c = 0; break; case '+': flag_plussign = 1; c = 0; break; case ' ': flag_blanksign = 1; c = 0; break; case '#': flag_alternateform = 1; c = 0; break; case '0': flag_zeropad = 1; c = 0; break; case '=': flag_center = 1; c = 0; break; default: break; } }while( c==0 && (c=(*++fmt))!=0 ); if( flag_center ) flag_leftjustify = 0; /* Get the field width */ width = 0; if( c=='*' ){ width = va_arg(ap,int); if( width<0 ){ flag_leftjustify = 1; width = -width; } c = *++fmt; }else{ while( isdigit(c) ){ width = width*10 + c - '0'; c = *++fmt; } } if( width > etBUFSIZE-10 ){ width = etBUFSIZE-10; } /* Get the precision */ if( c=='.' ){ precision = 0; c = *++fmt; if( c=='*' ){ precision = va_arg(ap,int); #ifndef etCOMPATIBILITY /* This is sensible, but SUN OS 4.1 doesn't do it. */ if( precision<0 ) precision = -precision; #endif c = *++fmt; }else{ while( isdigit(c) ){ precision = precision*10 + c - '0'; c = *++fmt; } } /* Limit the precision to prevent overflowing buf[] during conversion */ if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40; }else{ precision = -1; } /* Get the conversion type modifier */ if( c=='l' ){ flag_long = 1; c = *++fmt; }else{ flag_long = 0; } /* Fetch the info entry for the field */ infop = 0; for(idx=0; idxtype; } zExtra = 0; /* ** At this point, variables are initialized as follows: ** ** flag_alternateform TRUE if a '#' is present. ** flag_plussign TRUE if a '+' is present. ** flag_leftjustify TRUE if a '-' is present or if the ** field width was negative. ** flag_zeropad TRUE if the width began with 0. ** flag_long TRUE if the letter 'l' (ell) prefixed ** the conversion character. ** flag_blanksign TRUE if a ' ' is present. ** width The specified field width. This is ** always non-negative. Zero is the default. ** precision The specified precision. The default ** is -1. ** xtype The class of the conversion. ** infop Pointer to the appropriate info struct. */ switch( xtype ){ case etORDINAL: case etRADIX: if( flag_long ) longvalue = va_arg(ap,long); else longvalue = va_arg(ap,int); #ifdef etCOMPATIBILITY /* For the format %#x, the value zero is printed "0" not "0x0". ** I think this is stupid. */ if( longvalue==0 ) flag_alternateform = 0; #else /* More sensible: turn off the prefix for octal (to prevent "00"), ** but leave the prefix for hex. */ if( longvalue==0 && infop->base==8 ) flag_alternateform = 0; #endif if( infop->flag_signed ){ if( *(long*)&longvalue<0 ){ longvalue = -*(long*)&longvalue; prefix = '-'; }else if( flag_plussign ) prefix = '+'; else if( flag_blanksign ) prefix = ' '; else prefix = 0; }else prefix = 0; if( flag_zeropad && precision3 || (b>10 && b<14) ){ bufpt[0] = 't'; bufpt[1] = 'h'; }else if( a==1 ){ bufpt[0] = 's'; bufpt[1] = 't'; }else if( a==2 ){ bufpt[0] = 'n'; bufpt[1] = 'd'; }else if( a==3 ){ bufpt[0] = 'r'; bufpt[1] = 'd'; } } { register char *cset; /* Use registers for speed */ register int base; cset = infop->charset; base = infop->base; do{ /* Convert to ascii */ *(--bufpt) = cset[longvalue%base]; longvalue = longvalue/base; }while( longvalue>0 ); } length = (long)&buf[etBUFSIZE]-(long)bufpt; for(idx=precision-length; idx>0; idx--){ *(--bufpt) = '0'; /* Zero pad */ } if( prefix ) *(--bufpt) = prefix; /* Add sign */ if( flag_alternateform && infop->prefix ){ /* Add "0" or "0x" */ char *pre, x; pre = infop->prefix; if( *bufpt!=pre[0] ){ for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x; } } length = (long)&buf[etBUFSIZE]-(long)bufpt; break; case etFLOAT: case etEXP: case etGENERIC: realvalue = va_arg(ap,double); #ifndef etNOFLOATINGPOINT if( precision<0 ) precision = 6; /* Set default precision */ if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10; if( realvalue<0.0 ){ realvalue = -realvalue; prefix = '-'; }else{ if( flag_plussign ) prefix = '+'; else if( flag_blanksign ) prefix = ' '; else prefix = 0; } if( infop->type==etGENERIC && precision>0 ) precision--; rounder = 0.0; #ifdef COMPATIBILITY /* Rounding works like BSD when the constant 0.4999 is used. Wierd! */ for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1); #else /* It makes more sense to use 0.5 */ for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1); #endif if( infop->type==etFLOAT ) realvalue += rounder; /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */ exp = 0; if( realvalue>0.0 ){ int k = 0; while( realvalue>=1e8 && k++<100 ){ realvalue *= 1e-8; exp+=8; } while( realvalue>=10.0 && k++<100 ){ realvalue *= 0.1; exp++; } while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; } while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; } if( k>=100 ){ bufpt = "NaN"; length = 3; break; } } bufpt = buf; /* ** If the field type is etGENERIC, then convert to either etEXP ** or etFLOAT, as appropriate. */ flag_exp = xtype==etEXP; if( xtype!=etFLOAT ){ realvalue += rounder; if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; } } if( xtype==etGENERIC ){ flag_rtz = !flag_alternateform; if( exp<-4 || exp>precision ){ xtype = etEXP; }else{ precision = precision - exp; xtype = etFLOAT; } }else{ flag_rtz = 0; } /* ** The "exp+precision" test causes output to be of type etEXP if ** the precision is too large to fit in buf[]. */ nsd = 0; if( xtype==etFLOAT && exp+precision0 || flag_alternateform); if( prefix ) *(bufpt++) = prefix; /* Sign */ if( exp<0 ) *(bufpt++) = '0'; /* Digits before "." */ else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd); if( flag_dp ) *(bufpt++) = '.'; /* The decimal point */ for(exp++; exp<0 && precision>0; precision--, exp++){ *(bufpt++) = '0'; } while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd); *(bufpt--) = 0; /* Null terminate */ if( flag_rtz && flag_dp ){ /* Remove trailing zeros and "." */ while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0; if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0; } bufpt++; /* point to next free slot */ }else{ /* etEXP or etGENERIC */ flag_dp = (precision>0 || flag_alternateform); if( prefix ) *(bufpt++) = prefix; /* Sign */ *(bufpt++) = et_getdigit(&realvalue,&nsd); /* First digit */ if( flag_dp ) *(bufpt++) = '.'; /* Decimal point */ while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd); bufpt--; /* point to last digit */ if( flag_rtz && flag_dp ){ /* Remove tail zeros */ while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0; if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0; } bufpt++; /* point to next free slot */ if( exp || flag_exp ){ *(bufpt++) = infop->charset[0]; if( exp<0 ){ *(bufpt++) = '-'; exp = -exp; } /* sign of exp */ else { *(bufpt++) = '+'; } if( exp>=100 ){ *(bufpt++) = (exp/100)+'0'; /* 100's digit */ exp %= 100; } *(bufpt++) = exp/10+'0'; /* 10's digit */ *(bufpt++) = exp%10+'0'; /* 1's digit */ } } /* The converted number is in buf[] and zero terminated. Output it. ** Note that the number is in the usual order, not reversed as with ** integer conversions. */ length = (long)bufpt-(long)buf; bufpt = buf; /* Special case: Add leading zeros if the flag_zeropad flag is ** set and we are not left justified */ if( flag_zeropad && !flag_leftjustify && length < width){ int i; int nPad = width - length; for(i=width; i>=nPad; i--){ bufpt[i] = bufpt[i-nPad]; } i = prefix!=0; while( nPad-- ) bufpt[i++] = '0'; length = width; } #endif break; case etSIZE: *(va_arg(ap,int*)) = count; length = width = 0; break; case etPERCENT: buf[0] = '%'; bufpt = buf; length = 1; break; case etCHARLIT: case etCHARX: c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt); if( precision>=0 ){ for(idx=1; idx=0 && precisionetBUFSIZE ){ bufpt = zExtra = Tcl_Alloc( n ); }else{ bufpt = buf; } for(i=j=0; (c=arg[i])!=0; i++){ k = NeedEsc[c&0xff]; if( k==0 ){ bufpt[j++] = c; }else if( k==1 ){ bufpt[j++] = '\\'; bufpt[j++] = ((c>>6) & 3) + '0'; bufpt[j++] = ((c>>3) & 7) + '0'; bufpt[j++] = (c & 7) + '0'; }else{ bufpt[j++] = '\\'; bufpt[j++] = k; } } bufpt[j] = 0; length = j; if( precision>=0 && precision0 ){ if( flag_center ){ nspace = nspace/2; width -= nspace; flag_leftjustify = 1; } count += nspace; while( nspace>=etSPACESIZE ){ (*func)(arg,spaces,etSPACESIZE); nspace -= etSPACESIZE; } if( nspace>0 ) (*func)(arg,spaces,nspace); } } if( length>0 ){ (*func)(arg,bufpt,length); count += length; } if( xtype==etMEMSTRING && zMem ){ Tcl_Free(zMem); } if( flag_leftjustify ){ register int nspace; nspace = width-length; if( nspace>0 ){ count += nspace; while( nspace>=etSPACESIZE ){ (*func)(arg,spaces,etSPACESIZE); nspace -= etSPACESIZE; } if( nspace>0 ) (*func)(arg,spaces,nspace); } } if( zExtra ){ Tcl_Free(zExtra); } }/* End for loop over the format string */ return errorflag ? -1 : count; } /* End of function */ /* ** The following section of code handles the mprintf routine, that ** writes to memory obtained from malloc(). */ /* This structure is used to store state information about the ** write to memory that is currently in progress. */ struct sgMprintf { char *zBase; /* A base allocation */ char *zText; /* The string collected so far */ int nChar; /* Length of the string so far */ int nAlloc; /* Amount of space allocated in zText */ }; /* ** The xprintf callback function. ** ** This routine add nNewChar characters of text in zNewText to ** the sgMprintf structure pointed to by "arg". */ static void mout(void *arg, char *zNewText, int nNewChar){ struct sgMprintf *pM = (struct sgMprintf*)arg; if( pM->nChar + nNewChar + 1 > pM->nAlloc ){ pM->nAlloc = pM->nChar + nNewChar*2 + 1; if( pM->zText==pM->zBase ){ pM->zText = Tcl_Alloc(pM->nAlloc); if( pM->zText && pM->nChar ) memcpy(pM->zText,pM->zBase,pM->nChar); }else{ pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc); } } if( pM->zText ){ memcpy(&pM->zText[pM->nChar], zNewText, nNewChar); pM->nChar += nNewChar; pM->zText[pM->nChar] = 0; } } /* ** mprintf() works like printf(), but allocations memory to hold the ** resulting string and returns a pointer to the allocated memory. */ char *mprintf(const char *zFormat, ...){ va_list ap; struct sgMprintf sMprintf; char *zNew; char zBuf[200]; sMprintf.nChar = 0; sMprintf.nAlloc = sizeof(zBuf); sMprintf.zText = zBuf; sMprintf.zBase = zBuf; va_start(ap,zFormat); vxprintf(mout,&sMprintf,zFormat,ap); va_end(ap); sMprintf.zText[sMprintf.nChar] = 0; if( sMprintf.zText==sMprintf.zBase ){ zNew = Tcl_Alloc( sMprintf.nChar+1 ); if( zNew ) strcpy(zNew,zBuf); }else{ zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1); } return zNew; } /* This is the varargs version of mprintf. */ char *vmprintf(const char *zFormat, va_list ap){ struct sgMprintf sMprintf; char zBuf[200]; sMprintf.nChar = 0; sMprintf.zText = zBuf; sMprintf.nAlloc = sizeof(zBuf); sMprintf.zBase = zBuf; vxprintf(mout,&sMprintf,zFormat,ap); sMprintf.zText[sMprintf.nChar] = 0; if( sMprintf.zText==sMprintf.zBase ){ sMprintf.zText = Tcl_Alloc( strlen(zBuf)+1 ); if( sMprintf.zText ) strcpy(sMprintf.zText,zBuf); }else{ sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1); } return sMprintf.zText; } /* ** Add text output to a Tcl_DString. ** ** This routine is called by vxprintf(). It's job is to add ** nNewChar characters of text from zNewText to the Tcl_DString ** that "arg" is pointing to. */ static void dstringout(void *arg, char *zNewText, int nNewChar){ Tcl_DString *str = (Tcl_DString*)arg; Tcl_DStringAppend(str,zNewText,nNewChar); } /* ** Append formatted output to a DString. */ char *Et_DStringAppendF(Tcl_DString *str, const char *zFormat, ...){ va_list ap; va_start(ap,zFormat); vxprintf(dstringout,str,zFormat,ap); va_end(ap); return Tcl_DStringValue(str); } /* ** Make this variable true to trace all calls to EvalF */ int Et_EvalTrace = 0; /* ** Eval the results of a string. */ int Et_EvalF(Tcl_Interp *interp, const char *zFormat, ...){ char *zCmd; va_list ap; int result; va_start(ap,zFormat); zCmd = vmprintf(zFormat,ap); if( Et_EvalTrace ) printf("%s\n",zCmd); result = Tcl_Eval(interp,zCmd); if( Et_EvalTrace ) printf("%d %s\n",result,Tcl_GetStringResult(interp)); Tcl_Free(zCmd); return result; } int Et_GlobalEvalF(Tcl_Interp *interp, const char *zFormat, ...){ char *zCmd; va_list ap; int result; va_start(ap,zFormat); zCmd = vmprintf(zFormat,ap); if( Et_EvalTrace ) printf("%s\n",zCmd); result = Tcl_GlobalEval(interp,zCmd); if( Et_EvalTrace ) printf("%d %s\n",result,Tcl_GetStringResult(interp)); Tcl_Free(zCmd); return result; } /* ** Set the result of an interpreter using printf-like arguments. */ void Et_ResultF(Tcl_Interp *interp, const char *zFormat, ...){ Tcl_DString str; va_list ap; Tcl_DStringInit(&str); va_start(ap,zFormat); vxprintf(dstringout,&str,zFormat,ap); va_end(ap); Tcl_DStringResult(interp,&str); } #if ET_HAVE_OBJ /* ** Append text to a string object. */ int Et_AppendObjF(Tcl_Obj *pObj, const char *zFormat, ...){ va_list ap; int rc; va_start(ap,zFormat); rc = vxprintf((void(*)(void*,char*,int))Tcl_AppendToObj, pObj, zFormat, ap); va_end(ap); return rc; } #endif #if ET_DOS /* ** This array translates all characters into themselves. Except ** for the \ which gets translated into /. And all upper-case ** characters are translated into lower case. This is used for ** hashing and comparing filenames, to work around the Windows ** bug of ignoring filename case and using the wrong separator ** character for directories. ** ** The array is initialized by FilenameHashInit(). ** ** We also define a macro ET_TRANS() that actually does ** the character translation. ET_TRANS() is a no-op under ** unix. */ static char charTrans[256]; #define ET_TRANS(X) (charTrans[0xff&(int)(X)]) #else #define ET_TRANS(X) (X) #endif /* ** Hash a filename. The value returned is appropriate for ** indexing into the Et_FileHashTable[] array. */ static int FilenameHash(char *zName){ int h = 0; while( *zName ){ h = h ^ (h<<5) ^ ET_TRANS(*(zName++)); } if( h<0 ) h = -h; return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0])); } /* ** Compare two filenames. Return 0 if they are the same and ** non-zero if they are different. */ static int FilenameCmp(char *z1, char *z2){ int diff; while( (diff = ET_TRANS(*z1)-ET_TRANS(*z2))==0 && *z1!=0){ z1++; z2++; } return diff; } /* ** Initialize the file hash table */ static void FilenameHashInit(void){ int i; static int already_run = 0; if( already_run ) return; already_run = 1; #if ET_DOS for(i=0; izName); p->pNext = Et_FileHashTable[h]; Et_FileHashTable[h] = p; } } /* ** Locate the text of a built-in file given its name. ** Return 0 if not found. Return this size of the file (not ** counting the null-terminator) in *pSize if pSize!=NULL. ** ** If deshroud==1 and the file is shrouded, then descramble ** the text. */ static char *FindBuiltinFile(char *zName, int deshroud, int *pSize){ int h; struct EtFile *p; h = FilenameHash(zName); p = Et_FileHashTable[h]; while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; } #if ET_SHROUD_KEY>0 if( p && p->shrouded && deshroud ){ char *z; int xor = ET_SHROUD_KEY; for(z=(char*)p->zData; *z; z++){ if( *z>=0x20 ){ *z ^= xor; xor = (xor+1)&0x1f; } } p->shrouded = 0; } #endif if( p && pSize ){ *pSize = p->nData; } return p ? (char*)p->zData : 0; } /* ** Add a new file to the list of built-in files. ** ** This routine makes a copy of zFilename. But it does NOT make ** a copy of zData. It just holds a pointer to zData and uses ** that for all file access. So after calling this routine, ** you should never change zData! */ void Et_NewBuiltinFile( char *zFilename, /* Name of the new file */ char *zData, /* Data for the new file */ int nData /* Number of bytes in the new file */ ){ int h; struct EtFile *p; p = (struct EtFile*)Tcl_Alloc( sizeof(struct EtFile) + strlen(zFilename) + 1); if( p==0 ) return; p->zName = (char*)&p[1]; strcpy(p->zName, zFilename); p->zData = (unsigned char*)zData; p->nData = nData; p->shrouded = 0; h = FilenameHash(zFilename); p->pNext = Et_FileHashTable[h]; Et_FileHashTable[h] = p; } /* ** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0 ** and later, we make this an Obj command so that it can deal with ** binary data. */ #if ET_HAVE_OBJ static int Et_NewBuiltinFileCmd(ET_OBJARGS){ char *zData, *zNew; int nData; if( objc!=3 ){ Tcl_WrongNumArgs(interp, 1, objv, "filename data"); return TCL_ERROR; } zData = (char*)Tcl_GetByteArrayFromObj(objv[2], &nData); zNew = Tcl_Alloc( nData + 1 ); if( zNew ){ memcpy(zNew, zData, nData); zNew[nData] = 0; Et_NewBuiltinFile(Tcl_GetStringFromObj(objv[1], 0), zNew, nData); } return TCL_OK; } #else static int Et_NewBuiltinFileCmd(ET_TCLARGS){ char *zData; int nData; if( argc!=3 ){ Et_ResultF(interp,"wrong # args: should be \"%s FILENAME DATA\"", argv[0]); return TCL_ERROR; } nData = strlen(argv[2]) + 1; zData = Tcl_Alloc( nData ); if( zData ){ strcpy(zData, argv[2]); Et_NewBuiltinFile(argv[1], zData, nData); } return TCL_OK; } #endif /* ** The following section implements the InsertProc functionality. The ** new InsertProc feature of Tcl8.0.3 and later allows us to overload ** the usual system call commands for file I/O and replace them with ** commands that operate on the built-in files. */ #ifdef ET_HAVE_INSERTPROC /* ** Each open channel to a built-in file is an instance of the ** following structure. */ typedef struct Et_FileStruct { char *zData; /* All of the data */ int nData; /* Bytes of data, not counting the null terminator */ int cursor; /* How much of the data has been read so far */ } Et_FileStruct; /* ** Close a previously opened built-in file. */ static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){ Et_FileStruct *p = (Et_FileStruct*)instanceData; Tcl_Free((char*)p); return 0; } /* ** Read from a built-in file. */ static int Et_FileInput( ClientData instanceData, /* The file structure */ char *buf, /* Write the data read here */ int bufSize, /* Read this much data */ int *pErrorCode /* Write the error code here */ ){ Et_FileStruct *p = (Et_FileStruct*)instanceData; *pErrorCode = 0; if( p->cursor+bufSize>p->nData ){ bufSize = p->nData - p->cursor; } memcpy(buf, &p->zData[p->cursor], bufSize); p->cursor += bufSize; return bufSize; } /* ** Writes to a built-in file always return EOF. */ static int Et_FileOutput( ClientData instanceData, /* The file structure */ char *buf, /* Read the data from here */ int toWrite, /* Write this much data */ int *pErrorCode /* Write the error code here */ ){ *pErrorCode = 0; return 0; } /* ** Move the cursor around within the built-in file. */ static int Et_FileSeek( ClientData instanceData, /* The file structure */ long offset, /* Offset to seek to */ int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */ int *pErrorCode /* Write the error code here */ ){ Et_FileStruct *p = (Et_FileStruct*)instanceData; switch( mode ){ case SEEK_CUR: offset += p->cursor; break; case SEEK_END: offset += p->nData; break; default: break; } if( offset<0 ) offset = 0; if( offset>p->nData ) offset = p->nData; p->cursor = offset; return offset; } /* ** The Watch method is a no-op */ static void Et_FileWatch(ClientData instanceData, int mask){ } /* ** The Handle method always returns an error. */ static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){ return TCL_ERROR; } /* ** This is the channel type that will access the built-in files. */ static Tcl_ChannelType builtinChannelType = { "builtin", /* Type name. */ NULL, /* Always non-blocking.*/ Et_FileClose, /* Close proc. */ Et_FileInput, /* Input proc. */ Et_FileOutput, /* Output proc. */ Et_FileSeek, /* Seek proc. */ NULL, /* Set option proc. */ NULL, /* Get option proc. */ Et_FileWatch, /* Watch for events on console. */ Et_FileHandle, /* Get a handle from the device. */ }; /* ** This routine attempts to do an open of a built-in file. */ static Tcl_Channel Et_FileOpen( Tcl_Interp *interp, /* The TCL interpreter doing the open */ char *zFilename, /* Name of the file to open */ char *modeString, /* Mode string for the open (ignored) */ int permissions /* Permissions for a newly created file (ignored) */ ){ char *zData; Et_FileStruct *p; int nData; char zName[50]; Tcl_Channel chan; static int count = 1; zData = FindBuiltinFile(zFilename, 1, &nData); if( zData==0 ) return NULL; p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) ); if( p==0 ) return NULL; p->zData = zData; p->nData = nData; p->cursor = 0; sprintf(zName,"etbi_%x_%x",((int)Et_FileOpen)>>12,count++); chan = Tcl_CreateChannel(&builtinChannelType, zName, (ClientData)p, TCL_READABLE); return chan; } /* ** This routine does a stat() system call for a built-in file. */ static int Et_FileStat(char *path, struct stat *buf){ char *zData; int nData; zData = FindBuiltinFile(path, 0, &nData); if( zData==0 ){ return -1; } memset(buf, 0, sizeof(*buf)); buf->st_mode = 0400; buf->st_size = nData; return 0; } /* ** This routien does an access() system call for a built-in file. */ static int Et_FileAccess(char *path, int mode){ char *zData; if( mode & 3 ){ return -1; } zData = FindBuiltinFile(path, 0, 0); if( zData==0 ){ return -1; } return 0; } #endif /* ET_HAVE_INSERTPROC */ /* ** An overloaded version of "source". First check for the file ** is one of the built-ins. If it isn't a built-in, then check the ** disk. But if ET_STANDALONE is set (which corresponds to the ** "Strict" option in the user interface) then never check the disk. ** This gives us a quick way to check for the common error of ** sourcing a file that exists on the development by mistake, ** and only discovering the mistake when you move the program ** to your customer's machine. */ static int Et_Source(ET_TCLARGS){ char *z; if( argc!=2 ){ Et_ResultF(interp,"wrong # args: should be \"%s FILENAME\"", argv[0]); return TCL_ERROR; } z = FindBuiltinFile(argv[1], 1, 0); if( z ){ int rc; rc = Tcl_Eval(interp,z); if (rc == TCL_ERROR) { char msg[200]; sprintf(msg, "\n (file \"%.150s\" line %d)", argv[1], interp->errorLine); Tcl_AddErrorInfo(interp, msg); } else { rc = TCL_OK; } return rc; } #if ET_STANDALONE Et_ResultF(interp,"no such file: \"%s\"", argv[1]); return TCL_ERROR; #else return Tcl_EvalFile(interp,argv[1]); #endif } #ifndef ET_HAVE_INSERTPROC /* ** An overloaded version of "file exists". First check for the file ** in the file table, then go to disk. ** ** We only overload "file exists" if we don't have InsertProc() ** procedures. If we do have InsertProc() procedures, they will ** handle this more efficiently. */ static int Et_FileExists(ET_TCLARGS){ int i, rc; Tcl_DString str; if( argc==3 && strncmp(argv[1],"exis",4)==0 ){ if( FindBuiltinFile(argv[2], 0, 0)!=0 ){ Tcl_SetResult(interp, "1", TCL_STATIC); return TCL_OK; } } Tcl_DStringInit(&str); Tcl_DStringAppendElement(&str,"Et_FileCmd"); for(i=1; i1 ){ zTitle = argv[1]; } if( argc>2 ){ zMsg = argv[2]; } MessageBox(0, zMsg, zTitle, MB_ICONSTOP | MB_OK); return TCL_OK; } #endif /* ** A default implementation for "bgerror" */ static char zBgerror[] = "proc Et_Bgerror err {\n" " global errorInfo tk_library\n" " if {[info exists errorInfo]} {\n" " set ei $errorInfo\n" " } else {\n" " set ei {}\n" " }\n" " if {[catch {bgerror $err}]==0} return\n" " if {[string length $ei]>0} {\n" " set err $ei\n" " }\n" " if {[catch {Et_MessageBox {Error} $err}]} {\n" " puts stderr $err\n" " }\n" " exit\n" "}\n" ; /* ** Do the initialization. ** ** This routine is called after the interpreter is created, but ** before Et_PreInit() or Et_AppInit() have been run. */ static int Et_DoInit(Tcl_Interp *interp){ int i; extern int Et_PreInit(Tcl_Interp*); extern int Et_AppInit(Tcl_Interp*); /* Insert our alternative stat(), access() and open() procedures ** so that any attempt to work with a file will check our built-in ** scripts first. */ #ifdef ET_HAVE_INSERTPROC TclStatInsertProc(Et_FileStat); TclAccessInsertProc(Et_FileAccess); TclOpenFileChannelInsertProc(Et_FileOpen); #endif /* Initialize the hash-table for built-in scripts */ FilenameHashInit(); /* The Et_NewBuiltFile command is inserted for use by FreeWrap ** and similar tools. */ #if ET_HAVE_OBJ Tcl_CreateObjCommand(interp,"Et_NewBuiltinFile",Et_NewBuiltinFileCmd,0,0); #else Tcl_CreateCommand(interp,"Et_NewBuiltinFile",Et_NewBuiltinFileCmd,0,0); #endif /* Overload the "file" and "source" commands */ #ifndef ET_HAVE_INSERTPROC { static char zRename[] = "rename file Et_FileCmd"; Tcl_Eval(interp,zRename); Tcl_CreateCommand(interp,"file",Et_FileExists,0,0); } #endif Tcl_CreateCommand(interp,"source",Et_Source,0,0); Et_Interp = interp; #ifdef ET_TCL_LIBRARY Tcl_SetVar(interp,"tcl_library",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY); Tcl_SetVar(interp,"tcl_libPath",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY); Tcl_SetVar2(interp,"env","TCL_LIBRARY",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY); #endif #ifdef ET_TK_LIBRARY Tcl_SetVar(interp,"tk_library",ET_TK_LIBRARY,TCL_GLOBAL_ONLY); Tcl_SetVar2(interp,"env","TK_LIBRARY",ET_TK_LIBRARY,TCL_GLOBAL_ONLY); #endif #if ET_WIN32 Tcl_CreateCommand(interp,"Et_MessageBox",Et_MessageBox, 0, 0); #endif Tcl_Eval(interp,zBgerror); #if ET_HAVE_PREINIT if( Et_PreInit(interp) == TCL_ERROR ){ goto initerr; } #endif if( Tcl_Init(interp) == TCL_ERROR ){ goto initerr; } Et_GlobalEvalF(interp,"set dir $tcl_library;source $dir/tclIndex;unset dir"); #if ET_ENABLE_TK if( Tk_Init(interp) == TCL_ERROR ){ goto initerr; } Tcl_StaticPackage(interp,"Tk", Tk_Init, 0); Et_GlobalEvalF(interp,"set dir $tk_library;source $dir/tclIndex;unset dir"); #endif #if ET_ENABLE_TK && !ET_EXTENSION && !ET_READ_STDIN && ET_USE_BUILTIN_CONSOLE Tk_InitConsoleChannels(interp); Tk_CreateConsoleWindow(interp); #endif /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); */ for(i=0; i {+if {\"%W\"==\".\"} exit}\n" #endif "while 1 {vwait forever}"; #endif Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); if( Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1)==0 ){ Et_EvalF(interp, "Et_Bgerror \"Tcl header version (%s) does not match " " Tcl library ($tcl_version)\"", TCL_VERSION); Tcl_DeleteInterp(interp); return 1; } args = Tcl_Merge(argc-1, argv+1); Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); ckfree(args); sprintf(buf, "%d", argc-1); Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); Et_DoInit(interp); #if ET_HAVE_CUSTOM_MAINLOOP Et_CustomMainLoop(interp); #else Tcl_Eval(interp,zWaitForever); #endif return 0; } #endif /* ** This routine is called to do the complete initialization. */ int Et_Init(int argc, char **argv){ #ifdef ET_TCL_LIBRARY putenv("TCL_LIBRARY=" ET_TCL_LIBRARY); #endif #ifdef ET_TK_LIBRARY putenv("TK_LIBRARY=" ET_TK_LIBRARY); #endif #if ET_CONSOLE || ET_TKCONSOLE || !ET_READ_STDIN Et_Local_Init(argc, argv); #else # if ET_ENABLE_TK Tk_Main(argc,argv,Et_DoInit); # else Tcl_Main(argc, argv, Et_DoInit); # endif #endif return 0; } #if !ET_HAVE_MAIN && !ET_EXTENSION /* ** Main routine for UNIX programs. If the user has supplied ** their own main() routine in a C module, then the ET_HAVE_MAIN ** macro will be set to 1 and this code will be skipped. */ int main(int argc, char **argv){ #if ET_AUTO_FORK int rc = fork(); if( rc<0 ){ perror("can't fork"); exit(1); } if( rc>0 ) return 0; close(0); open("/dev/null",O_RDONLY); close(1); open("/dev/null",O_WRONLY); #endif return Et_Init(argc,argv)!=TCL_OK; } #endif #if ET_EXTENSION /* ** If the -extension flag is used, then generate code that will be ** turned into a loadable shared library or DLL, not a standalone ** executable. */ int ET_EXTENSION_NAME(Tcl_Interp *interp){ int i; #ifndef ET_HAVE_INSERTPROC Tcl_AppendResult(interp, "mktclapp can only generate extensions for Tcl/Tk version " "8.0.3 and later. This is version " TCL_MAJOR_VERSION "." TCL_MINOR_VERSION "." TCL_RELEASE_SERIAL, 0); return TCL_ERROR; #endif #ifdef ET_HAVE_INSERTPROC #ifdef USE_TCL_STUBS if( Tcl_InitStubs(interp,"8.0",0)==0 ){ return TCL_ERROR; } if( Tk_InitStubs(interp,"8.0",0)==0 ){ return TCL_ERROR; } #endif Et_Interp = interp; TclStatInsertProc(Et_FileStat); TclAccessInsertProc(Et_FileAccess); TclOpenFileChannelInsertProc(Et_FileOpen); FilenameHashInit(); for(i=0; i