/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/appinit.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/appinit.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 25 - (hide annotations) (download)
Sat Oct 8 06:43:03 2016 UTC (7 years, 4 months ago) by dashley
Original Path: sf_code/esrgpcpj/shared/tk_base/appinit.c
File MIME type: text/plain
File size: 355233 byte(s)
Initial commit.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/appinit.c,v 1.6 2002/04/23 06:26:42 dtashley Exp $ */
2    
3     #define MODULE_APPINIT
4    
5     #include <tcl.h>
6    
7     #include "appinit.h"
8     #include "build_config.h"
9     #include "extninit.h"
10     #include "msgstrs.h"
11    
12    
13     #define INTERFACE 1
14     #if INTERFACE
15     #define ET_TCLARGS ClientData clientData,Tcl_Interp*interp,int argc,char**argv
16     #define ET_OBJARGS ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj*CONST objv[]
17     #endif
18     #define ET_ENABLE_OBJ 0
19     #define ET_ENABLE_TK 1
20     #define ET_AUTO_FORK 0
21     #define ET_STANDALONE 0
22     #define ET_N_BUILTIN_SCRIPT 31
23     #define ET_VERSION "3.10"
24     #define ET_HAVE_APPINIT 0
25     #define ET_HAVE_PREINIT 0
26     #define ET_HAVE_MAIN 1
27     #define ET_HAVE_CUSTOM_MAINLOOP 0
28     #define ET_EXTENSION 0
29     #define ET_SHROUD_KEY 0
30     #define ET_READ_STDIN 0
31     #define ET_CONSOLE 1
32     static struct {
33     char *zName;
34     int (*xProc)(ET_TCLARGS);
35     } Et_CmdSet[] = {
36     {0, 0}};
37     static char Et_zFile0[] =
38     "proc auto_reset {} {\n"
39     "global auto_execs auto_index auto_oldpath\n"
40     "foreach p [info procs] {\n"
41     "if {[info exists auto_index($p)] && ![string match auto_* $p]\n"
42     "&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup\n"
43     "tcl_findLibrary pkg_compareExtension\n"
44     "tclMacPkgSearch tclPkgUnknown} $p] < 0)} {\n"
45     "rename $p {}\n"
46     "}\n"
47     "}\n"
48     "catch {unset auto_execs}\n"
49     "catch {unset auto_index}\n"
50     "catch {unset auto_oldpath}\n"
51     "}\n"
52     "proc tcl_findLibrary {basename version patch initScript enVarName varName} {\n"
53     "upvar #0 $varName the_library\n"
54     "global env errorInfo\n"
55     "set dirs {}\n"
56     "set errors {}\n"
57     "if {[info exist the_library] && [string compare $the_library {}]} {\n"
58     "lappend dirs $the_library\n"
59     "} else {\n"
60     "if {[info exists env($enVarName)]} {\n"
61     "lappend dirs $env($enVarName)\n"
62     "}\n"
63     "lappend dirs [file join [file dirname [info library]] \\\n"
64     "\011\011$basename$version]\n"
65     "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
66     "set grandParentDir [file dirname $parentDir]\n"
67     "lappend dirs [file join $parentDir lib $basename$version]\n"
68     "lappend dirs [file join $grandParentDir lib $basename$version]\n"
69     "lappend dirs [file join $parentDir library]\n"
70     "lappend dirs [file join $grandParentDir library]\n"
71     "if {![regexp {.*[ab][0-9]*} $patch ver]} {\n"
72     "set ver $version\n"
73     "}\n"
74     "lappend dirs [file join $grandParentDir $basename$ver library]\n"
75     "lappend dirs [file join [file dirname $grandParentDir] $basename$ver library]\n"
76     "}\n"
77     "foreach i $dirs {\n"
78     "set the_library $i\n"
79     "set file [file join $i $initScript]\n"
80     "if {[interp issafe] || [file exists $file]} {\n"
81     "if {![catch {uplevel #0 [list source $file]} msg]} {\n"
82     "return\n"
83     "} else {\n"
84     "append errors \"$file: $msg\\n$errorInfo\\n\"\n"
85     "}\n"
86     "}\n"
87     "}\n"
88     "set msg \"Can't find a usable $initScript in the following directories: \\n\"\n"
89     "append msg \" $dirs\\n\\n\"\n"
90     "append msg \"$errors\\n\\n\"\n"
91     "append msg \"This probably means that $basename wasn't installed properly.\\n\"\n"
92     "error $msg\n"
93     "}\n"
94     "if {[interp issafe]} {\n"
95     "return\011;# Stop sourcing the file here\n"
96     "}\n"
97     "proc auto_mkindex {dir args} {\n"
98     "global errorCode errorInfo\n"
99     "if {[interp issafe]} {\n"
100     "error \"can't generate index within safe interpreter\"\n"
101     "}\n"
102     "set oldDir [pwd]\n"
103     "cd $dir\n"
104     "set dir [pwd]\n"
105     "append index \"# Tcl autoload index file, version 2.0\\n\"\n"
106     "append index \"# This file is generated by the \\\"auto_mkindex\\\" command\\n\"\n"
107     "append index \"# and sourced to set up indexing information for one or\\n\"\n"
108     "append index \"# more commands. Typically each line is a command that\\n\"\n"
109     "append index \"# sets an element in the auto_index array, where the\\n\"\n"
110     "append index \"# element name is the name of a command and the value is\\n\"\n"
111     "append index \"# a script that loads the command.\\n\\n\"\n"
112     "if {$args == \"\"} {\n"
113     "set args *.tcl\n"
114     "}\n"
115     "auto_mkindex_parser::init\n"
116     "foreach file [eval glob $args] {\n"
117     "if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {\n"
118     "append index $msg\n"
119     "} else {\n"
120     "set code $errorCode\n"
121     "set info $errorInfo\n"
122     "cd $oldDir\n"
123     "error $msg $info $code\n"
124     "}\n"
125     "}\n"
126     "auto_mkindex_parser::cleanup\n"
127     "set fid [open \"tclIndex\" w]\n"
128     "puts -nonewline $fid $index\n"
129     "close $fid\n"
130     "cd $oldDir\n"
131     "}\n"
132     "proc auto_mkindex_old {dir args} {\n"
133     "global errorCode errorInfo\n"
134     "set oldDir [pwd]\n"
135     "cd $dir\n"
136     "set dir [pwd]\n"
137     "append index \"# Tcl autoload index file, version 2.0\\n\"\n"
138     "append index \"# This file is generated by the \\\"auto_mkindex\\\" command\\n\"\n"
139     "append index \"# and sourced to set up indexing information for one or\\n\"\n"
140     "append index \"# more commands. Typically each line is a command that\\n\"\n"
141     "append index \"# sets an element in the auto_index array, where the\\n\"\n"
142     "append index \"# element name is the name of a command and the value is\\n\"\n"
143     "append index \"# a script that loads the command.\\n\\n\"\n"
144     "if {[string equal $args \"\"]} {\n"
145     "set args *.tcl\n"
146     "}\n"
147     "foreach file [eval glob $args] {\n"
148     "set f \"\"\n"
149     "set error [catch {\n"
150     "set f [open $file]\n"
151     "while {[gets $f line] >= 0} {\n"
152     "if {[regexp {^proc[ \011]+([^ \011]*)} $line match procName]} {\n"
153     "set procName [lindex [auto_qualify $procName \"::\"] 0]\n"
154     "append index \"set [list auto_index($procName)]\"\n"
155     "append index \" \\[list source \\[file join \\$dir [list $file]\\]\\]\\n\"\n"
156     "}\n"
157     "}\n"
158     "close $f\n"
159     "} msg]\n"
160     "if {$error} {\n"
161     "set code $errorCode\n"
162     "set info $errorInfo\n"
163     "catch {close $f}\n"
164     "cd $oldDir\n"
165     "error $msg $info $code\n"
166     "}\n"
167     "}\n"
168     "set f \"\"\n"
169     "set error [catch {\n"
170     "set f [open tclIndex w]\n"
171     "puts -nonewline $f $index\n"
172     "close $f\n"
173     "cd $oldDir\n"
174     "} msg]\n"
175     "if {$error} {\n"
176     "set code $errorCode\n"
177     "set info $errorInfo\n"
178     "catch {close $f}\n"
179     "cd $oldDir\n"
180     "error $msg $info $code\n"
181     "}\n"
182     "}\n"
183     "namespace eval auto_mkindex_parser {\n"
184     "variable parser \"\" ;# parser used to build index\n"
185     "variable index \"\" ;# maintains index as it is built\n"
186     "variable scriptFile \"\" ;# name of file being processed\n"
187     "variable contextStack \"\" ;# stack of namespace scopes\n"
188     "variable imports \"\" ;# keeps track of all imported cmds\n"
189     "variable initCommands \"\" ;# list of commands that create aliases\n"
190     "proc init {} {\n"
191     "variable parser\n"
192     "variable initCommands\n"
193     "if {![interp issafe]} {\n"
194     "set parser [interp create -safe]\n"
195     "$parser hide info\n"
196     "$parser hide rename\n"
197     "$parser hide proc\n"
198     "$parser hide namespace\n"
199     "$parser hide eval\n"
200     "$parser hide puts\n"
201     "$parser invokehidden namespace delete ::\n"
202     "$parser invokehidden proc unknown {args} {}\n"
203     "$parser expose namespace\n"
204     "$parser invokehidden rename namespace _%@namespace\n"
205     "$parser expose eval\n"
206     "$parser invokehidden rename eval _%@eval\n"
207     "foreach cmd $initCommands {\n"
208     "eval $cmd\n"
209     "}\n"
210     "}\n"
211     "}\n"
212     "proc cleanup {} {\n"
213     "variable parser\n"
214     "interp delete $parser\n"
215     "unset parser\n"
216     "}\n"
217     "}\n"
218     "proc auto_mkindex_parser::mkindex {file} {\n"
219     "variable parser\n"
220     "variable index\n"
221     "variable scriptFile\n"
222     "variable contextStack\n"
223     "variable imports\n"
224     "set scriptFile $file\n"
225     "set fid [open $file]\n"
226     "set contents [read $fid]\n"
227     "close $fid\n"
228     "regsub -all {\\$} $contents \"\\0\" contents\n"
229     "set index \"\"\n"
230     "set contextStack \"\"\n"
231     "set imports \"\"\n"
232     "$parser eval $contents\n"
233     "foreach name $imports {\n"
234     "catch {$parser eval [list _%@namespace forget $name]}\n"
235     "}\n"
236     "return $index\n"
237     "}\n"
238     "proc auto_mkindex_parser::hook {cmd} {\n"
239     "variable initCommands\n"
240     "lappend initCommands $cmd\n"
241     "}\n"
242     "proc auto_mkindex_parser::slavehook {cmd} {\n"
243     "variable initCommands\n"
244     "lappend initCommands \"\\$parser eval [list $cmd]\"\n"
245     "}\n"
246     "proc auto_mkindex_parser::command {name arglist body} {\n"
247     "hook [list auto_mkindex_parser::commandInit $name $arglist $body]\n"
248     "}\n"
249     "proc auto_mkindex_parser::commandInit {name arglist body} {\n"
250     "variable parser\n"
251     "set ns [namespace qualifiers $name]\n"
252     "set tail [namespace tail $name]\n"
253     "if {[string equal $ns \"\"]} {\n"
254     "set fakeName \"[namespace current]::_%@fake_$tail\"\n"
255     "} else {\n"
256     "set fakeName \"_%@fake_$name\"\n"
257     "regsub -all {::} $fakeName \"_\" fakeName\n"
258     "set fakeName \"[namespace current]::$fakeName\"\n"
259     "}\n"
260     "proc $fakeName $arglist $body\n"
261     "if {[regexp {::} $name]} {\n"
262     "set exportCmd [list _%@namespace export [namespace tail $name]]\n"
263     "$parser eval [list _%@namespace eval $ns $exportCmd]\n"
264     "set alias [namespace tail $fakeName]\n"
265     "$parser invokehidden proc $name {args} \"_%@eval {$alias} \\$args\"\n"
266     "$parser alias $alias $fakeName\n"
267     "} else {\n"
268     "$parser alias $name $fakeName\n"
269     "}\n"
270     "return\n"
271     "}\n"
272     "proc auto_mkindex_parser::fullname {name} {\n"
273     "variable contextStack\n"
274     "if {![string match ::* $name]} {\n"
275     "foreach ns $contextStack {\n"
276     "set name \"${ns}::$name\"\n"
277     "if {[string match ::* $name]} {\n"
278     "break\n"
279     "}\n"
280     "}\n"
281     "}\n"
282     "if {[string equal [namespace qualifiers $name] \"\"]} {\n"
283     "set name [namespace tail $name]\n"
284     "} elseif {![string match ::* $name]} {\n"
285     "set name \"::$name\"\n"
286     "}\n"
287     "regsub -all \"\\0\" $name \"\\$\" name\n"
288     "return $name\n"
289     "}\n"
290     "auto_mkindex_parser::command proc {name args} {\n"
291     "variable index\n"
292     "variable scriptFile\n"
293     "append index [list set auto_index([fullname $name])] \\\n"
294     "\011 [format { [list source [file join $dir %s]]} \\\n"
295     "\011 [file split $scriptFile]] \"\\n\"\n"
296     "}\n"
297     "auto_mkindex_parser::hook {\n"
298     "if {![catch {package require tbcload}]} {\n"
299     "if {[llength [info commands tbcload::bcproc]] == 0} {\n"
300     "auto_load tbcload::bcproc\n"
301     "}\n"
302     "load {} tbcload $auto_mkindex_parser::parser\n"
303     "auto_mkindex_parser::commandInit tbcload::bcproc {name args} {\n"
304     "variable index\n"
305     "variable scriptFile\n"
306     "append index [list set auto_index([fullname $name])] \\\n"
307     "\011\011 [format { [list source [file join $dir %s]]} \\\n"
308     "\011\011 [file split $scriptFile]] \"\\n\"\n"
309     "}\n"
310     "}\n"
311     "}\n"
312     "auto_mkindex_parser::command namespace {op args} {\n"
313     "switch -- $op {\n"
314     "eval {\n"
315     "variable parser\n"
316     "variable contextStack\n"
317     "set name [lindex $args 0]\n"
318     "set args [lrange $args 1 end]\n"
319     "set contextStack [linsert $contextStack 0 $name]\n"
320     "$parser eval [list _%@namespace eval $name] $args\n"
321     "set contextStack [lrange $contextStack 1 end]\n"
322     "}\n"
323     "import {\n"
324     "variable parser\n"
325     "variable imports\n"
326     "foreach pattern $args {\n"
327     "if {[string compare $pattern \"-force\"]} {\n"
328     "lappend imports $pattern\n"
329     "}\n"
330     "}\n"
331     "catch {$parser eval \"_%@namespace import $args\"}\n"
332     "}\n"
333     "}\n"
334     "}\n"
335     "return\n"
336     ;
337     static char Et_zFile1[] =
338     "namespace eval tcl {\n"
339     "variable history\n"
340     "if {![info exists history]} {\n"
341     "array set history {\n"
342     "nextid\0110\n"
343     "keep\01120\n"
344     "oldest\011-20\n"
345     "}\n"
346     "}\n"
347     "}\n"
348     "proc history {args} {\n"
349     "set len [llength $args]\n"
350     "if {$len == 0} {\n"
351     "return [tcl::HistInfo]\n"
352     "}\n"
353     "set key [lindex $args 0]\n"
354     "set options \"add, change, clear, event, info, keep, nextid, or redo\"\n"
355     "switch -glob -- $key {\n"
356     "a* { # history add\n"
357     "if {$len > 3} {\n"
358     "return -code error \"wrong # args: should be \\\"history add event ?exec?\\\"\"\n"
359     "}\n"
360     "if {![string match $key* add]} {\n"
361     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
362     "}\n"
363     "if {$len == 3} {\n"
364     "set arg [lindex $args 2]\n"
365     "if {! ([string match e* $arg] && [string match $arg* exec])} {\n"
366     "return -code error \"bad argument \\\"$arg\\\": should be \\\"exec\\\"\"\n"
367     "}\n"
368     "}\n"
369     "return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]\n"
370     "}\n"
371     "ch* { # history change\n"
372     "if {($len > 3) || ($len < 2)} {\n"
373     "return -code error \"wrong # args: should be \\\"history change newValue ?event?\\\"\"\n"
374     "}\n"
375     "if {![string match $key* change]} {\n"
376     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
377     "}\n"
378     "if {$len == 2} {\n"
379     "set event 0\n"
380     "} else {\n"
381     "set event [lindex $args 2]\n"
382     "}\n"
383     "return [tcl::HistChange [lindex $args 1] $event]\n"
384     "}\n"
385     "cl* { # history clear\n"
386     "if {($len > 1)} {\n"
387     "return -code error \"wrong # args: should be \\\"history clear\\\"\"\n"
388     "}\n"
389     "if {![string match $key* clear]} {\n"
390     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
391     "}\n"
392     "return [tcl::HistClear]\n"
393     "}\n"
394     "e* { # history event\n"
395     "if {$len > 2} {\n"
396     "return -code error \"wrong # args: should be \\\"history event ?event?\\\"\"\n"
397     "}\n"
398     "if {![string match $key* event]} {\n"
399     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
400     "}\n"
401     "if {$len == 1} {\n"
402     "set event -1\n"
403     "} else {\n"
404     "set event [lindex $args 1]\n"
405     "}\n"
406     "return [tcl::HistEvent $event]\n"
407     "}\n"
408     "i* { # history info\n"
409     "if {$len > 2} {\n"
410     "return -code error \"wrong # args: should be \\\"history info ?count?\\\"\"\n"
411     "}\n"
412     "if {![string match $key* info]} {\n"
413     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
414     "}\n"
415     "return [tcl::HistInfo [lindex $args 1]]\n"
416     "}\n"
417     "k* { # history keep\n"
418     "if {$len > 2} {\n"
419     "return -code error \"wrong # args: should be \\\"history keep ?count?\\\"\"\n"
420     "}\n"
421     "if {$len == 1} {\n"
422     "return [tcl::HistKeep]\n"
423     "} else {\n"
424     "set limit [lindex $args 1]\n"
425     "if {[catch {expr {~$limit}}] || ($limit < 0)} {\n"
426     "return -code error \"illegal keep count \\\"$limit\\\"\"\n"
427     "}\n"
428     "return [tcl::HistKeep $limit]\n"
429     "}\n"
430     "}\n"
431     "n* { # history nextid\n"
432     "if {$len > 1} {\n"
433     "return -code error \"wrong # args: should be \\\"history nextid\\\"\"\n"
434     "}\n"
435     "if {![string match $key* nextid]} {\n"
436     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
437     "}\n"
438     "return [expr {$tcl::history(nextid) + 1}]\n"
439     "}\n"
440     "r* { # history redo\n"
441     "if {$len > 2} {\n"
442     "return -code error \"wrong # args: should be \\\"history redo ?event?\\\"\"\n"
443     "}\n"
444     "if {![string match $key* redo]} {\n"
445     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
446     "}\n"
447     "return [tcl::HistRedo [lindex $args 1]]\n"
448     "}\n"
449     "default {\n"
450     "return -code error \"bad option \\\"$key\\\": must be $options\"\n"
451     "}\n"
452     "}\n"
453     "}\n"
454     "proc tcl::HistAdd {command {exec {}}} {\n"
455     "variable history\n"
456     "set i [incr history(nextid)]\n"
457     "set history($i) $command\n"
458     "set j [incr history(oldest)]\n"
459     "if {[info exists history($j)]} {unset history($j)}\n"
460     "if {[string match e* $exec]} {\n"
461     "return [uplevel #0 $command]\n"
462     "} else {\n"
463     "return {}\n"
464     "}\n"
465     "}\n"
466     "proc tcl::HistKeep {{limit {}}} {\n"
467     "variable history\n"
468     "if {[string length $limit] == 0} {\n"
469     "return $history(keep)\n"
470     "} else {\n"
471     "set oldold $history(oldest)\n"
472     "set history(oldest) [expr {$history(nextid) - $limit}]\n"
473     "for {} {$oldold <= $history(oldest)} {incr oldold} {\n"
474     "if {[info exists history($oldold)]} {unset history($oldold)}\n"
475     "}\n"
476     "set history(keep) $limit\n"
477     "}\n"
478     "}\n"
479     "proc tcl::HistClear {} {\n"
480     "variable history\n"
481     "set keep $history(keep)\n"
482     "unset history\n"
483     "array set history [list \\\n"
484     "\011nextid\0110\011\\\n"
485     "\011keep\011$keep\011\\\n"
486     "\011oldest\011-$keep\011\\\n"
487     " ]\n"
488     "}\n"
489     "proc tcl::HistInfo {{num {}}} {\n"
490     "variable history\n"
491     "if {$num == {}} {\n"
492     "set num [expr {$history(keep) + 1}]\n"
493     "}\n"
494     "set result {}\n"
495     "set newline \"\"\n"
496     "for {set i [expr {$history(nextid) - $num + 1}]} \\\n"
497     "\011 {$i <= $history(nextid)} {incr i} {\n"
498     "if {![info exists history($i)]} {\n"
499     "continue\n"
500     "}\n"
501     "set cmd [string trimright $history($i) \\ \\n]\n"
502     "regsub -all \\n $cmd \"\\n\\t\" cmd\n"
503     "append result $newline[format \"%6d %s\" $i $cmd]\n"
504     "set newline \\n\n"
505     "}\n"
506     "return $result\n"
507     "}\n"
508     "proc tcl::HistRedo {{event -1}} {\n"
509     "variable history\n"
510     "if {[string length $event] == 0} {\n"
511     "set event -1\n"
512     "}\n"
513     "set i [HistIndex $event]\n"
514     "if {$i == $history(nextid)} {\n"
515     "return -code error \"cannot redo the current event\"\n"
516     "}\n"
517     "set cmd $history($i)\n"
518     "HistChange $cmd 0\n"
519     "uplevel #0 $cmd\n"
520     "}\n"
521     "proc tcl::HistIndex {event} {\n"
522     "variable history\n"
523     "if {[catch {expr {~$event}}]} {\n"
524     "for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {\n"
525     "if {[string match $event* $history($i)]} {\n"
526     "return $i;\n"
527     "}\n"
528     "if {[string match $event $history($i)]} {\n"
529     "return $i;\n"
530     "}\n"
531     "}\n"
532     "return -code error \"no event matches \\\"$event\\\"\"\n"
533     "} elseif {$event <= 0} {\n"
534     "set i [expr {$history(nextid) + $event}]\n"
535     "} else {\n"
536     "set i $event\n"
537     "}\n"
538     "if {$i <= $history(oldest)} {\n"
539     "return -code error \"event \\\"$event\\\" is too far in the past\"\n"
540     "}\n"
541     "if {$i > $history(nextid)} {\n"
542     "return -code error \"event \\\"$event\\\" hasn't occured yet\"\n"
543     "}\n"
544     "return $i\n"
545     "}\n"
546     "proc tcl::HistEvent {event} {\n"
547     "variable history\n"
548     "set i [HistIndex $event]\n"
549     "if {[info exists history($i)]} {\n"
550     "return [string trimright $history($i) \\ \\n]\n"
551     "} else {\n"
552     "return \"\";\n"
553     "}\n"
554     "}\n"
555     "proc tcl::HistChange {cmd {event 0}} {\n"
556     "variable history\n"
557     "set i [HistIndex $event]\n"
558     "set history($i) $cmd\n"
559     "}\n"
560     ;
561     static char Et_zFile2[] =
562     "if {[info commands package] == \"\"} {\n"
563     "error \"version mismatch: library\\nscripts expect Tcl version 7.5b1 or later but the loaded version is\\nonly [info patchlevel]\"\n"
564     "}\n"
565     "package require -exact Tcl 8.3\n"
566     "if {![info exists auto_path]} {\n"
567     "if {[info exist env(TCLLIBPATH)]} {\n"
568     "set auto_path $env(TCLLIBPATH)\n"
569     "} else {\n"
570     "set auto_path \"\"\n"
571     "}\n"
572     "}\n"
573     "if {[string compare [info library] {}]} {\n"
574     "foreach __dir [list [info library] [file dirname [info library]]] {\n"
575     "if {[lsearch -exact $auto_path $__dir] < 0} {\n"
576     "lappend auto_path $__dir\n"
577     "}\n"
578     "}\n"
579     "}\n"
580     "set __dir [file join [file dirname [file dirname \\\n"
581     "\011[info nameofexecutable]]] lib]\n"
582     "if {[lsearch -exact $auto_path $__dir] < 0} {\n"
583     "lappend auto_path $__dir\n"
584     "}\n"
585     "if {[info exist tcl_pkgPath]} {\n"
586     "foreach __dir $tcl_pkgPath {\n"
587     "if {[lsearch -exact $auto_path $__dir] < 0} {\n"
588     "lappend auto_path $__dir\n"
589     "}\n"
590     "}\n"
591     "}\n"
592     "if {[info exists __dir]} {\n"
593     "unset __dir\n"
594     "}\n"
595     "if {(![interp issafe]) && [string equal $tcl_platform(platform) \"windows\"]} {\n"
596     "namespace eval tcl {\n"
597     "proc envTraceProc {lo n1 n2 op} {\n"
598     "set x $::env($n2)\n"
599     "set ::env($lo) $x\n"
600     "set ::env([string toupper $lo]) $x\n"
601     "}\n"
602     "}\n"
603     "foreach p [array names env] {\n"
604     "set u [string toupper $p]\n"
605     "if {[string compare $u $p]} {\n"
606     "switch -- $u {\n"
607     "COMSPEC -\n"
608     "PATH {\n"
609     "if {![info exists env($u)]} {\n"
610     "set env($u) $env($p)\n"
611     "}\n"
612     "trace variable env($p) w [list tcl::envTraceProc $p]\n"
613     "trace variable env($u) w [list tcl::envTraceProc $p]\n"
614     "}\n"
615     "}\n"
616     "}\n"
617     "}\n"
618     "if {[info exists p]} {\n"
619     "unset p\n"
620     "}\n"
621     "if {[info exists u]} {\n"
622     "unset u\n"
623     "}\n"
624     "if {![info exists env(COMSPEC)]} {\n"
625     "if {[string equal $tcl_platform(os) \"Windows NT\"]} {\n"
626     "set env(COMSPEC) cmd.exe\n"
627     "} else {\n"
628     "set env(COMSPEC) command.com\n"
629     "}\n"
630     "}\n"
631     "}\n"
632     "package unknown tclPkgUnknown\n"
633     "if {[llength [info commands exec]] == 0} {\n"
634     "set auto_noexec 1\n"
635     "}\n"
636     "set errorCode \"\"\n"
637     "set errorInfo \"\"\n"
638     "if {[llength [info commands tclLog]] == 0} {\n"
639     "proc tclLog {string} {\n"
640     "catch {puts stderr $string}\n"
641     "}\n"
642     "}\n"
643     "proc unknown args {\n"
644     "global auto_noexec auto_noload env unknown_pending tcl_interactive\n"
645     "global errorCode errorInfo\n"
646     "set cmd [lindex $args 0]\n"
647     "if {[regexp \"^namespace\\[ \\t\\n\\]+inscope\" $cmd] && [llength $cmd] == 4} {\n"
648     "set arglist [lrange $args 1 end]\n"
649     "set ret [catch {uplevel $cmd $arglist} result]\n"
650     "if {$ret == 0} {\n"
651     "return $result\n"
652     "} else {\n"
653     "return -code $ret -errorcode $errorCode $result\n"
654     "}\n"
655     "}\n"
656     "set savedErrorCode $errorCode\n"
657     "set savedErrorInfo $errorInfo\n"
658     "set name [lindex $args 0]\n"
659     "if {![info exists auto_noload]} {\n"
660     "if {[info exists unknown_pending($name)]} {\n"
661     "return -code error \"self-referential recursion in \\\"unknown\\\" for command \\\"$name\\\"\";\n"
662     "}\n"
663     "set unknown_pending($name) pending;\n"
664     "set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]\n"
665     "unset unknown_pending($name);\n"
666     "if {$ret != 0} {\n"
667     "append errorInfo \"\\n (autoloading \\\"$name\\\")\"\n"
668     "return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg\n"
669     "}\n"
670     "if {![array size unknown_pending]} {\n"
671     "unset unknown_pending\n"
672     "}\n"
673     "if {$msg} {\n"
674     "set errorCode $savedErrorCode\n"
675     "set errorInfo $savedErrorInfo\n"
676     "set code [catch {uplevel 1 $args} msg]\n"
677     "if {$code == 1} {\n"
678     "set new [split $errorInfo \\n]\n"
679     "set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \\n]\n"
680     "return -code error -errorcode $errorCode \\\n"
681     "\011\011\011-errorinfo $new $msg\n"
682     "} else {\n"
683     "return -code $code $msg\n"
684     "}\n"
685     "}\n"
686     "}\n"
687     "if {([info level] == 1) && [string equal [info script] \"\"] \\\n"
688     "\011 && [info exists tcl_interactive] && $tcl_interactive} {\n"
689     "if {![info exists auto_noexec]} {\n"
690     "set new [auto_execok $name]\n"
691     "if {[string compare {} $new]} {\n"
692     "set errorCode $savedErrorCode\n"
693     "set errorInfo $savedErrorInfo\n"
694     "set redir \"\"\n"
695     "if {[string equal [info commands console] \"\"]} {\n"
696     "set redir \">&@stdout <@stdin\"\n"
697     "}\n"
698     "return [uplevel exec $redir $new [lrange $args 1 end]]\n"
699     "}\n"
700     "}\n"
701     "set errorCode $savedErrorCode\n"
702     "set errorInfo $savedErrorInfo\n"
703     "if {[string equal $name \"!!\"]} {\n"
704     "set newcmd [history event]\n"
705     "} elseif {[regexp {^!(.+)$} $name dummy event]} {\n"
706     "set newcmd [history event $event]\n"
707     "} elseif {[regexp {^\\^([^^]*)\\^([^^]*)\\^?$} $name dummy old new]} {\n"
708     "set newcmd [history event -1]\n"
709     "catch {regsub -all -- $old $newcmd $new newcmd}\n"
710     "}\n"
711     "if {[info exists newcmd]} {\n"
712     "tclLog $newcmd\n"
713     "history change $newcmd 0\n"
714     "return [uplevel $newcmd]\n"
715     "}\n"
716     "set ret [catch {set cmds [info commands $name*]} msg]\n"
717     "if {[string equal $name \"::\"]} {\n"
718     "set name \"\"\n"
719     "}\n"
720     "if {$ret != 0} {\n"
721     "return -code $ret -errorcode $errorCode \\\n"
722     "\011\011\"error in unknown while checking if \\\"$name\\\" is a unique command abbreviation: $msg\"\n"
723     "}\n"
724     "if {[llength $cmds] == 1} {\n"
725     "return [uplevel [lreplace $args 0 0 $cmds]]\n"
726     "}\n"
727     "if {[llength $cmds]} {\n"
728     "if {[string equal $name \"\"]} {\n"
729     "return -code error \"empty command name \\\"\\\"\"\n"
730     "} else {\n"
731     "return -code error \\\n"
732     "\011\011\011\"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n"
733     "}\n"
734     "}\n"
735     "}\n"
736     "return -code error \"invalid command name \\\"$name\\\"\"\n"
737     "}\n"
738     "proc auto_load {cmd {namespace {}}} {\n"
739     "global auto_index auto_oldpath auto_path\n"
740     "if {[string length $namespace] == 0} {\n"
741     "set namespace [uplevel {namespace current}]\n"
742     "}\n"
743     "set nameList [auto_qualify $cmd $namespace]\n"
744     "lappend nameList $cmd\n"
745     "foreach name $nameList {\n"
746     "if {[info exists auto_index($name)]} {\n"
747     "uplevel #0 $auto_index($name)\n"
748     "return [expr {[info commands $name] != \"\"}]\n"
749     "}\n"
750     "}\n"
751     "if {![info exists auto_path]} {\n"
752     "return 0\n"
753     "}\n"
754     "if {![auto_load_index]} {\n"
755     "return 0\n"
756     "}\n"
757     "foreach name $nameList {\n"
758     "if {[info exists auto_index($name)]} {\n"
759     "uplevel #0 $auto_index($name)\n"
760     "if { ![string equal [namespace which -command $name] \"\"] } {\n"
761     "return 1\n"
762     "}\n"
763     "}\n"
764     "}\n"
765     "return 0\n"
766     "}\n"
767     "proc auto_load_index {} {\n"
768     "global auto_index auto_oldpath auto_path errorInfo errorCode\n"
769     "if {[info exists auto_oldpath] && \\\n"
770     "\011 [string equal $auto_oldpath $auto_path]} {\n"
771     "return 0\n"
772     "}\n"
773     "set auto_oldpath $auto_path\n"
774     "set issafe [interp issafe]\n"
775     "for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {\n"
776     "set dir [lindex $auto_path $i]\n"
777     "set f \"\"\n"
778     "if {$issafe} {\n"
779     "catch {source [file join $dir tclIndex]}\n"
780     "} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {\n"
781     "continue\n"
782     "} else {\n"
783     "set error [catch {\n"
784     "set id [gets $f]\n"
785     "if {[string equal $id \\\n"
786     "\011\011\011\"# Tcl autoload index file, version 2.0\"]} {\n"
787     "eval [read $f]\n"
788     "} elseif {[string equal $id \"# Tcl autoload index file: each line identifies a Tcl\"]} {\n"
789     "while {[gets $f line] >= 0} {\n"
790     "if {[string equal [string index $line 0] \"#\"] \\\n"
791     "\011\011\011\011|| ([llength $line] != 2)} {\n"
792     "continue\n"
793     "}\n"
794     "set name [lindex $line 0]\n"
795     "set auto_index($name) \\\n"
796     "\011\011\011\011\"source [file join $dir [lindex $line 1]]\"\n"
797     "}\n"
798     "} else {\n"
799     "error \"[file join $dir tclIndex] isn't a proper Tcl index file\"\n"
800     "}\n"
801     "} msg]\n"
802     "if {[string compare $f \"\"]} {\n"
803     "close $f\n"
804     "}\n"
805     "if {$error} {\n"
806     "error $msg $errorInfo $errorCode\n"
807     "}\n"
808     "}\n"
809     "}\n"
810     "return 1\n"
811     "}\n"
812     "proc auto_qualify {cmd namespace} {\n"
813     "set n [regsub -all {::+} $cmd :: cmd]\n"
814     "if {[regexp {^::(.*)$} $cmd x tail]} {\n"
815     "if {$n > 1} {\n"
816     "return [list $cmd]\n"
817     "} else {\n"
818     "return [list $tail]\n"
819     "}\n"
820     "}\n"
821     "if {$n == 0} {\n"
822     "if {[string equal $namespace ::]} {\n"
823     "return [list $cmd]\n"
824     "} else {\n"
825     "return [list ${namespace}::$cmd $cmd]\n"
826     "}\n"
827     "} elseif {[string equal $namespace ::]} {\n"
828     "return [list ::$cmd]\n"
829     "} else {\n"
830     "return [list ${namespace}::$cmd ::$cmd]\n"
831     "}\n"
832     "}\n"
833     "proc auto_import {pattern} {\n"
834     "global auto_index\n"
835     "set ns [uplevel namespace current]\n"
836     "set patternList [auto_qualify $pattern $ns]\n"
837     "auto_load_index\n"
838     "foreach pattern $patternList {\n"
839     "foreach name [array names auto_index] {\n"
840     "if {[string match $pattern $name] && \\\n"
841     "\011\011 [string equal \"\" [info commands $name]]} {\n"
842     "uplevel #0 $auto_index($name)\n"
843     "}\n"
844     "}\n"
845     "}\n"
846     "}\n"
847     "if {[string equal windows $tcl_platform(platform)]} {\n"
848     "proc auto_execok name {\n"
849     "global auto_execs env tcl_platform\n"
850     "if {[info exists auto_execs($name)]} {\n"
851     "return $auto_execs($name)\n"
852     "}\n"
853     "set auto_execs($name) \"\"\n"
854     "set shellBuiltins [list cls copy date del erase dir echo mkdir \\\n"
855     "\011 md rename ren rmdir rd time type ver vol]\n"
856     "if {[string equal $tcl_platform(os) \"Windows NT\"]} {\n"
857     "lappend shellBuiltins \"start\"\n"
858     "}\n"
859     "if {[lsearch -exact $shellBuiltins $name] != -1} {\n"
860     "return [set auto_execs($name) [list $env(COMSPEC) /c $name]]\n"
861     "}\n"
862     "if {[llength [file split $name]] != 1} {\n"
863     "foreach ext {{} .com .exe .bat} {\n"
864     "set file ${name}${ext}\n"
865     "if {[file exists $file] && ![file isdirectory $file]} {\n"
866     "return [set auto_execs($name) [list $file]]\n"
867     "}\n"
868     "}\n"
869     "return \"\"\n"
870     "}\n"
871     "set path \"[file dirname [info nameof]];.;\"\n"
872     "if {[info exists env(WINDIR)]} {\n"
873     "set windir $env(WINDIR) \n"
874     "}\n"
875     "if {[info exists windir]} {\n"
876     "if {[string equal $tcl_platform(os) \"Windows NT\"]} {\n"
877     "append path \"$windir/system32;\"\n"
878     "}\n"
879     "append path \"$windir/system;$windir;\"\n"
880     "}\n"
881     "foreach var {PATH Path path} {\n"
882     "if {[info exists env($var)]} {\n"
883     "append path \";$env($var)\"\n"
884     "}\n"
885     "}\n"
886     "foreach dir [split $path {;}] {\n"
887     "if {[info exists checked($dir)] || [string equal {} $dir]} { continue }\n"
888     "set checked($dir) {}\n"
889     "foreach ext {{} .com .exe .bat} {\n"
890     "set file [file join $dir ${name}${ext}]\n"
891     "if {[file exists $file] && ![file isdirectory $file]} {\n"
892     "return [set auto_execs($name) [list $file]]\n"
893     "}\n"
894     "}\n"
895     "}\n"
896     "return \"\"\n"
897     "}\n"
898     "} else {\n"
899     "proc auto_execok name {\n"
900     "global auto_execs env\n"
901     "if {[info exists auto_execs($name)]} {\n"
902     "return $auto_execs($name)\n"
903     "}\n"
904     "set auto_execs($name) \"\"\n"
905     "if {[llength [file split $name]] != 1} {\n"
906     "if {[file executable $name] && ![file isdirectory $name]} {\n"
907     "set auto_execs($name) [list $name]\n"
908     "}\n"
909     "return $auto_execs($name)\n"
910     "}\n"
911     "foreach dir [split $env(PATH) :] {\n"
912     "if {[string equal $dir \"\"]} {\n"
913     "set dir .\n"
914     "}\n"
915     "set file [file join $dir $name]\n"
916     "if {[file executable $file] && ![file isdirectory $file]} {\n"
917     "set auto_execs($name) [list $file]\n"
918     "return $auto_execs($name)\n"
919     "}\n"
920     "}\n"
921     "return \"\"\n"
922     "}\n"
923     "}\n"
924     ;
925     static char Et_zFile3[] =
926     "namespace eval ::pkg {\n"
927     "}\n"
928     "proc pkg_compareExtension { fileName {ext {}} } {\n"
929     "global tcl_platform\n"
930     "if {[string length $ext] == 0} {\n"
931     "set ext [info sharedlibextension]\n"
932     "}\n"
933     "if {[string equal $tcl_platform(platform) \"windows\"]} {\n"
934     "return [string equal -nocase [file extension $fileName] $ext]\n"
935     "} else {\n"
936     "return [string equal [file extension $fileName] $ext]\n"
937     "}\n"
938     "}\n"
939     "proc pkg_mkIndex {args} {\n"
940     "global errorCode errorInfo\n"
941     "set usage {\"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?\"};\n"
942     "set argCount [llength $args]\n"
943     "if {$argCount < 1} {\n"
944     "return -code error \"wrong # args: should be\\n$usage\"\n"
945     "}\n"
946     "set more \"\"\n"
947     "set direct 1\n"
948     "set doVerbose 0\n"
949     "set loadPat \"\"\n"
950     "for {set idx 0} {$idx < $argCount} {incr idx} {\n"
951     "set flag [lindex $args $idx]\n"
952     "switch -glob -- $flag {\n"
953     "-- {\n"
954     "incr idx\n"
955     "break\n"
956     "}\n"
957     "-verbose {\n"
958     "set doVerbose 1\n"
959     "}\n"
960     "-lazy {\n"
961     "set direct 0\n"
962     "append more \" -lazy\"\n"
963     "}\n"
964     "-direct {\n"
965     "append more \" -direct\"\n"
966     "}\n"
967     "-load {\n"
968     "incr idx\n"
969     "set loadPat [lindex $args $idx]\n"
970     "append more \" -load $loadPat\"\n"
971     "}\n"
972     "-* {\n"
973     "return -code error \"unknown flag $flag: should be\\n$usage\"\n"
974     "}\n"
975     "default {\n"
976     "break\n"
977     "}\n"
978     "}\n"
979     "}\n"
980     "set dir [lindex $args $idx]\n"
981     "set patternList [lrange $args [expr {$idx + 1}] end]\n"
982     "if {[llength $patternList] == 0} {\n"
983     "set patternList [list \"*.tcl\" \"*[info sharedlibextension]\"]\n"
984     "}\n"
985     "set oldDir [pwd]\n"
986     "cd $dir\n"
987     "if {[catch {eval glob $patternList} fileList]} {\n"
988     "global errorCode errorInfo\n"
989     "cd $oldDir\n"
990     "return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList\n"
991     "}\n"
992     "foreach file $fileList {\n"
993     "if {[string equal $file \"pkgIndex.tcl\"]} {\n"
994     "continue\n"
995     "}\n"
996     "cd $oldDir\n"
997     "set c [interp create]\n"
998     "foreach pkg [info loaded] {\n"
999     "if {! [string match $loadPat [lindex $pkg 1]]} {\n"
1000     "continue\n"
1001     "}\n"
1002     "if {[catch {\n"
1003     "load [lindex $pkg 0] [lindex $pkg 1] $c\n"
1004     "} err]} {\n"
1005     "if {$doVerbose} {\n"
1006     "tclLog \"warning: load [lindex $pkg 0] [lindex $pkg 1]\\nfailed with: $err\"\n"
1007     "}\n"
1008     "} elseif {$doVerbose} {\n"
1009     "tclLog \"loaded [lindex $pkg 0] [lindex $pkg 1]\"\n"
1010     "}\n"
1011     "if {[string equal [lindex $pkg 1] \"Tk\"]} {\n"
1012     "$c eval [list wm withdraw .]\n"
1013     "}\n"
1014     "}\n"
1015     "cd $dir\n"
1016     "$c eval {\n"
1017     "rename package __package_orig\n"
1018     "proc package {what args} {\n"
1019     "switch -- $what {\n"
1020     "require { return ; # ignore transitive requires }\n"
1021     "default { eval __package_orig {$what} $args }\n"
1022     "}\n"
1023     "}\n"
1024     "proc tclPkgUnknown args {}\n"
1025     "package unknown tclPkgUnknown\n"
1026     "proc unknown {args} {}\n"
1027     "proc auto_import {args} {}\n"
1028     "namespace eval ::tcl {\n"
1029     "variable file\011\011;# Current file being processed\n"
1030     "variable direct\011\011;# -direct flag value\n"
1031     "variable x\011\011;# Loop variable\n"
1032     "variable debug\011\011;# For debugging\n"
1033     "variable type\011\011;# \"load\" or \"source\", for -direct\n"
1034     "variable namespaces\011;# Existing namespaces (e.g., ::tcl)\n"
1035     "variable packages\011;# Existing packages (e.g., Tcl)\n"
1036     "variable origCmds\011;# Existing commands\n"
1037     "variable newCmds\011;# Newly created commands\n"
1038     "variable newPkgs {}\011;# Newly created packages\n"
1039     "}\n"
1040     "}\n"
1041     "$c eval [list set ::tcl::file $file]\n"
1042     "$c eval [list set ::tcl::direct $direct]\n"
1043     "foreach p {pkg_compareExtension} {\n"
1044     "$c eval [list proc $p [info args $p] [info body $p]]\n"
1045     "}\n"
1046     "if {[catch {\n"
1047     "$c eval {\n"
1048     "set ::tcl::debug \"loading or sourcing\"\n"
1049     "proc ::tcl::GetAllNamespaces {{root ::}} {\n"
1050     "set list $root\n"
1051     "foreach ns [namespace children $root] {\n"
1052     "eval lappend list [::tcl::GetAllNamespaces $ns]\n"
1053     "}\n"
1054     "return $list\n"
1055     "}\n"
1056     "foreach ::tcl::x [::tcl::GetAllNamespaces] {\n"
1057     "set ::tcl::namespaces($::tcl::x) 1\n"
1058     "}\n"
1059     "foreach ::tcl::x [package names] {\n"
1060     "set ::tcl::packages($::tcl::x) 1\n"
1061     "}\n"
1062     "set ::tcl::origCmds [info commands]\n"
1063     "if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {\n"
1064     "set ::tcl::debug loading\n"
1065     "load [file join . $::tcl::file]\n"
1066     "set ::tcl::type load\n"
1067     "} else {\n"
1068     "set ::tcl::debug sourcing\n"
1069     "source $::tcl::file\n"
1070     "set ::tcl::type source\n"
1071     "}\n"
1072     "if { !$::tcl::direct } {\n"
1073     "foreach ::tcl::x [::tcl::GetAllNamespaces] {\n"
1074     "if {! [info exists ::tcl::namespaces($::tcl::x)]} {\n"
1075     "namespace import -force ${::tcl::x}::*\n"
1076     "}\n"
1077     "foreach ::tcl::x [info commands] {\n"
1078     "set ::tcl::newCmds($::tcl::x) 1\n"
1079     "}\n"
1080     "foreach ::tcl::x $::tcl::origCmds {\n"
1081     "catch {unset ::tcl::newCmds($::tcl::x)}\n"
1082     "}\n"
1083     "foreach ::tcl::x [array names ::tcl::newCmds] {\n"
1084     "set ::tcl::abs [namespace origin $::tcl::x]\n"
1085     "set ::tcl::abs \\\n"
1086     "\011\011\011\011 [lindex [auto_qualify $::tcl::abs ::] 0]\n"
1087     "if {[string compare $::tcl::x $::tcl::abs]} {\n"
1088     "set ::tcl::newCmds($::tcl::abs) 1\n"
1089     "unset ::tcl::newCmds($::tcl::x)\n"
1090     "}\n"
1091     "}\n"
1092     "}\n"
1093     "}\n"
1094     "foreach ::tcl::x [package names] {\n"
1095     "if {[string compare [package provide $::tcl::x] \"\"] \\\n"
1096     "\011\011\011 && ![info exists ::tcl::packages($::tcl::x)]} {\n"
1097     "lappend ::tcl::newPkgs \\\n"
1098     "\011\011\011 [list $::tcl::x [package provide $::tcl::x]]\n"
1099     "}\n"
1100     "}\n"
1101     "}\n"
1102     "} msg] == 1} {\n"
1103     "set what [$c eval set ::tcl::debug]\n"
1104     "if {$doVerbose} {\n"
1105     "tclLog \"warning: error while $what $file: $msg\"\n"
1106     "}\n"
1107     "} else {\n"
1108     "set type [$c eval set ::tcl::type]\n"
1109     "set cmds [lsort [$c eval array names ::tcl::newCmds]]\n"
1110     "set pkgs [$c eval set ::tcl::newPkgs]\n"
1111     "if {[llength $pkgs] > 1} {\n"
1112     "tclLog \"warning: \\\"$file\\\" provides more than one package ($pkgs)\"\n"
1113     "}\n"
1114     "foreach pkg $pkgs {\n"
1115     "lappend files($pkg) [list $file $type $cmds]\n"
1116     "}\n"
1117     "if {$doVerbose} {\n"
1118     "tclLog \"processed $file\"\n"
1119     "}\n"
1120     "interp delete $c\n"
1121     "}\n"
1122     "}\n"
1123     "append index \"# Tcl package index file, version 1.1\\n\"\n"
1124     "append index \"# This file is generated by the \\\"pkg_mkIndex$more\\\" command\\n\"\n"
1125     "append index \"# and sourced either when an application starts up or\\n\"\n"
1126     "append index \"# by a \\\"package unknown\\\" script. It invokes the\\n\"\n"
1127     "append index \"# \\\"package ifneeded\\\" command to set up package-related\\n\"\n"
1128     "append index \"# information so that packages will be loaded automatically\\n\"\n"
1129     "append index \"# in response to \\\"package require\\\" commands. When this\\n\"\n"
1130     "append index \"# script is sourced, the variable \\$dir must contain the\\n\"\n"
1131     "append index \"# full path name of this file's directory.\\n\"\n"
1132     "foreach pkg [lsort [array names files]] {\n"
1133     "set cmd {}\n"
1134     "foreach {name version} $pkg {\n"
1135     "break\n"
1136     "}\n"
1137     "lappend cmd ::pkg::create -name $name -version $version\n"
1138     "foreach spec $files($pkg) {\n"
1139     "foreach {file type procs} $spec {\n"
1140     "if { $direct } {\n"
1141     "set procs {}\n"
1142     "}\n"
1143     "lappend cmd \"-$type\" [list $file $procs]\n"
1144     "}\n"
1145     "}\n"
1146     "append index \"\\n[eval $cmd]\"\n"
1147     "}\n"
1148     "set f [open pkgIndex.tcl w]\n"
1149     "puts $f $index\n"
1150     "close $f\n"
1151     "cd $oldDir\n"
1152     "}\n"
1153     "proc tclPkgSetup {dir pkg version files} {\n"
1154     "global auto_index\n"
1155     "package provide $pkg $version\n"
1156     "foreach fileInfo $files {\n"
1157     "set f [lindex $fileInfo 0]\n"
1158     "set type [lindex $fileInfo 1]\n"
1159     "foreach cmd [lindex $fileInfo 2] {\n"
1160     "if {[string equal $type \"load\"]} {\n"
1161     "set auto_index($cmd) [list load [file join $dir $f] $pkg]\n"
1162     "} else {\n"
1163     "set auto_index($cmd) [list source [file join $dir $f]]\n"
1164     "} \n"
1165     "}\n"
1166     "}\n"
1167     "}\n"
1168     "proc tclMacPkgSearch {dir} {\n"
1169     "foreach x [glob -nocomplain [file join $dir *.shlb]] {\n"
1170     "if {[file isfile $x]} {\n"
1171     "set res [resource open $x]\n"
1172     "foreach y [resource list TEXT $res] {\n"
1173     "if {[string equal $y \"pkgIndex\"]} {source -rsrc pkgIndex}\n"
1174     "}\n"
1175     "catch {resource close $res}\n"
1176     "}\n"
1177     "}\n"
1178     "}\n"
1179     "proc tclPkgUnknown {name version {exact {}}} {\n"
1180     "global auto_path tcl_platform env\n"
1181     "if {![info exists auto_path]} {\n"
1182     "return\n"
1183     "}\n"
1184     "set old_path [set use_path $auto_path]\n"
1185     "while {[llength $use_path]} {\n"
1186     "set dir [lindex $use_path end]\n"
1187     "catch {\n"
1188     "foreach file [glob -nocomplain [file join $dir * pkgIndex.tcl]] {\n"
1189     "set dir [file dirname $file]\n"
1190     "if {[file readable $file] && ![info exists procdDirs($dir)]} {\n"
1191     "if {[catch {source $file} msg]} {\n"
1192     "tclLog \"error reading package index file $file: $msg\"\n"
1193     "} else {\n"
1194     "set procdDirs($dir) 1\n"
1195     "}\n"
1196     "}\n"
1197     "}\n"
1198     "}\n"
1199     "set dir [lindex $use_path end]\n"
1200     "set file [file join $dir pkgIndex.tcl]\n"
1201     "if {([interp issafe] || [file readable $file]) && \\\n"
1202     "\011\011![info exists procdDirs($dir)]} {\n"
1203     "if {[catch {source $file} msg] && ![interp issafe]} {\n"
1204     "tclLog \"error reading package index file $file: $msg\"\n"
1205     "} else {\n"
1206     "set procdDirs($dir) 1\n"
1207     "}\n"
1208     "}\n"
1209     "if {(![interp issafe]) && \\\n"
1210     "\011\011[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
1211     "set dir [lindex $use_path end]\n"
1212     "if {![info exists procdDirs($dir)]} {\n"
1213     "tclMacPkgSearch $dir\n"
1214     "set procdDirs($dir) 1\n"
1215     "}\n"
1216     "foreach x [glob -nocomplain [file join $dir *]] {\n"
1217     "if {[file isdirectory $x] && ![info exists procdDirs($x)]} {\n"
1218     "set dir $x\n"
1219     "tclMacPkgSearch $dir\n"
1220     "set procdDirs($dir) 1\n"
1221     "}\n"
1222     "}\n"
1223     "}\n"
1224     "set use_path [lrange $use_path 0 end-1]\n"
1225     "if {[string compare $old_path $auto_path]} {\n"
1226     "foreach dir $auto_path {\n"
1227     "lappend use_path $dir\n"
1228     "}\n"
1229     "set old_path $auto_path\n"
1230     "}\n"
1231     "}\n"
1232     "}\n"
1233     "proc ::pkg::create {args} {\n"
1234     "append err(usage) \"[lindex [info level 0] 0] \"\n"
1235     "append err(usage) \"-name packageName -version packageVersion\"\n"
1236     "append err(usage) \"?-load {filename ?{procs}?}? ... \"\n"
1237     "append err(usage) \"?-source {filename ?{procs}?}? ...\"\n"
1238     "set err(wrongNumArgs) \"wrong # args: should be \\\"$err(usage)\\\"\"\n"
1239     "set err(valueMissing) \"value for \\\"%s\\\" missing: should be \\\"$err(usage)\\\"\"\n"
1240     "set err(unknownOpt) \"unknown option \\\"%s\\\": should be \\\"$err(usage)\\\"\"\n"
1241     "set err(noLoadOrSource) \"at least one of -load and -source must be given\"\n"
1242     "set len [llength $args]\n"
1243     "if { $len < 6 } {\n"
1244     "error $err(wrongNumArgs)\n"
1245     "}\n"
1246     "set opts(-name)\011\011{}\n"
1247     "set opts(-version)\011\011{}\n"
1248     "set opts(-source)\011\011{}\n"
1249     "set opts(-load)\011\011{}\n"
1250     "for {set i 0} {$i < $len} {incr i} {\n"
1251     "set flag [lindex $args $i]\n"
1252     "incr i\n"
1253     "switch -glob -- $flag {\n"
1254     "\"-name\"\011\011-\n"
1255     "\"-version\"\011\011{\n"
1256     "if { $i >= $len } {\n"
1257     "error [format $err(valueMissing) $flag]\n"
1258     "}\n"
1259     "set opts($flag) [lindex $args $i]\n"
1260     "}\n"
1261     "\"-source\"\011\011-\n"
1262     "\"-load\"\011\011{\n"
1263     "if { $i >= $len } {\n"
1264     "error [format $err(valueMissing) $flag]\n"
1265     "}\n"
1266     "lappend opts($flag) [lindex $args $i]\n"
1267     "}\n"
1268     "default {\n"
1269     "error [format $err(unknownOpt) [lindex $args $i]]\n"
1270     "}\n"
1271     "}\n"
1272     "}\n"
1273     "if { [llength $opts(-name)] == 0 } {\n"
1274     "error [format $err(valueMissing) \"-name\"]\n"
1275     "}\n"
1276     "if { [llength $opts(-version)] == 0 } {\n"
1277     "error [format $err(valueMissing) \"-version\"]\n"
1278     "}\n"
1279     "if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {\n"
1280     "error $err(noLoadOrSource)\n"
1281     "}\n"
1282     "set cmdline \"package ifneeded $opts(-name) $opts(-version) \"\n"
1283     "set cmdList {}\n"
1284     "set lazyFileList {}\n"
1285     "foreach key {load source} {\n"
1286     "foreach filespec $opts(-$key) {\n"
1287     "foreach {filename proclist} {{} {}} {\n"
1288     "break\n"
1289     "}\n"
1290     "foreach {filename proclist} $filespec {\n"
1291     "break\n"
1292     "}\n"
1293     "if { [llength $proclist] == 0 } {\n"
1294     "set cmd \"\\[list $key \\[file join \\$dir [list $filename]\\]\\]\"\n"
1295     "lappend cmdList $cmd\n"
1296     "} else {\n"
1297     "lappend lazyFileList [list $filename $key $proclist]\n"
1298     "}\n"
1299     "}\n"
1300     "}\n"
1301     "if { [llength $lazyFileList] > 0 } {\n"
1302     "lappend cmdList \"\\[list tclPkgSetup \\$dir $opts(-name)\\\n"
1303     "\011\011$opts(-version) [list $lazyFileList]\\]\"\n"
1304     "}\n"
1305     "append cmdline [join $cmdList \"\\\\n\"]\n"
1306     "return $cmdline\n"
1307     "}\n"
1308     ;
1309     static char Et_zFile4[] =
1310     "proc parray {a {pattern *}} {\n"
1311     "upvar 1 $a array\n"
1312     "if {![array exists array]} {\n"
1313     "error \"\\\"$a\\\" isn't an array\"\n"
1314     "}\n"
1315     "set maxl 0\n"
1316     "foreach name [lsort [array names array $pattern]] {\n"
1317     "if {[string length $name] > $maxl} {\n"
1318     "set maxl [string length $name]\n"
1319     "}\n"
1320     "}\n"
1321     "set maxl [expr {$maxl + [string length $a] + 2}]\n"
1322     "foreach name [lsort [array names array $pattern]] {\n"
1323     "set nameString [format %s(%s) $a $name]\n"
1324     "puts stdout [format \"%-*s = %s\" $maxl $nameString $array($name)]\n"
1325     "}\n"
1326     "}\n"
1327     ;
1328     static char Et_zFile5[] =
1329     "package require opt 0.4.1;\n"
1330     "namespace eval ::safe {\n"
1331     "namespace export interpCreate interpInit interpConfigure interpDelete \\\n"
1332     "\011 interpAddToAccessPath interpFindInAccessPath setLogCmd\n"
1333     "set temp [::tcl::OptKeyRegister {\n"
1334     "{-accessPath -list {} \"access path for the slave\"}\n"
1335     "{-noStatics \"prevent loading of statically linked pkgs\"}\n"
1336     "{-statics true \"loading of statically linked pkgs\"}\n"
1337     "{-nestedLoadOk \"allow nested loading\"}\n"
1338     "{-nested false \"nested loading\"}\n"
1339     "{-deleteHook -script {} \"delete hook\"}\n"
1340     "}]\n"
1341     "::tcl::OptKeyRegister {\n"
1342     "{?slave? -name {} \"name of the slave (optional)\"}\n"
1343     "} ::safe::interpCreate\n"
1344     "lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)\n"
1345     "::tcl::OptKeyRegister {\n"
1346     "{slave -name {} \"name of the slave\"}\n"
1347     "} ::safe::interpIC\n"
1348     "lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)\n"
1349     "::tcl::OptKeyDelete $temp\n"
1350     "proc InterpStatics {} {\n"
1351     "foreach v {Args statics noStatics} {\n"
1352     "upvar $v $v\n"
1353     "}\n"
1354     "set flag [::tcl::OptProcArgGiven -noStatics];\n"
1355     "if {$flag && ($noStatics == $statics) \n"
1356     "&& ([::tcl::OptProcArgGiven -statics])} {\n"
1357     "return -code error\\\n"
1358     "\011\011 \"conflicting values given for -statics and -noStatics\"\n"
1359     "}\n"
1360     "if {$flag} {\n"
1361     "return [expr {!$noStatics}]\n"
1362     "} else {\n"
1363     "return $statics\n"
1364     "}\n"
1365     "}\n"
1366     "proc InterpNested {} {\n"
1367     "foreach v {Args nested nestedLoadOk} {\n"
1368     "upvar $v $v\n"
1369     "}\n"
1370     "set flag [::tcl::OptProcArgGiven -nestedLoadOk];\n"
1371     "if {$flag && ($nestedLoadOk != $nested) \n"
1372     "&& ([::tcl::OptProcArgGiven -nested])} {\n"
1373     "return -code error\\\n"
1374     "\011\011 \"conflicting values given for -nested and -nestedLoadOk\"\n"
1375     "}\n"
1376     "if {$flag} {\n"
1377     "return $nestedLoadOk\n"
1378     "} else {\n"
1379     "return $nested\n"
1380     "}\n"
1381     "}\n"
1382     "proc interpCreate {args} {\n"
1383     "set Args [::tcl::OptKeyParse ::safe::interpCreate $args]\n"
1384     "InterpCreate $slave $accessPath \\\n"
1385     "\011\011[InterpStatics] [InterpNested] $deleteHook\n"
1386     "}\n"
1387     "proc interpInit {args} {\n"
1388     "set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n"
1389     "if {![::interp exists $slave]} {\n"
1390     "return -code error \"\\\"$slave\\\" is not an interpreter\"\n"
1391     "}\n"
1392     "InterpInit $slave $accessPath \\\n"
1393     "\011\011[InterpStatics] [InterpNested] $deleteHook;\n"
1394     "}\n"
1395     "proc CheckInterp {slave} {\n"
1396     "if {![IsInterp $slave]} {\n"
1397     "return -code error \\\n"
1398     "\011\011 \"\\\"$slave\\\" is not an interpreter managed by ::safe::\"\n"
1399     "}\n"
1400     "}\n"
1401     "proc interpConfigure {args} {\n"
1402     "switch [llength $args] {\n"
1403     "1 {\n"
1404     "set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n"
1405     "CheckInterp $slave\n"
1406     "set res {}\n"
1407     "lappend res [list -accessPath [Set [PathListName $slave]]]\n"
1408     "lappend res [list -statics [Set [StaticsOkName $slave]]]\n"
1409     "lappend res [list -nested [Set [NestedOkName $slave]]]\n"
1410     "lappend res [list -deleteHook [Set [DeleteHookName $slave]]]\n"
1411     "join $res\n"
1412     "}\n"
1413     "2 {\n"
1414     "::tcl::Lassign $args slave arg\n"
1415     "set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]\n"
1416     "set hits [::tcl::OptHits desc $arg]\n"
1417     "if {$hits > 1} {\n"
1418     "return -code error [::tcl::OptAmbigous $desc $arg]\n"
1419     "} elseif {$hits == 0} {\n"
1420     "return -code error [::tcl::OptFlagUsage $desc $arg]\n"
1421     "}\n"
1422     "CheckInterp $slave\n"
1423     "set item [::tcl::OptCurDesc $desc]\n"
1424     "set name [::tcl::OptName $item]\n"
1425     "switch -exact -- $name {\n"
1426     "-accessPath {\n"
1427     "return [list -accessPath [Set [PathListName $slave]]]\n"
1428     "}\n"
1429     "-statics {\n"
1430     "return [list -statics [Set [StaticsOkName $slave]]]\n"
1431     "}\n"
1432     "-nested {\n"
1433     "return [list -nested [Set [NestedOkName $slave]]]\n"
1434     "}\n"
1435     "-deleteHook {\n"
1436     "return [list -deleteHook [Set [DeleteHookName $slave]]]\n"
1437     "}\n"
1438     "-noStatics {\n"
1439     "return -code error\\\n"
1440     "\011\011\011\011\"ambigous query (get or set -noStatics ?)\\\n"
1441     "\011\011\011\011use -statics instead\"\n"
1442     "}\n"
1443     "-nestedLoadOk {\n"
1444     "return -code error\\\n"
1445     "\011\011\011\011\"ambigous query (get or set -nestedLoadOk ?)\\\n"
1446     "\011\011\011\011use -nested instead\"\n"
1447     "}\n"
1448     "default {\n"
1449     "return -code error \"unknown flag $name (bug)\"\n"
1450     "}\n"
1451     "}\n"
1452     "}\n"
1453     "default {\n"
1454     "set Args [::tcl::OptKeyParse ::safe::interpIC $args]\n"
1455     "CheckInterp $slave\n"
1456     "if {![::tcl::OptProcArgGiven -accessPath]} {\n"
1457     "set doreset 1\n"
1458     "set accessPath [Set [PathListName $slave]]\n"
1459     "} else {\n"
1460     "set doreset 0\n"
1461     "}\n"
1462     "if {(![::tcl::OptProcArgGiven -statics]) \\\n"
1463     "\011\011\011&& (![::tcl::OptProcArgGiven -noStatics]) } {\n"
1464     "set statics [Set [StaticsOkName $slave]]\n"
1465     "} else {\n"
1466     "set statics [InterpStatics]\n"
1467     "}\n"
1468     "if {([::tcl::OptProcArgGiven -nested]) \\\n"
1469     "\011\011\011|| ([::tcl::OptProcArgGiven -nestedLoadOk]) } {\n"
1470     "set nested [InterpNested]\n"
1471     "} else {\n"
1472     "set nested [Set [NestedOkName $slave]]\n"
1473     "}\n"
1474     "if {![::tcl::OptProcArgGiven -deleteHook]} {\n"
1475     "set deleteHook [Set [DeleteHookName $slave]]\n"
1476     "}\n"
1477     "InterpSetConfig $slave $accessPath $statics $nested $deleteHook\n"
1478     "if {$doreset} {\n"
1479     "if {[catch {::interp eval $slave {auto_reset}} msg]} {\n"
1480     "Log $slave \"auto_reset failed: $msg\"\n"
1481     "} else {\n"
1482     "Log $slave \"successful auto_reset\" NOTICE\n"
1483     "}\n"
1484     "}\n"
1485     "}\n"
1486     "}\n"
1487     "}\n"
1488     "proc ::safe::InterpCreate {\n"
1489     "slave \n"
1490     "access_path\n"
1491     "staticsok\n"
1492     "nestedok\n"
1493     "deletehook\n"
1494     "} {\n"
1495     "if {[string compare \"\" $slave]} {\n"
1496     "::interp create -safe $slave\n"
1497     "} else {\n"
1498     "set slave [::interp create -safe]\n"
1499     "}\n"
1500     "Log $slave \"Created\" NOTICE\n"
1501     "InterpInit $slave $access_path $staticsok $nestedok $deletehook\n"
1502     "}\n"
1503     "proc ::safe::InterpSetConfig {slave access_path staticsok\\\n"
1504     "\011 nestedok deletehook} {\n"
1505     "if {[string equal \"\" $access_path]} {\n"
1506     "set access_path [uplevel #0 set auto_path]\n"
1507     "set where [lsearch -exact $access_path [info library]]\n"
1508     "if {$where == -1} {\n"
1509     "set access_path [concat [list [info library]] $access_path]\n"
1510     "Log $slave \"tcl_library was not in auto_path,\\\n"
1511     "\011\011\011added it to slave's access_path\" NOTICE\n"
1512     "} elseif {$where != 0} {\n"
1513     "set access_path [concat [list [info library]]\\\n"
1514     "\011\011\011[lreplace $access_path $where $where]]\n"
1515     "Log $slave \"tcl_libray was not in first in auto_path,\\\n"
1516     "\011\011\011moved it to front of slave's access_path\" NOTICE\n"
1517     "}\n"
1518     "set access_path [AddSubDirs $access_path]\n"
1519     "}\n"
1520     "Log $slave \"Setting accessPath=($access_path) staticsok=$staticsok\\\n"
1521     "\011\011nestedok=$nestedok deletehook=($deletehook)\" NOTICE\n"
1522     "set nname [PathNumberName $slave]\n"
1523     "if {[Exists $nname]} {\n"
1524     "set n [Set $nname]\n"
1525     "for {set i 0} {$i<$n} {incr i} {\n"
1526     "Unset [PathToken $i $slave]\n"
1527     "}\n"
1528     "}\n"
1529     "set slave_auto_path {}\n"
1530     "set i 0\n"
1531     "foreach dir $access_path {\n"
1532     "Set [PathToken $i $slave] $dir\n"
1533     "lappend slave_auto_path \"\\$[PathToken $i]\"\n"
1534     "incr i\n"
1535     "}\n"
1536     "Set $nname $i\n"
1537     "Set [PathListName $slave] $access_path\n"
1538     "Set [VirtualPathListName $slave] $slave_auto_path\n"
1539     "Set [StaticsOkName $slave] $staticsok\n"
1540     "Set [NestedOkName $slave] $nestedok\n"
1541     "Set [DeleteHookName $slave] $deletehook\n"
1542     "SyncAccessPath $slave\n"
1543     "}\n"
1544     "proc ::safe::interpFindInAccessPath {slave path} {\n"
1545     "set access_path [GetAccessPath $slave]\n"
1546     "set where [lsearch -exact $access_path $path]\n"
1547     "if {$where == -1} {\n"
1548     "return -code error \"$path not found in access path $access_path\"\n"
1549     "}\n"
1550     "return \"\\$[PathToken $where]\"\n"
1551     "}\n"
1552     "proc ::safe::interpAddToAccessPath {slave path} {\n"
1553     "if {![catch {interpFindInAccessPath $slave $path} res]} {\n"
1554     "return $res\n"
1555     "}\n"
1556     "set nname [PathNumberName $slave]\n"
1557     "set n [Set $nname]\n"
1558     "Set [PathToken $n $slave] $path\n"
1559     "set token \"\\$[PathToken $n]\"\n"
1560     "Lappend [VirtualPathListName $slave] $token\n"
1561     "Lappend [PathListName $slave] $path\n"
1562     "Set $nname [expr {$n+1}]\n"
1563     "SyncAccessPath $slave\n"
1564     "return $token\n"
1565     "}\n"
1566     "proc ::safe::InterpInit {\n"
1567     "slave \n"
1568     "access_path\n"
1569     "staticsok\n"
1570     "nestedok\n"
1571     "deletehook\n"
1572     "} {\n"
1573     "InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook\n"
1574     "::interp alias $slave source {} [namespace current]::AliasSource $slave\n"
1575     "::interp alias $slave load {} [namespace current]::AliasLoad $slave\n"
1576     "::interp alias $slave encoding {} [namespace current]::AliasEncoding \\\n"
1577     "\011\011$slave\n"
1578     "AliasSubset $slave file file dir.* join root.* ext.* tail \\\n"
1579     "\011\011path.* split\n"
1580     "::interp alias $slave exit {} [namespace current]::interpDelete $slave\n"
1581     "if {[catch {::interp eval $slave\\\n"
1582     "\011\011{source [file join $tcl_library init.tcl]}} msg]} {\n"
1583     "Log $slave \"can't source init.tcl ($msg)\"\n"
1584     "error \"can't source init.tcl into slave $slave ($msg)\"\n"
1585     "}\n"
1586     "return $slave\n"
1587     "}\n"
1588     "proc AddSubDirs {pathList} {\n"
1589     "set res {}\n"
1590     "foreach dir $pathList {\n"
1591     "if {[file isdirectory $dir]} {\n"
1592     "if {[lsearch -exact $res $dir]<0} {\n"
1593     "lappend res $dir\n"
1594     "}\n"
1595     "foreach sub [glob -nocomplain -- [file join $dir *]] {\n"
1596     "if {([file isdirectory $sub]) \\\n"
1597     "\011\011\011 && ([lsearch -exact $res $sub]<0) } {\n"
1598     "lappend res $sub\n"
1599     "}\n"
1600     "}\n"
1601     "}\n"
1602     "}\n"
1603     "return $res\n"
1604     "}\n"
1605     "proc ::safe::interpDelete {slave} {\n"
1606     "Log $slave \"About to delete\" NOTICE\n"
1607     "set hookname [DeleteHookName $slave]\n"
1608     "if {[Exists $hookname]} {\n"
1609     "set hook [Set $hookname]\n"
1610     "if {![::tcl::Lempty $hook]} {\n"
1611     "Unset $hookname\n"
1612     "if {[catch {eval $hook [list $slave]} err]} {\n"
1613     "Log $slave \"Delete hook error ($err)\"\n"
1614     "}\n"
1615     "}\n"
1616     "}\n"
1617     "set statename [InterpStateName $slave]\n"
1618     "if {[Exists $statename]} {\n"
1619     "Unset $statename\n"
1620     "}\n"
1621     "if {[::interp exists $slave]} {\n"
1622     "::interp delete $slave\n"
1623     "Log $slave \"Deleted\" NOTICE\n"
1624     "}\n"
1625     "return\n"
1626     "}\n"
1627     "proc ::safe::setLogCmd {args} {\n"
1628     "variable Log\n"
1629     "if {[llength $args] == 0} {\n"
1630     "return $Log\n"
1631     "} else {\n"
1632     "if {[llength $args] == 1} {\n"
1633     "set Log [lindex $args 0]\n"
1634     "} else {\n"
1635     "set Log $args\n"
1636     "}\n"
1637     "}\n"
1638     "}\n"
1639     "variable Log {}\n"
1640     "proc SyncAccessPath {slave} {\n"
1641     "set slave_auto_path [Set [VirtualPathListName $slave]]\n"
1642     "::interp eval $slave [list set auto_path $slave_auto_path]\n"
1643     "Log $slave \"auto_path in $slave has been set to $slave_auto_path\"\\\n"
1644     "\011\011NOTICE\n"
1645     "::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]]\n"
1646     "}\n"
1647     "proc InterpStateName {slave} {\n"
1648     "return \"S$slave\"\n"
1649     "}\n"
1650     "proc IsInterp {slave} {\n"
1651     "expr {[Exists [InterpStateName $slave]] && [::interp exists $slave]}\n"
1652     "}\n"
1653     "proc PathToken {n {slave \"\"}} {\n"
1654     "if {[string compare \"\" $slave]} {\n"
1655     "return \"[InterpStateName $slave](access_path,$n)\"\n"
1656     "} else {\n"
1657     "return \"p(:$n:)\"\n"
1658     "}\n"
1659     "}\n"
1660     "proc PathListName {slave} {\n"
1661     "return \"[InterpStateName $slave](access_path)\"\n"
1662     "}\n"
1663     "proc VirtualPathListName {slave} {\n"
1664     "return \"[InterpStateName $slave](access_path_slave)\"\n"
1665     "}\n"
1666     "proc PathNumberName {slave} {\n"
1667     "return \"[InterpStateName $slave](access_path,n)\"\n"
1668     "}\n"
1669     "proc StaticsOkName {slave} {\n"
1670     "return \"[InterpStateName $slave](staticsok)\"\n"
1671     "}\n"
1672     "proc NestedOkName {slave} {\n"
1673     "return \"[InterpStateName $slave](nestedok)\"\n"
1674     "}\n"
1675     "proc Toplevel {args} {\n"
1676     "namespace eval [namespace current] $args\n"
1677     "}\n"
1678     "proc Set {args} {\n"
1679     "eval Toplevel set $args\n"
1680     "}\n"
1681     "proc Lappend {args} {\n"
1682     "eval Toplevel lappend $args\n"
1683     "}\n"
1684     "proc Unset {args} {\n"
1685     "eval Toplevel unset $args\n"
1686     "}\n"
1687     "proc Exists {varname} {\n"
1688     "Toplevel info exists $varname\n"
1689     "}\n"
1690     "proc GetAccessPath {slave} {\n"
1691     "Set [PathListName $slave]\n"
1692     "}\n"
1693     "proc StaticsOk {slave} {\n"
1694     "Set [StaticsOkName $slave]\n"
1695     "}\n"
1696     "proc NestedOk {slave} {\n"
1697     "Set [NestedOkName $slave]\n"
1698     "}\n"
1699     "proc DeleteHookName {slave} {\n"
1700     "return [InterpStateName $slave](cleanupHook)\n"
1701     "}\n"
1702     "proc TranslatePath {slave path} {\n"
1703     "if {[regexp {(::)|(\\.\\.)} $path]} {\n"
1704     "error \"invalid characters in path $path\"\n"
1705     "}\n"
1706     "set n [expr {[Set [PathNumberName $slave]]-1}]\n"
1707     "for {} {$n>=0} {incr n -1} {\n"
1708     "set [PathToken $n] [Set [PathToken $n $slave]]\n"
1709     "}\n"
1710     "subst -nobackslashes -nocommands $path\n"
1711     "}\n"
1712     "proc Log {slave msg {type ERROR}} {\n"
1713     "variable Log\n"
1714     "if {[info exists Log] && [llength $Log]} {\n"
1715     "eval $Log [list \"$type for slave $slave : $msg\"]\n"
1716     "}\n"
1717     "}\n"
1718     "proc CheckFileName {slave file} {\n"
1719     "set ftail [file tail $file]\n"
1720     "if {[string length $ftail]>14} {\n"
1721     "error \"$ftail: filename too long\"\n"
1722     "}\n"
1723     "if {[regexp {\\..*\\.} $ftail]} {\n"
1724     "error \"$ftail: more than one dot is forbidden\"\n"
1725     "}\n"
1726     "if {[string compare $ftail \"tclIndex\"] && \\\n"
1727     "\011\011[string compare -nocase [file extension $ftail]\011\".tcl\"]} {\n"
1728     "error \"$ftail: must be a *.tcl or tclIndex\"\n"
1729     "}\n"
1730     "if {![file exists $file]} {\n"
1731     "error \"no such file or directory\"\n"
1732     "}\n"
1733     "if {![file readable $file]} {\n"
1734     "error \"not readable\"\n"
1735     "}\n"
1736     "}\n"
1737     "proc AliasSource {slave args} {\n"
1738     "set argc [llength $args]\n"
1739     "if {$argc != 1} {\n"
1740     "set msg \"wrong # args: should be \\\"source fileName\\\"\"\n"
1741     "Log $slave \"$msg ($args)\"\n"
1742     "return -code error $msg\n"
1743     "}\n"
1744     "set file [lindex $args 0]\n"
1745     "if {[catch {set file [TranslatePath $slave $file]} msg]} {\n"
1746     "Log $slave $msg\n"
1747     "return -code error \"permission denied\"\n"
1748     "}\n"
1749     "if {[catch {FileInAccessPath $slave $file} msg]} {\n"
1750     "Log $slave $msg\n"
1751     "return -code error \"permission denied\"\n"
1752     "}\n"
1753     "if {[catch {CheckFileName $slave $file} msg]} {\n"
1754     "Log $slave \"$file:$msg\"\n"
1755     "return -code error $msg\n"
1756     "}\n"
1757     "if {[catch {::interp invokehidden $slave source $file} msg]} {\n"
1758     "Log $slave $msg\n"
1759     "return -code error \"script error\"\n"
1760     "}\n"
1761     "return $msg\n"
1762     "}\n"
1763     "proc AliasLoad {slave file args} {\n"
1764     "set argc [llength $args]\n"
1765     "if {$argc > 2} {\n"
1766     "set msg \"load error: too many arguments\"\n"
1767     "Log $slave \"$msg ($argc) {$file $args}\"\n"
1768     "return -code error $msg\n"
1769     "}\n"
1770     "set package [lindex $args 0]\n"
1771     "set target [lindex $args 1]\n"
1772     "if {[string length $target]} {\n"
1773     "if {![NestedOk $slave]} {\n"
1774     "Log $slave \"loading to a sub interp (nestedok)\\\n"
1775     "\011\011\011disabled (trying to load $package to $target)\"\n"
1776     "return -code error \"permission denied (nested load)\"\n"
1777     "}\n"
1778     "}\n"
1779     "if {[string length $file] == 0} {\n"
1780     "if {[string length $package] == 0} {\n"
1781     "set msg \"load error: empty filename and no package name\"\n"
1782     "Log $slave $msg\n"
1783     "return -code error $msg\n"
1784     "}\n"
1785     "if {![StaticsOk $slave]} {\n"
1786     "Log $slave \"static packages loading disabled\\\n"
1787     "\011\011\011(trying to load $package to $target)\"\n"
1788     "return -code error \"permission denied (static package)\"\n"
1789     "}\n"
1790     "} else {\n"
1791     "if {[catch {set file [TranslatePath $slave $file]} msg]} {\n"
1792     "Log $slave $msg\n"
1793     "return -code error \"permission denied\"\n"
1794     "}\n"
1795     "if {[catch {FileInAccessPath $slave $file} msg]} {\n"
1796     "Log $slave $msg\n"
1797     "return -code error \"permission denied (path)\"\n"
1798     "}\n"
1799     "}\n"
1800     "if {[catch {::interp invokehidden\\\n"
1801     "\011\011$slave load $file $package $target} msg]} {\n"
1802     "Log $slave $msg\n"
1803     "return -code error $msg\n"
1804     "}\n"
1805     "return $msg\n"
1806     "}\n"
1807     "proc FileInAccessPath {slave file} {\n"
1808     "set access_path [GetAccessPath $slave]\n"
1809     "if {[file isdirectory $file]} {\n"
1810     "error \"\\\"$file\\\": is a directory\"\n"
1811     "}\n"
1812     "set parent [file dirname $file]\n"
1813     "if {[lsearch -exact $access_path $parent] == -1} {\n"
1814     "error \"\\\"$file\\\": not in access_path\"\n"
1815     "}\n"
1816     "}\n"
1817     "proc Subset {slave command okpat args} {\n"
1818     "set subcommand [lindex $args 0]\n"
1819     "if {[regexp $okpat $subcommand]} {\n"
1820     "return [eval {$command $subcommand} [lrange $args 1 end]]\n"
1821     "}\n"
1822     "set msg \"not allowed to invoke subcommand $subcommand of $command\"\n"
1823     "Log $slave $msg\n"
1824     "error $msg\n"
1825     "}\n"
1826     "proc AliasSubset {slave alias target args} {\n"
1827     "set pat ^(; set sep \"\"\n"
1828     "foreach sub $args {\n"
1829     "append pat $sep$sub\n"
1830     "set sep |\n"
1831     "}\n"
1832     "append pat )\\$\n"
1833     "::interp alias $slave $alias {}\\\n"
1834     "\011\011[namespace current]::Subset $slave $target $pat\n"
1835     "}\n"
1836     "proc AliasEncoding {slave args} {\n"
1837     "set argc [llength $args]\n"
1838     "set okpat \"^(name.*|convert.*)\\$\"\n"
1839     "set subcommand [lindex $args 0]\n"
1840     "if {[regexp $okpat $subcommand]} {\n"
1841     "return [eval ::interp invokehidden $slave encoding $subcommand \\\n"
1842     "\011\011 [lrange $args 1 end]]\n"
1843     "}\n"
1844     "if {[string match $subcommand system]} {\n"
1845     "if {$argc == 1} {\n"
1846     "if {[catch {::interp invokehidden \\\n"
1847     "\011\011\011$slave encoding system} msg]} {\n"
1848     "Log $slave $msg\n"
1849     "return -code error \"script error\"\n"
1850     "}\n"
1851     "} else {\n"
1852     "set msg \"wrong # args: should be \\\"encoding system\\\"\"\n"
1853     "Log $slave $msg\n"
1854     "error $msg\n"
1855     "}\n"
1856     "} else {\n"
1857     "set msg \"wrong # args: should be \\\"encoding option ?arg ...?\\\"\"\n"
1858     "Log $slave $msg\n"
1859     "error $msg\n"
1860     "}\n"
1861     "return $msg\n"
1862     "}\n"
1863     "}\n"
1864     ;
1865     static char Et_zFile6[] =
1866     "# Tcl autoload index file, version 2.0\n"
1867     "# This file is generated by the \"auto_mkindex\" command\n"
1868     "# and sourced to set up indexing information for one or\n"
1869     "# more commands. Typically each line is a command that\n"
1870     "# sets an element in the auto_index array, where the\n"
1871     "# element name is the name of a command and the value is\n"
1872     "# a script that loads the command.\n"
1873     "\n"
1874     "set auto_index(auto_reset) [list source [file join $dir auto.tcl]]\n"
1875     "set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]\n"
1876     "set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]\n"
1877     "set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]\n"
1878     "set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]\n"
1879     "set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]\n"
1880     "set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]\n"
1881     "set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]\n"
1882     "set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]\n"
1883     "set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]\n"
1884     "set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]\n"
1885     "set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]\n"
1886     "set auto_index(history) [list source [file join $dir history.tcl]]\n"
1887     "set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]\n"
1888     "set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]\n"
1889     "set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]\n"
1890     "set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]\n"
1891     "set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]\n"
1892     "set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]\n"
1893     "set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]\n"
1894     "set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]\n"
1895     "set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]\n"
1896     "set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]]\n"
1897     "set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]\n"
1898     "set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]\n"
1899     "set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]]\n"
1900     "set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]\n"
1901     "set auto_index(::pkg::create) [list source [file join $dir package.tcl]]\n"
1902     "set auto_index(parray) [list source [file join $dir parray.tcl]]\n"
1903     "set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]\n"
1904     "set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]\n"
1905     "set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]\n"
1906     "set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]\n"
1907     "set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]\n"
1908     "set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]\n"
1909     "set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]\n"
1910     "set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]\n"
1911     "set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]\n"
1912     "set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]\n"
1913     "set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]\n"
1914     "set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]\n"
1915     "set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]\n"
1916     "set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]\n"
1917     "set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]\n"
1918     "set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]\n"
1919     "set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]\n"
1920     "set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]\n"
1921     "set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]\n"
1922     "set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]\n"
1923     "set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]\n"
1924     "set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]\n"
1925     "set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]\n"
1926     "set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]\n"
1927     "set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]\n"
1928     "set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]\n"
1929     "set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]\n"
1930     "set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]\n"
1931     "set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]\n"
1932     "set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]\n"
1933     "set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]\n"
1934     "set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]\n"
1935     "set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]\n"
1936     "set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]\n"
1937     "set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]\n"
1938     "set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]\n"
1939     "set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]\n"
1940     "set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]\n"
1941     "set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]\n"
1942     "set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]\n"
1943     "set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]\n"
1944     "set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]\n"
1945     "set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]\n"
1946     "set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]\n"
1947     "set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]\n"
1948     ;
1949     static char Et_zFile7[] =
1950     "if {[string equal $tcl_platform(platform) \"windows\"]} {\n"
1951     "set tcl_wordchars \"\\\\S\"\n"
1952     "set tcl_nonwordchars \"\\\\s\"\n"
1953     "} else {\n"
1954     "set tcl_wordchars \"\\\\w\"\n"
1955     "set tcl_nonwordchars \"\\\\W\"\n"
1956     "}\n"
1957     "proc tcl_wordBreakAfter {str start} {\n"
1958     "global tcl_nonwordchars tcl_wordchars\n"
1959     "set str [string range $str $start end]\n"
1960     "if {[regexp -indices \"$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars\" $str result]} {\n"
1961     "return [expr {[lindex $result 1] + $start}]\n"
1962     "}\n"
1963     "return -1\n"
1964     "}\n"
1965     "proc tcl_wordBreakBefore {str start} {\n"
1966     "global tcl_nonwordchars tcl_wordchars\n"
1967     "if {[string equal $start end]} {\n"
1968     "set start [string length $str]\n"
1969     "}\n"
1970     "if {[regexp -indices \"^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)\" [string range $str 0 $start] result]} {\n"
1971     "return [lindex $result 1]\n"
1972     "}\n"
1973     "return -1\n"
1974     "}\n"
1975     "proc tcl_endOfWord {str start} {\n"
1976     "global tcl_nonwordchars tcl_wordchars\n"
1977     "if {[regexp -indices \"$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars\" \\\n"
1978     "\011 [string range $str $start end] result]} {\n"
1979     "return [expr {[lindex $result 1] + $start}]\n"
1980     "}\n"
1981     "return -1\n"
1982     "}\n"
1983     "proc tcl_startOfNextWord {str start} {\n"
1984     "global tcl_nonwordchars tcl_wordchars\n"
1985     "if {[regexp -indices \"$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars\" \\\n"
1986     "\011 [string range $str $start end] result]} {\n"
1987     "return [expr {[lindex $result 1] + $start}]\n"
1988     "}\n"
1989     "return -1\n"
1990     "}\n"
1991     "proc tcl_startOfPreviousWord {str start} {\n"
1992     "global tcl_nonwordchars tcl_wordchars\n"
1993     "if {[string equal $start end]} {\n"
1994     "set start [string length $str]\n"
1995     "}\n"
1996     "if {[regexp -indices \\\n"
1997     "\011 \"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\\$\" \\\n"
1998     "\011 [string range $str 0 [expr {$start - 1}]] result word]} {\n"
1999     "return [lindex $word 0]\n"
2000     "}\n"
2001     "return -1\n"
2002     "}\n"
2003     ;
2004     static char Et_zFile8[] =
2005     "proc bgerror err {\n"
2006     "global errorInfo tcl_platform\n"
2007     "set info $errorInfo ;\n"
2008     "set ret [catch {tkerror $err} msg];\n"
2009     "if {$ret != 1} {return -code $ret $msg}\n"
2010     "if {$tcl_platform(platform) == \"macintosh\"} {\n"
2011     "set ok Ok\n"
2012     "} else {\n"
2013     "set ok OK\n"
2014     "}\n"
2015     "set button [tk_dialog .bgerrorDialog \"Error in Tcl Script\" \\\n"
2016     "\011 \"Error: $err\" error 0 $ok \"Skip Messages\" \"Stack Trace\"]\n"
2017     "if {$button == 0} {\n"
2018     "return\n"
2019     "} elseif {$button == 1} {\n"
2020     "return -code break\n"
2021     "}\n"
2022     "set w .bgerrorTrace\n"
2023     "catch {destroy $w}\n"
2024     "toplevel $w -class ErrorTrace\n"
2025     "wm minsize $w 1 1\n"
2026     "wm title $w \"Stack Trace for Error\"\n"
2027     "wm iconname $w \"Stack Trace\"\n"
2028     "button $w.ok -text OK -command \"destroy $w\" -default active\n"
2029     "if {![string compare $tcl_platform(platform) \"macintosh\"]} {\n"
2030     "text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \\\n"
2031     "\011 -yscrollcommand \"$w.scroll set\" -width 60 -height 20\n"
2032     "} else {\n"
2033     "text $w.text -relief sunken -bd 2 -yscrollcommand \"$w.scroll set\" \\\n"
2034     "\011 -setgrid true -width 60 -height 20\n"
2035     "}\n"
2036     "scrollbar $w.scroll -relief sunken -command \"$w.text yview\"\n"
2037     "pack $w.ok -side bottom -padx 3m -pady 2m\n"
2038     "pack $w.scroll -side right -fill y\n"
2039     "pack $w.text -side left -expand yes -fill both\n"
2040     "$w.text insert 0.0 $info\n"
2041     "$w.text mark set insert 0.0\n"
2042     "bind $w <Return> \"destroy $w\"\n"
2043     "bind $w.text <Return> \"destroy $w; break\"\n"
2044     "wm withdraw $w\n"
2045     "update idletasks\n"
2046     "set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
2047     "\011 - [winfo vrootx [winfo parent $w]]}]\n"
2048     "set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
2049     "\011 - [winfo vrooty [winfo parent $w]]}]\n"
2050     "wm geom $w +$x+$y\n"
2051     "wm deiconify $w\n"
2052     "if {[string compare [grab current .] \"\"]} {\n"
2053     "grab release [grab current .]\n"
2054     "}\n"
2055     "}\n"
2056     ;
2057     static char Et_zFile9[] =
2058     "if {[string match \"macintosh\" $tcl_platform(platform)]} {\n"
2059     "bind Radiobutton <Enter> {\n"
2060     "tkButtonEnter %W\n"
2061     "}\n"
2062     "bind Radiobutton <1> {\n"
2063     "tkButtonDown %W\n"
2064     "}\n"
2065     "bind Radiobutton <ButtonRelease-1> {\n"
2066     "tkButtonUp %W\n"
2067     "}\n"
2068     "bind Checkbutton <Enter> {\n"
2069     "tkButtonEnter %W\n"
2070     "}\n"
2071     "bind Checkbutton <1> {\n"
2072     "tkButtonDown %W\n"
2073     "}\n"
2074     "bind Checkbutton <ButtonRelease-1> {\n"
2075     "tkButtonUp %W\n"
2076     "}\n"
2077     "}\n"
2078     "if {[string match \"windows\" $tcl_platform(platform)]} {\n"
2079     "bind Checkbutton <equal> {\n"
2080     "tkCheckRadioInvoke %W select\n"
2081     "}\n"
2082     "bind Checkbutton <plus> {\n"
2083     "tkCheckRadioInvoke %W select\n"
2084     "}\n"
2085     "bind Checkbutton <minus> {\n"
2086     "tkCheckRadioInvoke %W deselect\n"
2087     "}\n"
2088     "bind Checkbutton <1> {\n"
2089     "tkCheckRadioDown %W\n"
2090     "}\n"
2091     "bind Checkbutton <ButtonRelease-1> {\n"
2092     "tkButtonUp %W\n"
2093     "}\n"
2094     "bind Checkbutton <Enter> {\n"
2095     "tkCheckRadioEnter %W\n"
2096     "}\n"
2097     "bind Radiobutton <1> {\n"
2098     "tkCheckRadioDown %W\n"
2099     "}\n"
2100     "bind Radiobutton <ButtonRelease-1> {\n"
2101     "tkButtonUp %W\n"
2102     "}\n"
2103     "bind Radiobutton <Enter> {\n"
2104     "tkCheckRadioEnter %W\n"
2105     "}\n"
2106     "}\n"
2107     "if {[string match \"unix\" $tcl_platform(platform)]} {\n"
2108     "bind Checkbutton <Return> {\n"
2109     "if {!$tk_strictMotif} {\n"
2110     "tkCheckRadioInvoke %W\n"
2111     "}\n"
2112     "}\n"
2113     "bind Radiobutton <Return> {\n"
2114     "if {!$tk_strictMotif} {\n"
2115     "tkCheckRadioInvoke %W\n"
2116     "}\n"
2117     "}\n"
2118     "bind Checkbutton <1> {\n"
2119     "tkCheckRadioInvoke %W\n"
2120     "}\n"
2121     "bind Radiobutton <1> {\n"
2122     "tkCheckRadioInvoke %W\n"
2123     "}\n"
2124     "bind Checkbutton <Enter> {\n"
2125     "tkButtonEnter %W\n"
2126     "}\n"
2127     "bind Radiobutton <Enter> {\n"
2128     "tkButtonEnter %W\n"
2129     "}\n"
2130     "}\n"
2131     "bind Button <space> {\n"
2132     "tkButtonInvoke %W\n"
2133     "}\n"
2134     "bind Checkbutton <space> {\n"
2135     "tkCheckRadioInvoke %W\n"
2136     "}\n"
2137     "bind Radiobutton <space> {\n"
2138     "tkCheckRadioInvoke %W\n"
2139     "}\n"
2140     "bind Button <FocusIn> {}\n"
2141     "bind Button <Enter> {\n"
2142     "tkButtonEnter %W\n"
2143     "}\n"
2144     "bind Button <Leave> {\n"
2145     "tkButtonLeave %W\n"
2146     "}\n"
2147     "bind Button <1> {\n"
2148     "tkButtonDown %W\n"
2149     "}\n"
2150     "bind Button <ButtonRelease-1> {\n"
2151     "tkButtonUp %W\n"
2152     "}\n"
2153     "bind Checkbutton <FocusIn> {}\n"
2154     "bind Checkbutton <Leave> {\n"
2155     "tkButtonLeave %W\n"
2156     "}\n"
2157     "bind Radiobutton <FocusIn> {}\n"
2158     "bind Radiobutton <Leave> {\n"
2159     "tkButtonLeave %W\n"
2160     "}\n"
2161     "if {[string match \"windows\" $tcl_platform(platform)]} {\n"
2162     "proc tkButtonEnter w {\n"
2163     "global tkPriv\n"
2164     "if {[string compare [$w cget -state] \"disabled\"] \\\n"
2165     "\011 && [string equal $tkPriv(buttonWindow) $w]} {\n"
2166     "$w configure -state active -relief sunken\n"
2167     "}\n"
2168     "set tkPriv(window) $w\n"
2169     "}\n"
2170     "proc tkButtonLeave w {\n"
2171     "global tkPriv\n"
2172     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2173     "$w configure -state normal\n"
2174     "}\n"
2175     "if {[string equal $tkPriv(buttonWindow) $w]} {\n"
2176     "$w configure -relief $tkPriv(relief)\n"
2177     "}\n"
2178     "set tkPriv(window) \"\"\n"
2179     "}\n"
2180     "proc tkCheckRadioEnter w {\n"
2181     "global tkPriv\n"
2182     "if {[string compare [$w cget -state] \"disabled\"] \\\n"
2183     "\011 && [string equal $tkPriv(buttonWindow) $w]} {\n"
2184     "$w configure -state active\n"
2185     "}\n"
2186     "set tkPriv(window) $w\n"
2187     "}\n"
2188     "proc tkButtonDown w {\n"
2189     "global tkPriv\n"
2190     "set tkPriv(relief) [$w cget -relief]\n"
2191     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2192     "set tkPriv(buttonWindow) $w\n"
2193     "$w configure -relief sunken -state active\n"
2194     "}\n"
2195     "}\n"
2196     "proc tkCheckRadioDown w {\n"
2197     "global tkPriv\n"
2198     "set tkPriv(relief) [$w cget -relief]\n"
2199     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2200     "set tkPriv(buttonWindow) $w\n"
2201     "$w configure -state active\n"
2202     "}\n"
2203     "}\n"
2204     "proc tkButtonUp w {\n"
2205     "global tkPriv\n"
2206     "if {[string equal $tkPriv(buttonWindow) $w]} {\n"
2207     "set tkPriv(buttonWindow) \"\"\n"
2208     "$w configure -relief $tkPriv(relief)\n"
2209     "if {[string equal $tkPriv(window) $w]\n"
2210     "&& [string compare [$w cget -state] \"disabled\"]} {\n"
2211     "$w configure -state normal\n"
2212     "uplevel #0 [list $w invoke]\n"
2213     "}\n"
2214     "}\n"
2215     "}\n"
2216     "}\n"
2217     "if {[string match \"unix\" $tcl_platform(platform)]} {\n"
2218     "proc tkButtonEnter {w} {\n"
2219     "global tkPriv\n"
2220     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2221     "$w configure -state active\n"
2222     "if {[string equal $tkPriv(buttonWindow) $w]} {\n"
2223     "$w configure -state active -relief sunken\n"
2224     "}\n"
2225     "}\n"
2226     "set tkPriv(window) $w\n"
2227     "}\n"
2228     "proc tkButtonLeave w {\n"
2229     "global tkPriv\n"
2230     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2231     "$w configure -state normal\n"
2232     "}\n"
2233     "if {[string equal $tkPriv(buttonWindow) $w]} {\n"
2234     "$w configure -relief $tkPriv(relief)\n"
2235     "}\n"
2236     "set tkPriv(window) \"\"\n"
2237     "}\n"
2238     "proc tkButtonDown w {\n"
2239     "global tkPriv\n"
2240     "set tkPriv(relief) [$w cget -relief]\n"
2241     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2242     "set tkPriv(buttonWindow) $w\n"
2243     "$w configure -relief sunken\n"
2244     "}\n"
2245     "}\n"
2246     "proc tkButtonUp w {\n"
2247     "global tkPriv\n"
2248     "if {[string equal $w $tkPriv(buttonWindow)]} {\n"
2249     "set tkPriv(buttonWindow) \"\"\n"
2250     "$w configure -relief $tkPriv(relief)\n"
2251     "if {[string equal $w $tkPriv(window)] \\\n"
2252     "\011\011&& [string compare [$w cget -state] \"disabled\"]} {\n"
2253     "uplevel #0 [list $w invoke]\n"
2254     "}\n"
2255     "}\n"
2256     "}\n"
2257     "}\n"
2258     "if {[string match \"macintosh\" $tcl_platform(platform)]} {\n"
2259     "proc tkButtonEnter {w} {\n"
2260     "global tkPriv\n"
2261     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2262     "if {[string equal $w $tkPriv(buttonWindow)]} {\n"
2263     "$w configure -state active\n"
2264     "}\n"
2265     "}\n"
2266     "set tkPriv(window) $w\n"
2267     "}\n"
2268     "proc tkButtonLeave w {\n"
2269     "global tkPriv\n"
2270     "if {[string equal $w $tkPriv(buttonWindow)]} {\n"
2271     "$w configure -state normal\n"
2272     "}\n"
2273     "set tkPriv(window) \"\"\n"
2274     "}\n"
2275     "proc tkButtonDown w {\n"
2276     "global tkPriv\n"
2277     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2278     "set tkPriv(buttonWindow) $w\n"
2279     "$w configure -state active\n"
2280     "}\n"
2281     "}\n"
2282     "proc tkButtonUp w {\n"
2283     "global tkPriv\n"
2284     "if {[string equal $w $tkPriv(buttonWindow)]} {\n"
2285     "$w configure -state normal\n"
2286     "set tkPriv(buttonWindow) \"\"\n"
2287     "if {[string equal $w $tkPriv(window)]\n"
2288     "&& [string compare [$w cget -state] \"disabled\"]} {\n"
2289     "uplevel #0 [list $w invoke]\n"
2290     "}\n"
2291     "}\n"
2292     "}\n"
2293     "}\n"
2294     "proc tkButtonInvoke w {\n"
2295     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2296     "set oldRelief [$w cget -relief]\n"
2297     "set oldState [$w cget -state]\n"
2298     "$w configure -state active -relief sunken\n"
2299     "update idletasks\n"
2300     "after 100\n"
2301     "$w configure -state $oldState -relief $oldRelief\n"
2302     "uplevel #0 [list $w invoke]\n"
2303     "}\n"
2304     "}\n"
2305     "proc tkCheckRadioInvoke {w {cmd invoke}} {\n"
2306     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
2307     "uplevel #0 [list $w $cmd]\n"
2308     "}\n"
2309     "}\n"
2310     ;
2311     static char Et_zFile10[] =
2312     "proc tkColorDialog {args} {\n"
2313     "global tkPriv\n"
2314     "set w .__tk__color\n"
2315     "upvar #0 $w data\n"
2316     "set data(lines,red,start) 0\n"
2317     "set data(lines,red,last) -1\n"
2318     "set data(lines,green,start) 0\n"
2319     "set data(lines,green,last) -1\n"
2320     "set data(lines,blue,start) 0\n"
2321     "set data(lines,blue,last) -1\n"
2322     "set data(NUM_COLORBARS) 8\n"
2323     "set data(BARS_WIDTH) 128\n"
2324     "set data(PLGN_HEIGHT) 10\n"
2325     "set data(PLGN_WIDTH) 10\n"
2326     "tkColorDialog_Config $w $args\n"
2327     "tkColorDialog_InitValues $w\n"
2328     "set sc [winfo screen $data(-parent)]\n"
2329     "set winExists [winfo exists $w]\n"
2330     "if {!$winExists || [string compare $sc [winfo screen $w]]} {\n"
2331     "if {$winExists} {\n"
2332     "destroy $w\n"
2333     "}\n"
2334     "toplevel $w -class tkColorDialog -screen $sc\n"
2335     "tkColorDialog_BuildDialog $w\n"
2336     "}\n"
2337     "wm transient $w $data(-parent)\n"
2338     "::tk::PlaceWindow $w widget $data(-parent)\n"
2339     "wm title $w $data(-title)\n"
2340     "::tk::SetFocusGrab $w $data(okBtn)\n"
2341     "vwait tkPriv(selectColor)\n"
2342     "::tk::RestoreFocusGrab $w $data(okBtn)\n"
2343     "unset data\n"
2344     "return $tkPriv(selectColor)\n"
2345     "}\n"
2346     "proc tkColorDialog_InitValues {w} {\n"
2347     "upvar #0 $w data\n"
2348     "set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]\n"
2349     "set data(colorbarWidth) \\\n"
2350     "\011 [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]\n"
2351     "set data(indent) [expr {$data(PLGN_WIDTH) / 2}]\n"
2352     "set data(colorPad) 2\n"
2353     "set data(selPad) [expr {$data(PLGN_WIDTH) / 2}]\n"
2354     "set data(minX) $data(indent)\n"
2355     "set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]\n"
2356     "set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]\n"
2357     "set data(selection) $data(-initialcolor)\n"
2358     "set data(finalColor) $data(-initialcolor)\n"
2359     "set rgb [winfo rgb . $data(selection)]\n"
2360     "set data(red,intensity) [expr {[lindex $rgb 0]/0x100}]\n"
2361     "set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]\n"
2362     "set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}]\n"
2363     "}\n"
2364     "proc tkColorDialog_Config {w argList} {\n"
2365     "global tkPriv\n"
2366     "upvar #0 $w data\n"
2367     "if {[info exists tkPriv(selectColor)] && \\\n"
2368     "\011 [string compare $tkPriv(selectColor) \"\"]} {\n"
2369     "set defaultColor $tkPriv(selectColor)\n"
2370     "} else {\n"
2371     "set defaultColor [. cget -background]\n"
2372     "}\n"
2373     "set specs [list \\\n"
2374     "\011 [list -initialcolor \"\" \"\" $defaultColor] \\\n"
2375     "\011 [list -parent \"\" \"\" \".\"] \\\n"
2376     "\011 [list -title \"\" \"\" \"Color\"] \\\n"
2377     "\011 ]\n"
2378     "tclParseConfigSpec $w $specs \"\" $argList\n"
2379     "if {[string equal $data(-title) \"\"]} {\n"
2380     "set data(-title) \" \"\n"
2381     "}\n"
2382     "if {[catch {winfo rgb . $data(-initialcolor)} err]} {\n"
2383     "error $err\n"
2384     "}\n"
2385     "if {![winfo exists $data(-parent)]} {\n"
2386     "error \"bad window path name \\\"$data(-parent)\\\"\"\n"
2387     "}\n"
2388     "}\n"
2389     "proc tkColorDialog_BuildDialog {w} {\n"
2390     "upvar #0 $w data\n"
2391     "set topFrame [frame $w.top -relief raised -bd 1]\n"
2392     "set stripsFrame [frame $topFrame.colorStrip]\n"
2393     "foreach c { Red Green Blue } {\n"
2394     "set color [string tolower $c]\n"
2395     "set f [frame $stripsFrame.$color]\n"
2396     "set box [frame $f.box]\n"
2397     "label $box.label -text $c: -width 6 -under 0 -anchor ne\n"
2398     "entry $box.entry -textvariable [format %s $w]($color,intensity) \\\n"
2399     "\011 -width 4\n"
2400     "pack $box.label -side left -fill y -padx 2 -pady 3\n"
2401     "pack $box.entry -side left -anchor n -pady 0\n"
2402     "pack $box -side left -fill both\n"
2403     "set height [expr \\\n"
2404     "\011 {[winfo reqheight $box.entry] - \\\n"
2405     "\011 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]\n"
2406     "canvas $f.color -height $height\\\n"
2407     "\011 -width $data(BARS_WIDTH) -relief sunken -bd 2\n"
2408     "canvas $f.sel -height $data(PLGN_HEIGHT) \\\n"
2409     "\011 -width $data(canvasWidth) -highlightthickness 0\n"
2410     "pack $f.color -expand yes -fill both\n"
2411     "pack $f.sel -expand yes -fill both\n"
2412     "pack $f -side top -fill x -padx 0 -pady 2\n"
2413     "set data($color,entry) $box.entry\n"
2414     "set data($color,col) $f.color\n"
2415     "set data($color,sel) $f.sel\n"
2416     "bind $data($color,col) <Configure> \\\n"
2417     "\011 [list tkColorDialog_DrawColorScale $w $color 1]\n"
2418     "bind $data($color,col) <Enter> \\\n"
2419     "\011 [list tkColorDialog_EnterColorBar $w $color]\n"
2420     "bind $data($color,col) <Leave> \\\n"
2421     "\011 [list tkColorDialog_LeaveColorBar $w $color]\n"
2422     "bind $data($color,sel) <Enter> \\\n"
2423     "\011 [list tkColorDialog_EnterColorBar $w $color]\n"
2424     "bind $data($color,sel) <Leave> \\\n"
2425     "\011 [list tkColorDialog_LeaveColorBar $w $color]\n"
2426     "bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w]\n"
2427     "}\n"
2428     "pack $stripsFrame -side left -fill both -padx 4 -pady 10\n"
2429     "set selFrame [frame $topFrame.sel]\n"
2430     "set lab [label $selFrame.lab -text \"Selection:\" -under 0 -anchor sw]\n"
2431     "set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \\\n"
2432     "\011-width 16]\n"
2433     "set f1 [frame $selFrame.f1 -relief sunken -bd 2]\n"
2434     "set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]\n"
2435     "pack $lab $ent -side top -fill x -padx 4 -pady 2\n"
2436     "pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10\n"
2437     "pack $data(finalCanvas) -expand yes -fill both\n"
2438     "bind $ent <Return> [list tkColorDialog_HandleSelEntry $w]\n"
2439     "pack $selFrame -side left -fill none -anchor nw\n"
2440     "pack $topFrame -side top -expand yes -fill both -anchor nw\n"
2441     "set botFrame [frame $w.bot -relief raised -bd 1]\n"
2442     "button $botFrame.ok -text OK -width 8 -under 0 \\\n"
2443     "\011-command [list tkColorDialog_OkCmd $w]\n"
2444     "button $botFrame.cancel -text Cancel -width 8 -under 0 \\\n"
2445     "\011-command [list tkColorDialog_CancelCmd $w]\n"
2446     "set data(okBtn) $botFrame.ok\n"
2447     "set data(cancelBtn) $botFrame.cancel\n"
2448     "pack $botFrame.ok $botFrame.cancel \\\n"
2449     "\011-padx 10 -pady 10 -expand yes -side left\n"
2450     "pack $botFrame -side bottom -fill x\n"
2451     "bind $w <Alt-r> [list focus $data(red,entry)]\n"
2452     "bind $w <Alt-g> [list focus $data(green,entry)]\n"
2453     "bind $w <Alt-b> [list focus $data(blue,entry)]\n"
2454     "bind $w <Alt-s> [list focus $ent]\n"
2455     "bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]\n"
2456     "bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]\n"
2457     "bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]\n"
2458     "wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w]\n"
2459     "}\n"
2460     "proc tkColorDialog_SetRGBValue {w color} {\n"
2461     "upvar #0 $w data \n"
2462     "set data(red,intensity) [lindex $color 0]\n"
2463     "set data(green,intensity) [lindex $color 1]\n"
2464     "set data(blue,intensity) [lindex $color 2]\n"
2465     "tkColorDialog_RedrawColorBars $w all\n"
2466     "foreach color { red green blue } {\n"
2467     "set x [tkColorDialog_RgbToX $w $data($color,intensity)]\n"
2468     "tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0\n"
2469     "}\n"
2470     "}\n"
2471     "proc tkColorDialog_XToRgb {w x} {\n"
2472     "upvar #0 $w data\n"
2473     "return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]\n"
2474     "}\n"
2475     "proc tkColorDialog_RgbToX {w color} {\n"
2476     "upvar #0 $w data\n"
2477     "return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]\n"
2478     "}\n"
2479     "proc tkColorDialog_DrawColorScale {w c {create 0}} {\n"
2480     "global lines\n"
2481     "upvar #0 $w data\n"
2482     "set col $data($c,col)\n"
2483     "set sel $data($c,sel)\n"
2484     "if {$create} {\n"
2485     "if { $data(lines,$c,last) > $data(lines,$c,start)} {\n"
2486     "for {set i $data(lines,$c,start)} \\\n"
2487     "\011\011{$i <= $data(lines,$c,last)} { incr i} {\n"
2488     "$sel delete $i\n"
2489     "}\n"
2490     "}\n"
2491     "if {[info exists data($c,index)]} {\n"
2492     "$sel delete $data($c,index)\n"
2493     "}\n"
2494     "tkColorDialog_CreateSelector $w $sel $c\n"
2495     "$sel bind $data($c,index) <ButtonPress-1> \\\n"
2496     "\011\011[list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1]\n"
2497     "$sel bind $data($c,index) <B1-Motion> \\\n"
2498     "\011\011[list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]\n"
2499     "$sel bind $data($c,index) <ButtonRelease-1> \\\n"
2500     "\011\011[list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]\n"
2501     "set height [winfo height $col]\n"
2502     "set data($c,clickRegion) [$sel create rectangle 0 0 \\\n"
2503     "\011\011$data(canvasWidth) $height -fill {} -outline {}]\n"
2504     "bind $col <ButtonPress-1> \\\n"
2505     "\011\011[list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)]\n"
2506     "bind $col <B1-Motion> \\\n"
2507     "\011\011[list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)]\n"
2508     "bind $col <ButtonRelease-1> \\\n"
2509     "\011\011[list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)]\n"
2510     "$sel bind $data($c,clickRegion) <ButtonPress-1> \\\n"
2511     "\011\011[list tkColorDialog_StartMove $w $sel $c %x $data(selPad)]\n"
2512     "$sel bind $data($c,clickRegion) <B1-Motion> \\\n"
2513     "\011\011[list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]\n"
2514     "$sel bind $data($c,clickRegion) <ButtonRelease-1> \\\n"
2515     "\011\011[list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]\n"
2516     "} else {\n"
2517     "set l $data(lines,$c,start)\n"
2518     "}\n"
2519     "set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]\n"
2520     "for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {\n"
2521     "set intensity [expr {$i * $data(intensityIncr)}]\n"
2522     "set startx [expr {$i * $data(colorbarWidth) + $highlightW}]\n"
2523     "if {[string equal $c \"red\"]} {\n"
2524     "set color [format \"#%02x%02x%02x\" \\\n"
2525     "\011\011\011 $intensity \\\n"
2526     "\011\011\011 $data(green,intensity) \\\n"
2527     "\011\011\011 $data(blue,intensity)]\n"
2528     "} elseif {[string equal $c \"green\"]} {\n"
2529     "set color [format \"#%02x%02x%02x\" \\\n"
2530     "\011\011\011 $data(red,intensity) \\\n"
2531     "\011\011\011 $intensity \\\n"
2532     "\011\011\011 $data(blue,intensity)]\n"
2533     "} else {\n"
2534     "set color [format \"#%02x%02x%02x\" \\\n"
2535     "\011\011\011 $data(red,intensity) \\\n"
2536     "\011\011\011 $data(green,intensity) \\\n"
2537     "\011\011\011 $intensity]\n"
2538     "}\n"
2539     "if {$create} {\n"
2540     "set index [$col create rect $startx $highlightW \\\n"
2541     "\011\011 [expr {$startx +$data(colorbarWidth)}] \\\n"
2542     "\011\011 [expr {[winfo height $col] + $highlightW}]\\\n"
2543     "\011 -fill $color -outline $color]\n"
2544     "} else {\n"
2545     "$col itemconfigure $l -fill $color -outline $color\n"
2546     "incr l\n"
2547     "}\n"
2548     "}\n"
2549     "$sel raise $data($c,index)\n"
2550     "if {$create} {\n"
2551     "set data(lines,$c,last) $index\n"
2552     "set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]\n"
2553     "}\n"
2554     "tkColorDialog_RedrawFinalColor $w\n"
2555     "}\n"
2556     "proc tkColorDialog_CreateSelector {w sel c } {\n"
2557     "upvar #0 $w data\n"
2558     "set data($c,index) [$sel create polygon \\\n"
2559     "\0110 $data(PLGN_HEIGHT) \\\n"
2560     "\011$data(PLGN_WIDTH) $data(PLGN_HEIGHT) \\\n"
2561     "\011$data(indent) 0]\n"
2562     "set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]\n"
2563     "$sel move $data($c,index) $data($c,x) 0\n"
2564     "}\n"
2565     "proc tkColorDialog_RedrawFinalColor {w} {\n"
2566     "upvar #0 $w data\n"
2567     "set color [format \"#%02x%02x%02x\" $data(red,intensity) \\\n"
2568     "\011$data(green,intensity) $data(blue,intensity)]\n"
2569     "$data(finalCanvas) configure -bg $color\n"
2570     "set data(finalColor) $color\n"
2571     "set data(selection) $color\n"
2572     "set data(finalRGB) [list \\\n"
2573     "\011 $data(red,intensity) \\\n"
2574     "\011 $data(green,intensity) \\\n"
2575     "\011 $data(blue,intensity)]\n"
2576     "}\n"
2577     "proc tkColorDialog_RedrawColorBars {w colorChanged} {\n"
2578     "upvar #0 $w data\n"
2579     "switch $colorChanged {\n"
2580     "red { \n"
2581     "tkColorDialog_DrawColorScale $w green\n"
2582     "tkColorDialog_DrawColorScale $w blue\n"
2583     "}\n"
2584     "green {\n"
2585     "tkColorDialog_DrawColorScale $w red\n"
2586     "tkColorDialog_DrawColorScale $w blue\n"
2587     "}\n"
2588     "blue {\n"
2589     "tkColorDialog_DrawColorScale $w red\n"
2590     "tkColorDialog_DrawColorScale $w green\n"
2591     "}\n"
2592     "default {\n"
2593     "tkColorDialog_DrawColorScale $w red\n"
2594     "tkColorDialog_DrawColorScale $w green\n"
2595     "tkColorDialog_DrawColorScale $w blue\n"
2596     "}\n"
2597     "}\n"
2598     "tkColorDialog_RedrawFinalColor $w\n"
2599     "}\n"
2600     "proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {\n"
2601     "upvar #0 $w data\n"
2602     "if {!$dontMove} {\n"
2603     "tkColorDialog_MoveSelector $w $sel $color $x $delta\n"
2604     "}\n"
2605     "}\n"
2606     "proc tkColorDialog_MoveSelector {w sel color x delta} {\n"
2607     "upvar #0 $w data\n"
2608     "incr x -$delta\n"
2609     "if { $x < 0 } {\n"
2610     "set x 0\n"
2611     "} elseif { $x >= $data(BARS_WIDTH)} {\n"
2612     "set x [expr {$data(BARS_WIDTH) - 1}]\n"
2613     "}\n"
2614     "set diff [expr {$x - $data($color,x)}]\n"
2615     "$sel move $data($color,index) $diff 0\n"
2616     "set data($color,x) [expr {$data($color,x) + $diff}]\n"
2617     "return $x\n"
2618     "}\n"
2619     "proc tkColorDialog_ReleaseMouse {w sel color x delta} {\n"
2620     "upvar #0 $w data \n"
2621     "set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]\n"
2622     "set data($color,intensity) [tkColorDialog_XToRgb $w $x]\n"
2623     "tkColorDialog_RedrawColorBars $w $color\n"
2624     "}\n"
2625     "proc tkColorDialog_ResizeColorBars {w} {\n"
2626     "upvar #0 $w data\n"
2627     "if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || \n"
2628     "(($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {\n"
2629     "set data(BARS_WIDTH) $data(NUM_COLORBARS)\n"
2630     "}\n"
2631     "tkColorDialog_InitValues $w\n"
2632     "foreach color { red green blue } {\n"
2633     "$data($color,col) configure -width $data(canvasWidth)\n"
2634     "tkColorDialog_DrawColorScale $w $color 1\n"
2635     "}\n"
2636     "}\n"
2637     "proc tkColorDialog_HandleSelEntry {w} {\n"
2638     "upvar #0 $w data\n"
2639     "set text [string trim $data(selection)]\n"
2640     "if {[catch {set color [winfo rgb . $text]} ]} {\n"
2641     "set data(selection) $data(finalColor)\n"
2642     "return\n"
2643     "}\n"
2644     "set R [expr {[lindex $color 0]/0x100}]\n"
2645     "set G [expr {[lindex $color 1]/0x100}]\n"
2646     "set B [expr {[lindex $color 2]/0x100}]\n"
2647     "tkColorDialog_SetRGBValue $w \"$R $G $B\"\n"
2648     "set data(selection) $text\n"
2649     "}\n"
2650     "proc tkColorDialog_HandleRGBEntry {w} {\n"
2651     "upvar #0 $w data\n"
2652     "foreach c {red green blue} {\n"
2653     "if {[catch {\n"
2654     "set data($c,intensity) [expr {int($data($c,intensity))}]\n"
2655     "}]} {\n"
2656     "set data($c,intensity) 0\n"
2657     "}\n"
2658     "if {$data($c,intensity) < 0} {\n"
2659     "set data($c,intensity) 0\n"
2660     "}\n"
2661     "if {$data($c,intensity) > 255} {\n"
2662     "set data($c,intensity) 255\n"
2663     "}\n"
2664     "}\n"
2665     "tkColorDialog_SetRGBValue $w \"$data(red,intensity) $data(green,intensity) \\\n"
2666     "\011$data(blue,intensity)\"\n"
2667     "} \n"
2668     "proc tkColorDialog_EnterColorBar {w color} {\n"
2669     "upvar #0 $w data\n"
2670     "$data($color,sel) itemconfig $data($color,index) -fill red\n"
2671     "}\n"
2672     "proc tkColorDialog_LeaveColorBar {w color} {\n"
2673     "upvar #0 $w data\n"
2674     "$data($color,sel) itemconfig $data($color,index) -fill black\n"
2675     "}\n"
2676     "proc tkColorDialog_OkCmd {w} {\n"
2677     "global tkPriv\n"
2678     "upvar #0 $w data\n"
2679     "set tkPriv(selectColor) $data(finalColor)\n"
2680     "}\n"
2681     "proc tkColorDialog_CancelCmd {w} {\n"
2682     "global tkPriv\n"
2683     "set tkPriv(selectColor) \"\"\n"
2684     "}\n"
2685     ;
2686     static char Et_zFile11[] =
2687     "proc tclParseConfigSpec {w specs flags argList} {\n"
2688     "upvar #0 $w data\n"
2689     "foreach spec $specs {\n"
2690     "if {[llength $spec] < 4} {\n"
2691     "error \"\\\"spec\\\" should contain 5 or 4 elements\"\n"
2692     "}\n"
2693     "set cmdsw [lindex $spec 0]\n"
2694     "set cmd($cmdsw) \"\"\n"
2695     "set rname($cmdsw) [lindex $spec 1]\n"
2696     "set rclass($cmdsw) [lindex $spec 2]\n"
2697     "set def($cmdsw) [lindex $spec 3]\n"
2698     "set verproc($cmdsw) [lindex $spec 4]\n"
2699     "}\n"
2700     "if {[llength $argList] & 1} {\n"
2701     "set cmdsw [lindex $argList end]\n"
2702     "if {![info exists cmd($cmdsw)]} {\n"
2703     "error \"bad option \\\"$cmdsw\\\": must be [tclListValidFlags cmd]\"\n"
2704     "}\n"
2705     "error \"value for \\\"$cmdsw\\\" missing\"\n"
2706     "}\n"
2707     "foreach cmdsw [array names cmd] {\n"
2708     "set data($cmdsw) $def($cmdsw)\n"
2709     "}\n"
2710     "foreach {cmdsw value} $argList {\n"
2711     "if {![info exists cmd($cmdsw)]} {\n"
2712     "error \"bad option \\\"$cmdsw\\\": must be [tclListValidFlags cmd]\"\n"
2713     "}\n"
2714     "set data($cmdsw) $value\n"
2715     "}\n"
2716     "}\n"
2717     "proc tclListValidFlags {v} {\n"
2718     "upvar $v cmd\n"
2719     "set len [llength [array names cmd]]\n"
2720     "set i 1\n"
2721     "set separator \"\"\n"
2722     "set errormsg \"\"\n"
2723     "foreach cmdsw [lsort [array names cmd]] {\n"
2724     "append errormsg \"$separator$cmdsw\"\n"
2725     "incr i\n"
2726     "if {$i == $len} {\n"
2727     "set separator \", or \"\n"
2728     "} else {\n"
2729     "set separator \", \"\n"
2730     "}\n"
2731     "}\n"
2732     "return $errormsg\n"
2733     "}\n"
2734     "proc tkFocusGroup_Create {t} {\n"
2735     "global tkPriv\n"
2736     "if {[string compare [winfo toplevel $t] $t]} {\n"
2737     "error \"$t is not a toplevel window\"\n"
2738     "}\n"
2739     "if {![info exists tkPriv(fg,$t)]} {\n"
2740     "set tkPriv(fg,$t) 1\n"
2741     "set tkPriv(focus,$t) \"\"\n"
2742     "bind $t <FocusIn> [list tkFocusGroup_In $t %W %d]\n"
2743     "bind $t <FocusOut> [list tkFocusGroup_Out $t %W %d]\n"
2744     "bind $t <Destroy> [list tkFocusGroup_Destroy $t %W]\n"
2745     "}\n"
2746     "}\n"
2747     "proc tkFocusGroup_BindIn {t w cmd} {\n"
2748     "global tkFocusIn tkPriv\n"
2749     "if {![info exists tkPriv(fg,$t)]} {\n"
2750     "error \"focus group \\\"$t\\\" doesn't exist\"\n"
2751     "}\n"
2752     "set tkFocusIn($t,$w) $cmd\n"
2753     "}\n"
2754     "proc tkFocusGroup_BindOut {t w cmd} {\n"
2755     "global tkFocusOut tkPriv\n"
2756     "if {![info exists tkPriv(fg,$t)]} {\n"
2757     "error \"focus group \\\"$t\\\" doesn't exist\"\n"
2758     "}\n"
2759     "set tkFocusOut($t,$w) $cmd\n"
2760     "}\n"
2761     "proc tkFocusGroup_Destroy {t w} {\n"
2762     "global tkPriv tkFocusIn tkFocusOut\n"
2763     "if {[string equal $t $w]} {\n"
2764     "unset tkPriv(fg,$t)\n"
2765     "unset tkPriv(focus,$t) \n"
2766     "foreach name [array names tkFocusIn $t,*] {\n"
2767     "unset tkFocusIn($name)\n"
2768     "}\n"
2769     "foreach name [array names tkFocusOut $t,*] {\n"
2770     "unset tkFocusOut($name)\n"
2771     "}\n"
2772     "} else {\n"
2773     "if {[info exists tkPriv(focus,$t)] && \\\n"
2774     "\011\011[string equal $tkPriv(focus,$t) $w]} {\n"
2775     "set tkPriv(focus,$t) \"\"\n"
2776     "}\n"
2777     "catch {\n"
2778     "unset tkFocusIn($t,$w)\n"
2779     "}\n"
2780     "catch {\n"
2781     "unset tkFocusOut($t,$w)\n"
2782     "}\n"
2783     "}\n"
2784     "}\n"
2785     "proc tkFocusGroup_In {t w detail} {\n"
2786     "global tkPriv tkFocusIn\n"
2787     "if {[string compare $detail NotifyNonlinear] && \\\n"
2788     "\011 [string compare $detail NotifyNonlinearVirtual]} {\n"
2789     "return\n"
2790     "}\n"
2791     "if {![info exists tkFocusIn($t,$w)]} {\n"
2792     "set tkFocusIn($t,$w) \"\"\n"
2793     "return\n"
2794     "}\n"
2795     "if {![info exists tkPriv(focus,$t)]} {\n"
2796     "return\n"
2797     "}\n"
2798     "if {[string equal $tkPriv(focus,$t) $w]} {\n"
2799     "return\n"
2800     "} else {\n"
2801     "set tkPriv(focus,$t) $w\n"
2802     "eval $tkFocusIn($t,$w)\n"
2803     "}\n"
2804     "}\n"
2805     "proc tkFocusGroup_Out {t w detail} {\n"
2806     "global tkPriv tkFocusOut\n"
2807     "if {[string compare $detail NotifyNonlinear] && \\\n"
2808     "\011 [string compare $detail NotifyNonlinearVirtual]} {\n"
2809     "return\n"
2810     "}\n"
2811     "if {![info exists tkPriv(focus,$t)]} {\n"
2812     "return\n"
2813     "}\n"
2814     "if {![info exists tkFocusOut($t,$w)]} {\n"
2815     "return\n"
2816     "} else {\n"
2817     "eval $tkFocusOut($t,$w)\n"
2818     "set tkPriv(focus,$t) \"\"\n"
2819     "}\n"
2820     "}\n"
2821     "proc tkFDGetFileTypes {string} {\n"
2822     "foreach t $string {\n"
2823     "if {[llength $t] < 2 || [llength $t] > 3} {\n"
2824     "error \"bad file type \\\"$t\\\", should be \\\"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\\\"\"\n"
2825     "}\n"
2826     "eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1]\n"
2827     "}\n"
2828     "set types {}\n"
2829     "foreach t $string {\n"
2830     "set label [lindex $t 0]\n"
2831     "set exts {}\n"
2832     "if {[info exists hasDoneType($label)]} {\n"
2833     "continue\n"
2834     "}\n"
2835     "set name \"$label (\"\n"
2836     "set sep \"\"\n"
2837     "foreach ext $fileTypes($label) {\n"
2838     "if {[string equal $ext \"\"]} {\n"
2839     "continue\n"
2840     "}\n"
2841     "regsub {^[.]} $ext \"*.\" ext\n"
2842     "if {![info exists hasGotExt($label,$ext)]} {\n"
2843     "append name $sep$ext\n"
2844     "lappend exts $ext\n"
2845     "set hasGotExt($label,$ext) 1\n"
2846     "}\n"
2847     "set sep ,\n"
2848     "}\n"
2849     "append name \")\"\n"
2850     "lappend types [list $name $exts]\n"
2851     "set hasDoneType($label) 1\n"
2852     "}\n"
2853     "return $types\n"
2854     "}\n"
2855     ;
2856     static char Et_zFile12[] =
2857     "proc tkConsoleInit {} {\n"
2858     "global tcl_platform\n"
2859     "if {![consoleinterp eval {set tcl_interactive}]} {\n"
2860     "wm withdraw .\n"
2861     "}\n"
2862     "if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
2863     "set mod \"Ctrl\"\n"
2864     "} else {\n"
2865     "set mod \"Cmd\"\n"
2866     "}\n"
2867     "menu .menubar\n"
2868     ".menubar add cascade -label File -menu .menubar.file -underline 0\n"
2869     ".menubar add cascade -label Edit -menu .menubar.edit -underline 0\n"
2870     "menu .menubar.file -tearoff 0\n"
2871     ".menubar.file add command -label \"Source...\" -underline 0 \\\n"
2872     "\011 -command tkConsoleSource\n"
2873     ".menubar.file add command -label \"Hide Console\" -underline 0 \\\n"
2874     "\011 -command {wm withdraw .}\n"
2875     "if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
2876     ".menubar.file add command -label \"Exit\" -underline 1 -command exit\n"
2877     "} else {\n"
2878     ".menubar.file add command -label \"Quit\" -command exit -accel Cmd-Q\n"
2879     "}\n"
2880     "menu .menubar.edit -tearoff 0\n"
2881     ".menubar.edit add command -label \"Cut\" -underline 2 \\\n"
2882     "\011 -command { event generate .console <<Cut>> } -accel \"$mod+X\"\n"
2883     ".menubar.edit add command -label \"Copy\" -underline 0 \\\n"
2884     "\011 -command { event generate .console <<Copy>> } -accel \"$mod+C\"\n"
2885     ".menubar.edit add command -label \"Paste\" -underline 1 \\\n"
2886     "\011 -command { event generate .console <<Paste>> } -accel \"$mod+V\"\n"
2887     "if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
2888     ".menubar.edit add command -label \"Clear\" -underline 2 \\\n"
2889     "\011\011-command { event generate .console <<Clear>> }\n"
2890     "} else {\n"
2891     ".menubar.edit add command -label \"Delete\" -underline 0 \\\n"
2892     "\011\011-command { event generate .console <<Clear>> } -accel \"Del\"\n"
2893     ".menubar add cascade -label Help -menu .menubar.help -underline 0\n"
2894     "menu .menubar.help -tearoff 0\n"
2895     ".menubar.help add command -label \"About...\" -underline 0 \\\n"
2896     "\011\011-command tkConsoleAbout\n"
2897     "}\n"
2898     ". configure -menu .menubar\n"
2899     "text .console -yscrollcommand \".sb set\" -setgrid true \n"
2900     "scrollbar .sb -command \".console yview\"\n"
2901     "pack .sb -side right -fill both\n"
2902     "pack .console -fill both -expand 1 -side left\n"
2903     "switch -exact $tcl_platform(platform) {\n"
2904     "\"macintosh\" {\n"
2905     ".console configure -font {Monaco 9 normal} -highlightthickness 0\n"
2906     "}\n"
2907     "\"windows\" {\n"
2908     ".console configure -font systemfixed\n"
2909     "}\n"
2910     "}\n"
2911     "tkConsoleBind .console\n"
2912     ".console tag configure stderr -foreground red\n"
2913     ".console tag configure stdin -foreground blue\n"
2914     "focus .console\n"
2915     "wm protocol . WM_DELETE_WINDOW { wm withdraw . }\n"
2916     "wm title . \"" BUILD_CONFIG_STATIC_WISH_ALIAS " v" BUILD_CONFIG_RELEASE_VERSION "\"\n"
2917     "flush stdout\n"
2918     ".console mark set output [.console index \"end - 1 char\"]\n"
2919     "tkTextSetCursor .console end\n"
2920     ".console mark set promptEnd insert\n"
2921     ".console mark gravity promptEnd left\n"
2922     "}\n"
2923     "proc tkConsoleSource {} {\n"
2924     "set filename [tk_getOpenFile -defaultextension .tcl -parent . \\\n"
2925     "\011\011 -title \"Select a file to source\" \\\n"
2926     "\011\011 -filetypes {{\"Tcl Scripts\" .tcl} {\"All Files\" *}}]\n"
2927     "if {[string compare $filename \"\"]} {\n"
2928     "set cmd [list source $filename]\n"
2929     "if {[catch {consoleinterp eval $cmd} result]} {\n"
2930     "tkConsoleOutput stderr \"$result\\n\"\n"
2931     "}\n"
2932     "}\n"
2933     "}\n"
2934     "proc tkConsoleInvoke {args} {\n"
2935     "set ranges [.console tag ranges input]\n"
2936     "set cmd \"\"\n"
2937     "if {[llength $ranges]} {\n"
2938     "set pos 0\n"
2939     "while {[string compare [lindex $ranges $pos] \"\"]} {\n"
2940     "set start [lindex $ranges $pos]\n"
2941     "set end [lindex $ranges [incr pos]]\n"
2942     "append cmd [.console get $start $end]\n"
2943     "incr pos\n"
2944     "}\n"
2945     "}\n"
2946     "if {[string equal $cmd \"\"]} {\n"
2947     "tkConsolePrompt\n"
2948     "} elseif {[info complete $cmd]} {\n"
2949     ".console mark set output end\n"
2950     ".console tag delete input\n"
2951     "set result [consoleinterp record $cmd]\n"
2952     "if {[string compare $result \"\"]} {\n"
2953     "puts $result\n"
2954     "}\n"
2955     "tkConsoleHistory reset\n"
2956     "tkConsolePrompt\n"
2957     "} else {\n"
2958     "tkConsolePrompt partial\n"
2959     "}\n"
2960     ".console yview -pickplace insert\n"
2961     "}\n"
2962     "set histNum 1\n"
2963     "proc tkConsoleHistory {cmd} {\n"
2964     "global histNum\n"
2965     "switch $cmd {\n"
2966     "prev {\n"
2967     "incr histNum -1\n"
2968     "if {$histNum == 0} {\n"
2969     "set cmd {history event [expr {[history nextid] -1}]}\n"
2970     "} else {\n"
2971     "set cmd \"history event $histNum\"\n"
2972     "}\n"
2973     "if {[catch {consoleinterp eval $cmd} cmd]} {\n"
2974     "incr histNum\n"
2975     "return\n"
2976     "}\n"
2977     ".console delete promptEnd end\n"
2978     ".console insert promptEnd $cmd {input stdin}\n"
2979     "}\n"
2980     "next {\n"
2981     "incr histNum\n"
2982     "if {$histNum == 0} {\n"
2983     "set cmd {history event [expr {[history nextid] -1}]}\n"
2984     "} elseif {$histNum > 0} {\n"
2985     "set cmd \"\"\n"
2986     "set histNum 1\n"
2987     "} else {\n"
2988     "set cmd \"history event $histNum\"\n"
2989     "}\n"
2990     "if {[string compare $cmd \"\"]} {\n"
2991     "catch {consoleinterp eval $cmd} cmd\n"
2992     "}\n"
2993     ".console delete promptEnd end\n"
2994     ".console insert promptEnd $cmd {input stdin}\n"
2995     "}\n"
2996     "reset {\n"
2997     "set histNum 1\n"
2998     "}\n"
2999     "}\n"
3000     "}\n"
3001     "proc tkConsolePrompt {{partial normal}} {\n"
3002     "if {[string equal $partial \"normal\"]} {\n"
3003     "set temp [.console index \"end - 1 char\"]\n"
3004     ".console mark set output end\n"
3005     "if {[consoleinterp eval \"info exists tcl_prompt1\"]} {\n"
3006     "consoleinterp eval \"eval \\[set tcl_prompt1\\]\"\n"
3007     "} else {\n"
3008     "puts -nonewline \"% \"\n"
3009     "}\n"
3010     "} else {\n"
3011     "set temp [.console index output]\n"
3012     ".console mark set output end\n"
3013     "if {[consoleinterp eval \"info exists tcl_prompt2\"]} {\n"
3014     "consoleinterp eval \"eval \\[set tcl_prompt2\\]\"\n"
3015     "} else {\n"
3016     "puts -nonewline \"> \"\n"
3017     "}\n"
3018     "}\n"
3019     "flush stdout\n"
3020     ".console mark set output $temp\n"
3021     "tkTextSetCursor .console end\n"
3022     ".console mark set promptEnd insert\n"
3023     ".console mark gravity promptEnd left\n"
3024     "}\n"
3025     "proc tkConsoleBind {win} {\n"
3026     "bindtags $win \"$win Text . all\"\n"
3027     "bind $win <Alt-KeyPress> {# nothing }\n"
3028     "bind $win <Meta-KeyPress> {# nothing}\n"
3029     "bind $win <Control-KeyPress> {# nothing}\n"
3030     "bind $win <Escape> {# nothing}\n"
3031     "bind $win <KP_Enter> {# nothing}\n"
3032     "bind $win <Tab> {\n"
3033     "tkConsoleInsert %W \\t\n"
3034     "focus %W\n"
3035     "break\n"
3036     "}\n"
3037     "bind $win <Return> {\n"
3038     "%W mark set insert {end - 1c}\n"
3039     "tkConsoleInsert %W \"\\n\"\n"
3040     "tkConsoleInvoke\n"
3041     "break\n"
3042     "}\n"
3043     "bind $win <Delete> {\n"
3044     "if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
3045     "%W tag remove sel sel.first promptEnd\n"
3046     "} elseif {[%W compare insert < promptEnd]} {\n"
3047     "break\n"
3048     "}\n"
3049     "}\n"
3050     "bind $win <BackSpace> {\n"
3051     "if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
3052     "%W tag remove sel sel.first promptEnd\n"
3053     "} elseif {[%W compare insert <= promptEnd]} {\n"
3054     "break\n"
3055     "}\n"
3056     "}\n"
3057     "foreach left {Control-a Home} {\n"
3058     "bind $win <$left> {\n"
3059     "if {[%W compare insert < promptEnd]} {\n"
3060     "tkTextSetCursor %W {insert linestart}\n"
3061     "} else {\n"
3062     "tkTextSetCursor %W promptEnd\n"
3063     "}\n"
3064     "break\n"
3065     "}\n"
3066     "}\n"
3067     "foreach right {Control-e End} {\n"
3068     "bind $win <$right> {\n"
3069     "tkTextSetCursor %W {insert lineend}\n"
3070     "break\n"
3071     "}\n"
3072     "}\n"
3073     "bind $win <Control-d> {\n"
3074     "if {[%W compare insert < promptEnd]} {\n"
3075     "break\n"
3076     "}\n"
3077     "}\n"
3078     "bind $win <Control-k> {\n"
3079     "if {[%W compare insert < promptEnd]} {\n"
3080     "%W mark set insert promptEnd\n"
3081     "}\n"
3082     "}\n"
3083     "bind $win <Control-t> {\n"
3084     "if {[%W compare insert < promptEnd]} {\n"
3085     "break\n"
3086     "}\n"
3087     "}\n"
3088     "bind $win <Meta-d> {\n"
3089     "if {[%W compare insert < promptEnd]} {\n"
3090     "break\n"
3091     "}\n"
3092     "}\n"
3093     "bind $win <Meta-BackSpace> {\n"
3094     "if {[%W compare insert <= promptEnd]} {\n"
3095     "break\n"
3096     "}\n"
3097     "}\n"
3098     "bind $win <Control-h> {\n"
3099     "if {[%W compare insert <= promptEnd]} {\n"
3100     "break\n"
3101     "}\n"
3102     "}\n"
3103     "foreach prev {Control-p Up} {\n"
3104     "bind $win <$prev> {\n"
3105     "tkConsoleHistory prev\n"
3106     "break\n"
3107     "}\n"
3108     "}\n"
3109     "foreach prev {Control-n Down} {\n"
3110     "bind $win <$prev> {\n"
3111     "tkConsoleHistory next\n"
3112     "break\n"
3113     "}\n"
3114     "}\n"
3115     "bind $win <Insert> {\n"
3116     "catch {tkConsoleInsert %W [selection get -displayof %W]}\n"
3117     "break\n"
3118     "}\n"
3119     "bind $win <KeyPress> {\n"
3120     "tkConsoleInsert %W %A\n"
3121     "break\n"
3122     "}\n"
3123     "foreach left {Control-b Left} {\n"
3124     "bind $win <$left> {\n"
3125     "if {[%W compare insert == promptEnd]} {\n"
3126     "break\n"
3127     "}\n"
3128     "tkTextSetCursor %W insert-1c\n"
3129     "break\n"
3130     "}\n"
3131     "}\n"
3132     "foreach right {Control-f Right} {\n"
3133     "bind $win <$right> {\n"
3134     "tkTextSetCursor %W insert+1c\n"
3135     "break\n"
3136     "}\n"
3137     "}\n"
3138     "bind $win <F9> {\n"
3139     "eval destroy [winfo child .]\n"
3140     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
3141     "source -rsrc Console\n"
3142     "} else {\n"
3143     "source [file join $tk_library console.tcl]\n"
3144     "}\n"
3145     "}\n"
3146     "bind $win <<Cut>> {\n"
3147     "if {![catch {set data [%W get sel.first sel.last]}]} {\n"
3148     "clipboard clear -displayof %W\n"
3149     "clipboard append -displayof %W $data\n"
3150     "}\n"
3151     "break\n"
3152     "}\n"
3153     "bind $win <<Copy>> {\n"
3154     "if {![catch {set data [%W get sel.first sel.last]}]} {\n"
3155     "clipboard clear -displayof %W\n"
3156     "clipboard append -displayof %W $data\n"
3157     "}\n"
3158     "break\n"
3159     "}\n"
3160     "bind $win <<Paste>> {\n"
3161     "catch {\n"
3162     "set clip [selection get -displayof %W -selection CLIPBOARD]\n"
3163     "set list [split $clip \\n\\r]\n"
3164     "tkConsoleInsert %W [lindex $list 0]\n"
3165     "foreach x [lrange $list 1 end] {\n"
3166     "%W mark set insert {end - 1c}\n"
3167     "tkConsoleInsert %W \"\\n\"\n"
3168     "tkConsoleInvoke\n"
3169     "tkConsoleInsert %W $x\n"
3170     "}\n"
3171     "}\n"
3172     "break\n"
3173     "}\n"
3174     "}\n"
3175     "proc tkConsoleInsert {w s} {\n"
3176     "if {[string equal $s \"\"]} {\n"
3177     "return\n"
3178     "}\n"
3179     "catch {\n"
3180     "if {[$w compare sel.first <= insert]\n"
3181     "&& [$w compare sel.last >= insert]} {\n"
3182     "$w tag remove sel sel.first promptEnd\n"
3183     "$w delete sel.first sel.last\n"
3184     "}\n"
3185     "}\n"
3186     "if {[$w compare insert < promptEnd]} {\n"
3187     "$w mark set insert end\011\n"
3188     "}\n"
3189     "$w insert insert $s {input stdin}\n"
3190     "$w see insert\n"
3191     "}\n"
3192     "proc tkConsoleOutput {dest string} {\n"
3193     ".console insert output $string $dest\n"
3194     ".console see insert\n"
3195     "}\n"
3196     "proc tkConsoleExit {} {\n"
3197     "destroy .\n"
3198     "}\n"
3199     "proc tkConsoleAbout {} {\n"
3200     "global tk_patchLevel\n"
3201     "tk_messageBox -type ok -message \""
3202     BUILD_CONFIG_STATIC_WISH_ALIAS
3203     " for Windows, Version "
3204     BUILD_CONFIG_RELEASE_VERSION ", " BUILD_CONFIG_RELEASE_YEAR ".\n"
3205     "This product is an open-source static port of\n"
3206     "Tcl/Tk 8.3.1, originally from Scriptics. This product\n"
3207     "and its source code can be downloaded at no charge\n"
3208     "from http://ijutools.sourceforge.net, and is licensed\n"
3209     "under the GNU Public License (GPL).\n"
3210     "(Core components: Tcl [info patchlevel], Tk $tk_patchLevel.)\"\n"
3211     "}\n"
3212     "tkConsoleInit\n"
3213     ;
3214     static char Et_zFile13[] =
3215     "proc tk_dialog {w title text bitmap default args} {\n"
3216     "global tkPriv tcl_platform\n"
3217     "if {[string is int $default]} {\n"
3218     "if {$default >= [llength $args]} {\n"
3219     "return -code error \"default button index greater than number of\\\n"
3220     "\011\011 buttons specified for tk_dialog\"\n"
3221     "}\n"
3222     "} elseif {[string equal {} $default]} {\n"
3223     "set default -1\n"
3224     "} else {\n"
3225     "set default [lsearch -exact $args $default]\n"
3226     "}\n"
3227     "catch {destroy $w}\n"
3228     "toplevel $w -class Dialog\n"
3229     "wm title $w $title\n"
3230     "wm iconname $w Dialog\n"
3231     "wm protocol $w WM_DELETE_WINDOW { }\n"
3232     "if { [winfo viewable [winfo toplevel [winfo parent $w]]] } {\n"
3233     "wm transient $w [winfo toplevel [winfo parent $w]]\n"
3234     "} \n"
3235     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
3236     "unsupported1 style $w dBoxProc\n"
3237     "}\n"
3238     "frame $w.bot\n"
3239     "frame $w.top\n"
3240     "if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
3241     "$w.bot configure -relief raised -bd 1\n"
3242     "$w.top configure -relief raised -bd 1\n"
3243     "}\n"
3244     "pack $w.bot -side bottom -fill both\n"
3245     "pack $w.top -side top -fill both -expand 1\n"
3246     "option add *Dialog.msg.wrapLength 3i widgetDefault\n"
3247     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
3248     "option add *Dialog.msg.font system widgetDefault\n"
3249     "} else {\n"
3250     "option add *Dialog.msg.font {Times 12} widgetDefault\n"
3251     "}\n"
3252     "label $w.msg -justify left -text $text\n"
3253     "pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m\n"
3254     "if {[string compare $bitmap \"\"]} {\n"
3255     "if {[string equal $tcl_platform(platform) \"macintosh\"] && \\\n"
3256     "\011\011[string equal $bitmap \"error\"]} {\n"
3257     "set bitmap \"stop\"\n"
3258     "}\n"
3259     "label $w.bitmap -bitmap $bitmap\n"
3260     "pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m\n"
3261     "}\n"
3262     "set i 0\n"
3263     "foreach but $args {\n"
3264     "button $w.button$i -text $but -command [list set tkPriv(button) $i]\n"
3265     "if {$i == $default} {\n"
3266     "$w.button$i configure -default active\n"
3267     "} else {\n"
3268     "$w.button$i configure -default normal\n"
3269     "}\n"
3270     "grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10\n"
3271     "grid columnconfigure $w.bot $i\n"
3272     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
3273     "set tmp [string tolower $but]\n"
3274     "if {[string equal $tmp \"ok\"] || [string equal $tmp \"cancel\"]} {\n"
3275     "grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]\n"
3276     "}\n"
3277     "}\n"
3278     "incr i\n"
3279     "}\n"
3280     "if {$default >= 0} {\n"
3281     "bind $w <Return> \"\n"
3282     "[list $w.button$default] configure -state active -relief sunken\n"
3283     "update idletasks\n"
3284     "after 100\n"
3285     "set tkPriv(button) $default\n"
3286     "\"\n"
3287     "}\n"
3288     "bind $w <Destroy> {set tkPriv(button) -1}\n"
3289     "wm withdraw $w\n"
3290     "update idletasks\n"
3291     "set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n"
3292     "\011 - [winfo vrootx [winfo parent $w]]}]\n"
3293     "set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n"
3294     "\011 - [winfo vrooty [winfo parent $w]]}]\n"
3295     "wm geom $w +$x+$y\n"
3296     "wm deiconify $w\n"
3297     "set oldFocus [focus]\n"
3298     "set oldGrab [grab current $w]\n"
3299     "if {[string compare $oldGrab \"\"]} {\n"
3300     "set grabStatus [grab status $oldGrab]\n"
3301     "}\n"
3302     "grab $w\n"
3303     "if {$default >= 0} {\n"
3304     "focus $w.button$default\n"
3305     "} else {\n"
3306     "focus $w\n"
3307     "}\n"
3308     "tkwait variable tkPriv(button)\n"
3309     "catch {focus $oldFocus}\n"
3310     "catch {\n"
3311     "bind $w <Destroy> {}\n"
3312     "destroy $w\n"
3313     "}\n"
3314     "if {[string compare $oldGrab \"\"]} {\n"
3315     "if {[string compare $grabStatus \"global\"]} {\n"
3316     "grab $oldGrab\n"
3317     "} else {\n"
3318     "grab -global $oldGrab\n"
3319     "}\n"
3320     "}\n"
3321     "return $tkPriv(button)\n"
3322     "}\n"
3323     ;
3324     static char Et_zFile14[] =
3325     "bind Entry <<Cut>> {\n"
3326     "if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {\n"
3327     "clipboard clear -displayof %W\n"
3328     "clipboard append -displayof %W $tkPriv(data)\n"
3329     "%W delete sel.first sel.last\n"
3330     "unset tkPriv(data)\n"
3331     "}\n"
3332     "}\n"
3333     "bind Entry <<Copy>> {\n"
3334     "if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {\n"
3335     "clipboard clear -displayof %W\n"
3336     "clipboard append -displayof %W $tkPriv(data)\n"
3337     "unset tkPriv(data)\n"
3338     "}\n"
3339     "}\n"
3340     "bind Entry <<Paste>> {\n"
3341     "global tcl_platform\n"
3342     "catch {\n"
3343     "if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
3344     "catch {\n"
3345     "%W delete sel.first sel.last\n"
3346     "}\n"
3347     "}\n"
3348     "%W insert insert [selection get -displayof %W -selection CLIPBOARD]\n"
3349     "tkEntrySeeInsert %W\n"
3350     "}\n"
3351     "}\n"
3352     "bind Entry <<Clear>> {\n"
3353     "%W delete sel.first sel.last\n"
3354     "}\n"
3355     "bind Entry <<PasteSelection>> {\n"
3356     "if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n"
3357     "tkEntryPaste %W %x\n"
3358     "}\n"
3359     "}\n"
3360     "bind Entry <1> {\n"
3361     "tkEntryButton1 %W %x\n"
3362     "%W selection clear\n"
3363     "}\n"
3364     "bind Entry <B1-Motion> {\n"
3365     "set tkPriv(x) %x\n"
3366     "tkEntryMouseSelect %W %x\n"
3367     "}\n"
3368     "bind Entry <Double-1> {\n"
3369     "set tkPriv(selectMode) word\n"
3370     "tkEntryMouseSelect %W %x\n"
3371     "catch {%W icursor sel.first}\n"
3372     "}\n"
3373     "bind Entry <Triple-1> {\n"
3374     "set tkPriv(selectMode) line\n"
3375     "tkEntryMouseSelect %W %x\n"
3376     "%W icursor 0\n"
3377     "}\n"
3378     "bind Entry <Shift-1> {\n"
3379     "set tkPriv(selectMode) char\n"
3380     "%W selection adjust @%x\n"
3381     "}\n"
3382     "bind Entry <Double-Shift-1>\011{\n"
3383     "set tkPriv(selectMode) word\n"
3384     "tkEntryMouseSelect %W %x\n"
3385     "}\n"
3386     "bind Entry <Triple-Shift-1>\011{\n"
3387     "set tkPriv(selectMode) line\n"
3388     "tkEntryMouseSelect %W %x\n"
3389     "}\n"
3390     "bind Entry <B1-Leave> {\n"
3391     "set tkPriv(x) %x\n"
3392     "tkEntryAutoScan %W\n"
3393     "}\n"
3394     "bind Entry <B1-Enter> {\n"
3395     "tkCancelRepeat\n"
3396     "}\n"
3397     "bind Entry <ButtonRelease-1> {\n"
3398     "tkCancelRepeat\n"
3399     "}\n"
3400     "bind Entry <Control-1> {\n"
3401     "%W icursor @%x\n"
3402     "}\n"
3403     "bind Entry <Left> {\n"
3404     "tkEntrySetCursor %W [expr {[%W index insert] - 1}]\n"
3405     "}\n"
3406     "bind Entry <Right> {\n"
3407     "tkEntrySetCursor %W [expr {[%W index insert] + 1}]\n"
3408     "}\n"
3409     "bind Entry <Shift-Left> {\n"
3410     "tkEntryKeySelect %W [expr {[%W index insert] - 1}]\n"
3411     "tkEntrySeeInsert %W\n"
3412     "}\n"
3413     "bind Entry <Shift-Right> {\n"
3414     "tkEntryKeySelect %W [expr {[%W index insert] + 1}]\n"
3415     "tkEntrySeeInsert %W\n"
3416     "}\n"
3417     "bind Entry <Control-Left> {\n"
3418     "tkEntrySetCursor %W [tkEntryPreviousWord %W insert]\n"
3419     "}\n"
3420     "bind Entry <Control-Right> {\n"
3421     "tkEntrySetCursor %W [tkEntryNextWord %W insert]\n"
3422     "}\n"
3423     "bind Entry <Shift-Control-Left> {\n"
3424     "tkEntryKeySelect %W [tkEntryPreviousWord %W insert]\n"
3425     "tkEntrySeeInsert %W\n"
3426     "}\n"
3427     "bind Entry <Shift-Control-Right> {\n"
3428     "tkEntryKeySelect %W [tkEntryNextWord %W insert]\n"
3429     "tkEntrySeeInsert %W\n"
3430     "}\n"
3431     "bind Entry <Home> {\n"
3432     "tkEntrySetCursor %W 0\n"
3433     "}\n"
3434     "bind Entry <Shift-Home> {\n"
3435     "tkEntryKeySelect %W 0\n"
3436     "tkEntrySeeInsert %W\n"
3437     "}\n"
3438     "bind Entry <End> {\n"
3439     "tkEntrySetCursor %W end\n"
3440     "}\n"
3441     "bind Entry <Shift-End> {\n"
3442     "tkEntryKeySelect %W end\n"
3443     "tkEntrySeeInsert %W\n"
3444     "}\n"
3445     "bind Entry <Delete> {\n"
3446     "if {[%W selection present]} {\n"
3447     "%W delete sel.first sel.last\n"
3448     "} else {\n"
3449     "%W delete insert\n"
3450     "}\n"
3451     "}\n"
3452     "bind Entry <BackSpace> {\n"
3453     "tkEntryBackspace %W\n"
3454     "}\n"
3455     "bind Entry <Control-space> {\n"
3456     "%W selection from insert\n"
3457     "}\n"
3458     "bind Entry <Select> {\n"
3459     "%W selection from insert\n"
3460     "}\n"
3461     "bind Entry <Control-Shift-space> {\n"
3462     "%W selection adjust insert\n"
3463     "}\n"
3464     "bind Entry <Shift-Select> {\n"
3465     "%W selection adjust insert\n"
3466     "}\n"
3467     "bind Entry <Control-slash> {\n"
3468     "%W selection range 0 end\n"
3469     "}\n"
3470     "bind Entry <Control-backslash> {\n"
3471     "%W selection clear\n"
3472     "}\n"
3473     "bind Entry <KeyPress> {\n"
3474     "tkEntryInsert %W %A\n"
3475     "}\n"
3476     "bind Entry <Alt-KeyPress> {# nothing}\n"
3477     "bind Entry <Meta-KeyPress> {# nothing}\n"
3478     "bind Entry <Control-KeyPress> {# nothing}\n"
3479     "bind Entry <Escape> {# nothing}\n"
3480     "bind Entry <Return> {# nothing}\n"
3481     "bind Entry <KP_Enter> {# nothing}\n"
3482     "bind Entry <Tab> {# nothing}\n"
3483     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
3484     "bind Entry <Command-KeyPress> {# nothing}\n"
3485     "}\n"
3486     "if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
3487     "bind Entry <Insert> {\n"
3488     "catch {tkEntryInsert %W [selection get -displayof %W]}\n"
3489     "}\n"
3490     "}\n"
3491     "bind Entry <Control-a> {\n"
3492     "if {!$tk_strictMotif} {\n"
3493     "tkEntrySetCursor %W 0\n"
3494     "}\n"
3495     "}\n"
3496     "bind Entry <Control-b> {\n"
3497     "if {!$tk_strictMotif} {\n"
3498     "tkEntrySetCursor %W [expr {[%W index insert] - 1}]\n"
3499     "}\n"
3500     "}\n"
3501     "bind Entry <Control-d> {\n"
3502     "if {!$tk_strictMotif} {\n"
3503     "%W delete insert\n"
3504     "}\n"
3505     "}\n"
3506     "bind Entry <Control-e> {\n"
3507     "if {!$tk_strictMotif} {\n"
3508     "tkEntrySetCursor %W end\n"
3509     "}\n"
3510     "}\n"
3511     "bind Entry <Control-f> {\n"
3512     "if {!$tk_strictMotif} {\n"
3513     "tkEntrySetCursor %W [expr {[%W index insert] + 1}]\n"
3514     "}\n"
3515     "}\n"
3516     "bind Entry <Control-h> {\n"
3517     "if {!$tk_strictMotif} {\n"
3518     "tkEntryBackspace %W\n"
3519     "}\n"
3520     "}\n"
3521     "bind Entry <Control-k> {\n"
3522     "if {!$tk_strictMotif} {\n"
3523     "%W delete insert end\n"
3524     "}\n"
3525     "}\n"
3526     "bind Entry <Control-t> {\n"
3527     "if {!$tk_strictMotif} {\n"
3528     "tkEntryTranspose %W\n"
3529     "}\n"
3530     "}\n"
3531     "bind Entry <Meta-b> {\n"
3532     "if {!$tk_strictMotif} {\n"
3533     "tkEntrySetCursor %W [tkEntryPreviousWord %W insert]\n"
3534     "}\n"
3535     "}\n"
3536     "bind Entry <Meta-d> {\n"
3537     "if {!$tk_strictMotif} {\n"
3538     "%W delete insert [tkEntryNextWord %W insert]\n"
3539     "}\n"
3540     "}\n"
3541     "bind Entry <Meta-f> {\n"
3542     "if {!$tk_strictMotif} {\n"
3543     "tkEntrySetCursor %W [tkEntryNextWord %W insert]\n"
3544     "}\n"
3545     "}\n"
3546     "bind Entry <Meta-BackSpace> {\n"
3547     "if {!$tk_strictMotif} {\n"
3548     "%W delete [tkEntryPreviousWord %W insert] insert\n"
3549     "}\n"
3550     "}\n"
3551     "bind Entry <Meta-Delete> {\n"
3552     "if {!$tk_strictMotif} {\n"
3553     "%W delete [tkEntryPreviousWord %W insert] insert\n"
3554     "}\n"
3555     "}\n"
3556     "bind Entry <2> {\n"
3557     "if {!$tk_strictMotif} {\n"
3558     "%W scan mark %x\n"
3559     "set tkPriv(x) %x\n"
3560     "set tkPriv(y) %y\n"
3561     "set tkPriv(mouseMoved) 0\n"
3562     "}\n"
3563     "}\n"
3564     "bind Entry <B2-Motion> {\n"
3565     "if {!$tk_strictMotif} {\n"
3566     "if {abs(%x-$tkPriv(x)) > 2} {\n"
3567     "set tkPriv(mouseMoved) 1\n"
3568     "}\n"
3569     "%W scan dragto %x\n"
3570     "}\n"
3571     "}\n"
3572     "proc tkEntryClosestGap {w x} {\n"
3573     "set pos [$w index @$x]\n"
3574     "set bbox [$w bbox $pos]\n"
3575     "if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {\n"
3576     "return $pos\n"
3577     "}\n"
3578     "incr pos\n"
3579     "}\n"
3580     "proc tkEntryButton1 {w x} {\n"
3581     "global tkPriv\n"
3582     "set tkPriv(selectMode) char\n"
3583     "set tkPriv(mouseMoved) 0\n"
3584     "set tkPriv(pressX) $x\n"
3585     "$w icursor [tkEntryClosestGap $w $x]\n"
3586     "$w selection from insert\n"
3587     "if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
3588     "}\n"
3589     "proc tkEntryMouseSelect {w x} {\n"
3590     "global tkPriv\n"
3591     "set cur [tkEntryClosestGap $w $x]\n"
3592     "set anchor [$w index anchor]\n"
3593     "if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {\n"
3594     "set tkPriv(mouseMoved) 1\n"
3595     "}\n"
3596     "switch $tkPriv(selectMode) {\n"
3597     "char {\n"
3598     "if {$tkPriv(mouseMoved)} {\n"
3599     "if {$cur < $anchor} {\n"
3600     "$w selection range $cur $anchor\n"
3601     "} elseif {$cur > $anchor} {\n"
3602     "$w selection range $anchor $cur\n"
3603     "} else {\n"
3604     "$w selection clear\n"
3605     "}\n"
3606     "}\n"
3607     "}\n"
3608     "word {\n"
3609     "if {$cur < [$w index anchor]} {\n"
3610     "set before [tcl_wordBreakBefore [$w get] $cur]\n"
3611     "set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]\n"
3612     "} else {\n"
3613     "set before [tcl_wordBreakBefore [$w get] $anchor]\n"
3614     "set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]\n"
3615     "}\n"
3616     "if {$before < 0} {\n"
3617     "set before 0\n"
3618     "}\n"
3619     "if {$after < 0} {\n"
3620     "set after end\n"
3621     "}\n"
3622     "$w selection range $before $after\n"
3623     "}\n"
3624     "line {\n"
3625     "$w selection range 0 end\n"
3626     "}\n"
3627     "}\n"
3628     "update idletasks\n"
3629     "}\n"
3630     "proc tkEntryPaste {w x} {\n"
3631     "global tkPriv\n"
3632     "$w icursor [tkEntryClosestGap $w $x]\n"
3633     "catch {$w insert insert [selection get -displayof $w]}\n"
3634     "if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
3635     "}\n"
3636     "proc tkEntryAutoScan {w} {\n"
3637     "global tkPriv\n"
3638     "set x $tkPriv(x)\n"
3639     "if {![winfo exists $w]} return\n"
3640     "if {$x >= [winfo width $w]} {\n"
3641     "$w xview scroll 2 units\n"
3642     "tkEntryMouseSelect $w $x\n"
3643     "} elseif {$x < 0} {\n"
3644     "$w xview scroll -2 units\n"
3645     "tkEntryMouseSelect $w $x\n"
3646     "}\n"
3647     "set tkPriv(afterId) [after 50 [list tkEntryAutoScan $w]]\n"
3648     "}\n"
3649     "proc tkEntryKeySelect {w new} {\n"
3650     "if {![$w selection present]} {\n"
3651     "$w selection from insert\n"
3652     "$w selection to $new\n"
3653     "} else {\n"
3654     "$w selection adjust $new\n"
3655     "}\n"
3656     "$w icursor $new\n"
3657     "}\n"
3658     "proc tkEntryInsert {w s} {\n"
3659     "if {[string equal $s \"\"]} {\n"
3660     "return\n"
3661     "}\n"
3662     "catch {\n"
3663     "set insert [$w index insert]\n"
3664     "if {([$w index sel.first] <= $insert)\n"
3665     "&& ([$w index sel.last] >= $insert)} {\n"
3666     "$w delete sel.first sel.last\n"
3667     "}\n"
3668     "}\n"
3669     "$w insert insert $s\n"
3670     "tkEntrySeeInsert $w\n"
3671     "}\n"
3672     "proc tkEntryBackspace w {\n"
3673     "if {[$w selection present]} {\n"
3674     "$w delete sel.first sel.last\n"
3675     "} else {\n"
3676     "set x [expr {[$w index insert] - 1}]\n"
3677     "if {$x >= 0} {$w delete $x}\n"
3678     "if {[$w index @0] >= [$w index insert]} {\n"
3679     "set range [$w xview]\n"
3680     "set left [lindex $range 0]\n"
3681     "set right [lindex $range 1]\n"
3682     "$w xview moveto [expr {$left - ($right - $left)/2.0}]\n"
3683     "}\n"
3684     "}\n"
3685     "}\n"
3686     "proc tkEntrySeeInsert w {\n"
3687     "set c [$w index insert]\n"
3688     "if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {\n"
3689     "$w xview $c\n"
3690     "}\n"
3691     "}\n"
3692     "proc tkEntrySetCursor {w pos} {\n"
3693     "$w icursor $pos\n"
3694     "$w selection clear\n"
3695     "tkEntrySeeInsert $w\n"
3696     "}\n"
3697     "proc tkEntryTranspose w {\n"
3698     "set i [$w index insert]\n"
3699     "if {$i < [$w index end]} {\n"
3700     "incr i\n"
3701     "}\n"
3702     "set first [expr {$i-2}]\n"
3703     "if {$first < 0} {\n"
3704     "return\n"
3705     "}\n"
3706     "set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]\n"
3707     "$w delete $first $i\n"
3708     "$w insert insert $new\n"
3709     "tkEntrySeeInsert $w\n"
3710     "}\n"
3711     "if {[string equal $tcl_platform(platform) \"windows\"]} {\n"
3712     "proc tkEntryNextWord {w start} {\n"
3713     "set pos [tcl_endOfWord [$w get] [$w index $start]]\n"
3714     "if {$pos >= 0} {\n"
3715     "set pos [tcl_startOfNextWord [$w get] $pos]\n"
3716     "}\n"
3717     "if {$pos < 0} {\n"
3718     "return end\n"
3719     "}\n"
3720     "return $pos\n"
3721     "}\n"
3722     "} else {\n"
3723     "proc tkEntryNextWord {w start} {\n"
3724     "set pos [tcl_endOfWord [$w get] [$w index $start]]\n"
3725     "if {$pos < 0} {\n"
3726     "return end\n"
3727     "}\n"
3728     "return $pos\n"
3729     "}\n"
3730     "}\n"
3731     "proc tkEntryPreviousWord {w start} {\n"
3732     "set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]\n"
3733     "if {$pos < 0} {\n"
3734     "return 0\n"
3735     "}\n"
3736     "return $pos\n"
3737     "}\n"
3738     "proc tkEntryGetSelection {w} {\n"
3739     "set entryString [string range [$w get] [$w index sel.first] \\\n"
3740     "\011 [expr {[$w index sel.last] - 1}]]\n"
3741     "if {[string compare [$w cget -show] \"\"]} {\n"
3742     "regsub -all . $entryString [string index [$w cget -show] 0] entryString\n"
3743     "}\n"
3744     "return $entryString\n"
3745     "}\n"
3746     ;
3747     static char Et_zFile15[] =
3748     "proc tk_focusNext w {\n"
3749     "set cur $w\n"
3750     "while {1} {\n"
3751     "set parent $cur\n"
3752     "set children [winfo children $cur]\n"
3753     "set i -1\n"
3754     "while {1} {\n"
3755     "incr i\n"
3756     "if {$i < [llength $children]} {\n"
3757     "set cur [lindex $children $i]\n"
3758     "if {[string equal [winfo toplevel $cur] $cur]} {\n"
3759     "continue\n"
3760     "} else {\n"
3761     "break\n"
3762     "}\n"
3763     "}\n"
3764     "set cur $parent\n"
3765     "if {[string equal [winfo toplevel $cur] $cur]} {\n"
3766     "break\n"
3767     "}\n"
3768     "set parent [winfo parent $parent]\n"
3769     "set children [winfo children $parent]\n"
3770     "set i [lsearch -exact $children $cur]\n"
3771     "}\n"
3772     "if {[string equal $w $cur] || [tkFocusOK $cur]} {\n"
3773     "return $cur\n"
3774     "}\n"
3775     "}\n"
3776     "}\n"
3777     "proc tk_focusPrev w {\n"
3778     "set cur $w\n"
3779     "while {1} {\n"
3780     "if {[string equal [winfo toplevel $cur] $cur]} {\n"
3781     "set parent $cur\n"
3782