/[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 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 5 months ago) by dashley
File MIME type: text/plain
File size: 355233 byte(s)
Rename for reorganization.
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     "set children [winfo children $cur]\n"
3783     "set i [llength $children]\n"
3784     "} else {\n"
3785     "set parent [winfo parent $cur]\n"
3786     "set children [winfo children $parent]\n"
3787     "set i [lsearch -exact $children $cur]\n"
3788     "}\n"
3789     "while {$i > 0} {\n"
3790     "incr i -1\n"
3791     "set cur [lindex $children $i]\n"
3792     "if {[string equal [winfo toplevel $cur] $cur]} {\n"
3793     "continue\n"
3794     "}\n"
3795     "set parent $cur\n"
3796     "set children [winfo children $parent]\n"
3797     "set i [llength $children]\n"
3798     "}\n"
3799     "set cur $parent\n"
3800     "if {[string equal $w $cur] || [tkFocusOK $cur]} {\n"
3801     "return $cur\n"
3802     "}\n"
3803     "}\n"
3804     "}\n"
3805     "proc tkFocusOK w {\n"
3806     "set code [catch {$w cget -takefocus} value]\n"
3807     "if {($code == 0) && [string compare $value \"\"]} {\n"
3808     "if {$value == 0} {\n"
3809     "return 0\n"
3810     "} elseif {$value == 1} {\n"
3811     "return [winfo viewable $w]\n"
3812     "} else {\n"
3813     "set value [uplevel #0 [list $value $w]]\n"
3814     "if {[string compare $value \"\"]} {\n"
3815     "return $value\n"
3816     "}\n"
3817     "}\n"
3818     "}\n"
3819     "if {![winfo viewable $w]} {\n"
3820     "return 0\n"
3821     "}\n"
3822     "set code [catch {$w cget -state} value]\n"
3823     "if {($code == 0) && [string equal $value \"disabled\"]} {\n"
3824     "return 0\n"
3825     "}\n"
3826     "regexp Key|Focus \"[bind $w] [bind [winfo class $w]]\"\n"
3827     "}\n"
3828     "proc tk_focusFollowsMouse {} {\n"
3829     "set old [bind all <Enter>]\n"
3830     "set script {\n"
3831     "if {[string equal \"%d\" \"NotifyAncestor\"] \\\n"
3832     "\011\011|| [string equal \"%d\" \"NotifyNonlinear\"] \\\n"
3833     "\011\011|| [string equal \"%d\" \"NotifyInferior\"]} {\n"
3834     "if {[tkFocusOK %W]} {\n"
3835     "focus %W\n"
3836     "}\n"
3837     "}\n"
3838     "}\n"
3839     "if {[string compare $old \"\"]} {\n"
3840     "bind all <Enter> \"$old; $script\"\n"
3841     "} else {\n"
3842     "bind all <Enter> $script\n"
3843     "}\n"
3844     "}\n"
3845     ;
3846     static char Et_zFile16[] =
3847     "bind Listbox <1> {\n"
3848     "if {[winfo exists %W]} {\n"
3849     "tkListboxBeginSelect %W [%W index @%x,%y]\n"
3850     "}\n"
3851     "}\n"
3852     "bind Listbox <Double-1> {\n"
3853     "}\n"
3854     "bind Listbox <B1-Motion> {\n"
3855     "set tkPriv(x) %x\n"
3856     "set tkPriv(y) %y\n"
3857     "tkListboxMotion %W [%W index @%x,%y]\n"
3858     "}\n"
3859     "bind Listbox <ButtonRelease-1> {\n"
3860     "tkCancelRepeat\n"
3861     "%W activate @%x,%y\n"
3862     "}\n"
3863     "bind Listbox <Shift-1> {\n"
3864     "tkListboxBeginExtend %W [%W index @%x,%y]\n"
3865     "}\n"
3866     "bind Listbox <Control-1> {\n"
3867     "tkListboxBeginToggle %W [%W index @%x,%y]\n"
3868     "}\n"
3869     "bind Listbox <B1-Leave> {\n"
3870     "set tkPriv(x) %x\n"
3871     "set tkPriv(y) %y\n"
3872     "tkListboxAutoScan %W\n"
3873     "}\n"
3874     "bind Listbox <B1-Enter> {\n"
3875     "tkCancelRepeat\n"
3876     "}\n"
3877     "bind Listbox <Up> {\n"
3878     "tkListboxUpDown %W -1\n"
3879     "}\n"
3880     "bind Listbox <Shift-Up> {\n"
3881     "tkListboxExtendUpDown %W -1\n"
3882     "}\n"
3883     "bind Listbox <Down> {\n"
3884     "tkListboxUpDown %W 1\n"
3885     "}\n"
3886     "bind Listbox <Shift-Down> {\n"
3887     "tkListboxExtendUpDown %W 1\n"
3888     "}\n"
3889     "bind Listbox <Left> {\n"
3890     "%W xview scroll -1 units\n"
3891     "}\n"
3892     "bind Listbox <Control-Left> {\n"
3893     "%W xview scroll -1 pages\n"
3894     "}\n"
3895     "bind Listbox <Right> {\n"
3896     "%W xview scroll 1 units\n"
3897     "}\n"
3898     "bind Listbox <Control-Right> {\n"
3899     "%W xview scroll 1 pages\n"
3900     "}\n"
3901     "bind Listbox <Prior> {\n"
3902     "%W yview scroll -1 pages\n"
3903     "%W activate @0,0\n"
3904     "}\n"
3905     "bind Listbox <Next> {\n"
3906     "%W yview scroll 1 pages\n"
3907     "%W activate @0,0\n"
3908     "}\n"
3909     "bind Listbox <Control-Prior> {\n"
3910     "%W xview scroll -1 pages\n"
3911     "}\n"
3912     "bind Listbox <Control-Next> {\n"
3913     "%W xview scroll 1 pages\n"
3914     "}\n"
3915     "bind Listbox <Home> {\n"
3916     "%W xview moveto 0\n"
3917     "}\n"
3918     "bind Listbox <End> {\n"
3919     "%W xview moveto 1\n"
3920     "}\n"
3921     "bind Listbox <Control-Home> {\n"
3922     "%W activate 0\n"
3923     "%W see 0\n"
3924     "%W selection clear 0 end\n"
3925     "%W selection set 0\n"
3926     "event generate %W <<ListboxSelect>>\n"
3927     "}\n"
3928     "bind Listbox <Shift-Control-Home> {\n"
3929     "tkListboxDataExtend %W 0\n"
3930     "}\n"
3931     "bind Listbox <Control-End> {\n"
3932     "%W activate end\n"
3933     "%W see end\n"
3934     "%W selection clear 0 end\n"
3935     "%W selection set end\n"
3936     "event generate %W <<ListboxSelect>>\n"
3937     "}\n"
3938     "bind Listbox <Shift-Control-End> {\n"
3939     "tkListboxDataExtend %W [%W index end]\n"
3940     "}\n"
3941     "bind Listbox <<Copy>> {\n"
3942     "if {[string equal [selection own -displayof %W] \"%W\"]} {\n"
3943     "clipboard clear -displayof %W\n"
3944     "clipboard append -displayof %W [selection get -displayof %W]\n"
3945     "}\n"
3946     "}\n"
3947     "bind Listbox <space> {\n"
3948     "tkListboxBeginSelect %W [%W index active]\n"
3949     "}\n"
3950     "bind Listbox <Select> {\n"
3951     "tkListboxBeginSelect %W [%W index active]\n"
3952     "}\n"
3953     "bind Listbox <Control-Shift-space> {\n"
3954     "tkListboxBeginExtend %W [%W index active]\n"
3955     "}\n"
3956     "bind Listbox <Shift-Select> {\n"
3957     "tkListboxBeginExtend %W [%W index active]\n"
3958     "}\n"
3959     "bind Listbox <Escape> {\n"
3960     "tkListboxCancel %W\n"
3961     "}\n"
3962     "bind Listbox <Control-slash> {\n"
3963     "tkListboxSelectAll %W\n"
3964     "}\n"
3965     "bind Listbox <Control-backslash> {\n"
3966     "if {[string compare [%W cget -selectmode] \"browse\"]} {\n"
3967     "%W selection clear 0 end\n"
3968     "event generate %W <<ListboxSelect>>\n"
3969     "}\n"
3970     "}\n"
3971     "bind Listbox <2> {\n"
3972     "%W scan mark %x %y\n"
3973     "}\n"
3974     "bind Listbox <B2-Motion> {\n"
3975     "%W scan dragto %x %y\n"
3976     "}\n"
3977     "bind Listbox <MouseWheel> {\n"
3978     "%W yview scroll [expr {- (%D / 120) * 4}] units\n"
3979     "}\n"
3980     "if {[string equal \"unix\" $tcl_platform(platform)]} {\n"
3981     "bind Listbox <4> {\n"
3982     "if {!$tk_strictMotif} {\n"
3983     "%W yview scroll -5 units\n"
3984     "}\n"
3985     "}\n"
3986     "bind Listbox <5> {\n"
3987     "if {!$tk_strictMotif} {\n"
3988     "%W yview scroll 5 units\n"
3989     "}\n"
3990     "}\n"
3991     "}\n"
3992     "proc tkListboxBeginSelect {w el} {\n"
3993     "global tkPriv\n"
3994     "if {[string equal [$w cget -selectmode] \"multiple\"]} {\n"
3995     "if {[$w selection includes $el]} {\n"
3996     "$w selection clear $el\n"
3997     "} else {\n"
3998     "$w selection set $el\n"
3999     "}\n"
4000     "} else {\n"
4001     "$w selection clear 0 end\n"
4002     "$w selection set $el\n"
4003     "$w selection anchor $el\n"
4004     "set tkPriv(listboxSelection) {}\n"
4005     "set tkPriv(listboxPrev) $el\n"
4006     "}\n"
4007     "event generate $w <<ListboxSelect>>\n"
4008     "}\n"
4009     "proc tkListboxMotion {w el} {\n"
4010     "global tkPriv\n"
4011     "if {$el == $tkPriv(listboxPrev)} {\n"
4012     "return\n"
4013     "}\n"
4014     "set anchor [$w index anchor]\n"
4015     "switch [$w cget -selectmode] {\n"
4016     "browse {\n"
4017     "$w selection clear 0 end\n"
4018     "$w selection set $el\n"
4019     "set tkPriv(listboxPrev) $el\n"
4020     "event generate $w <<ListboxSelect>>\n"
4021     "}\n"
4022     "extended {\n"
4023     "set i $tkPriv(listboxPrev)\n"
4024     "if {[string equal {} $i]} {\n"
4025     "set i $el\n"
4026     "$w selection set $el\n"
4027     "}\n"
4028     "if {[$w selection includes anchor]} {\n"
4029     "$w selection clear $i $el\n"
4030     "$w selection set anchor $el\n"
4031     "} else {\n"
4032     "$w selection clear $i $el\n"
4033     "$w selection clear anchor $el\n"
4034     "}\n"
4035     "if {![info exists tkPriv(listboxSelection)]} {\n"
4036     "set tkPriv(listboxSelection) [$w curselection]\n"
4037     "}\n"
4038     "while {($i < $el) && ($i < $anchor)} {\n"
4039     "if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {\n"
4040     "$w selection set $i\n"
4041     "}\n"
4042     "incr i\n"
4043     "}\n"
4044     "while {($i > $el) && ($i > $anchor)} {\n"
4045     "if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {\n"
4046     "$w selection set $i\n"
4047     "}\n"
4048     "incr i -1\n"
4049     "}\n"
4050     "set tkPriv(listboxPrev) $el\n"
4051     "event generate $w <<ListboxSelect>>\n"
4052     "}\n"
4053     "}\n"
4054     "}\n"
4055     "proc tkListboxBeginExtend {w el} {\n"
4056     "if {[string equal [$w cget -selectmode] \"extended\"]} {\n"
4057     "if {[$w selection includes anchor]} {\n"
4058     "tkListboxMotion $w $el\n"
4059     "} else {\n"
4060     "tkListboxBeginSelect $w $el\n"
4061     "}\n"
4062     "}\n"
4063     "}\n"
4064     "proc tkListboxBeginToggle {w el} {\n"
4065     "global tkPriv\n"
4066     "if {[string equal [$w cget -selectmode] \"extended\"]} {\n"
4067     "set tkPriv(listboxSelection) [$w curselection]\n"
4068     "set tkPriv(listboxPrev) $el\n"
4069     "$w selection anchor $el\n"
4070     "if {[$w selection includes $el]} {\n"
4071     "$w selection clear $el\n"
4072     "} else {\n"
4073     "$w selection set $el\n"
4074     "}\n"
4075     "event generate $w <<ListboxSelect>>\n"
4076     "}\n"
4077     "}\n"
4078     "proc tkListboxAutoScan {w} {\n"
4079     "global tkPriv\n"
4080     "if {![winfo exists $w]} return\n"
4081     "set x $tkPriv(x)\n"
4082     "set y $tkPriv(y)\n"
4083     "if {$y >= [winfo height $w]} {\n"
4084     "$w yview scroll 1 units\n"
4085     "} elseif {$y < 0} {\n"
4086     "$w yview scroll -1 units\n"
4087     "} elseif {$x >= [winfo width $w]} {\n"
4088     "$w xview scroll 2 units\n"
4089     "} elseif {$x < 0} {\n"
4090     "$w xview scroll -2 units\n"
4091     "} else {\n"
4092     "return\n"
4093     "}\n"
4094     "tkListboxMotion $w [$w index @$x,$y]\n"
4095     "set tkPriv(afterId) [after 50 [list tkListboxAutoScan $w]]\n"
4096     "}\n"
4097     "proc tkListboxUpDown {w amount} {\n"
4098     "global tkPriv\n"
4099     "$w activate [expr {[$w index active] + $amount}]\n"
4100     "$w see active\n"
4101     "switch [$w cget -selectmode] {\n"
4102     "browse {\n"
4103     "$w selection clear 0 end\n"
4104     "$w selection set active\n"
4105     "event generate $w <<ListboxSelect>>\n"
4106     "}\n"
4107     "extended {\n"
4108     "$w selection clear 0 end\n"
4109     "$w selection set active\n"
4110     "$w selection anchor active\n"
4111     "set tkPriv(listboxPrev) [$w index active]\n"
4112     "set tkPriv(listboxSelection) {}\n"
4113     "event generate $w <<ListboxSelect>>\n"
4114     "}\n"
4115     "}\n"
4116     "}\n"
4117     "proc tkListboxExtendUpDown {w amount} {\n"
4118     "if {[string compare [$w cget -selectmode] \"extended\"]} {\n"
4119     "return\n"
4120     "}\n"
4121     "set active [$w index active]\n"
4122     "if {![info exists tkPriv(listboxSelection)]} {\n"
4123     "global tkPriv\n"
4124     "$w selection set $active\n"
4125     "set tkPriv(listboxSelection) [$w curselection]\n"
4126     "}\n"
4127     "$w activate [expr {$active + $amount}]\n"
4128     "$w see active\n"
4129     "tkListboxMotion $w [$w index active]\n"
4130     "}\n"
4131     "proc tkListboxDataExtend {w el} {\n"
4132     "set mode [$w cget -selectmode]\n"
4133     "if {[string equal $mode \"extended\"]} {\n"
4134     "$w activate $el\n"
4135     "$w see $el\n"
4136     "if {[$w selection includes anchor]} {\n"
4137     "tkListboxMotion $w $el\n"
4138     "}\n"
4139     "} elseif {[string equal $mode \"multiple\"]} {\n"
4140     "$w activate $el\n"
4141     "$w see $el\n"
4142     "}\n"
4143     "}\n"
4144     "proc tkListboxCancel w {\n"
4145     "global tkPriv\n"
4146     "if {[string compare [$w cget -selectmode] \"extended\"]} {\n"
4147     "return\n"
4148     "}\n"
4149     "set first [$w index anchor]\n"
4150     "set last $tkPriv(listboxPrev)\n"
4151     "if { [string equal $last \"\"] } {\n"
4152     "return\n"
4153     "}\n"
4154     "if {$first > $last} {\n"
4155     "set tmp $first\n"
4156     "set first $last\n"
4157     "set last $tmp\n"
4158     "}\n"
4159     "$w selection clear $first $last\n"
4160     "while {$first <= $last} {\n"
4161     "if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {\n"
4162     "$w selection set $first\n"
4163     "}\n"
4164     "incr first\n"
4165     "}\n"
4166     "event generate $w <<ListboxSelect>>\n"
4167     "}\n"
4168     "proc tkListboxSelectAll w {\n"
4169     "set mode [$w cget -selectmode]\n"
4170     "if {[string equal $mode \"single\"] || [string equal $mode \"browse\"]} {\n"
4171     "$w selection clear 0 end\n"
4172     "$w selection set active\n"
4173     "} else {\n"
4174     "$w selection set 0 end\n"
4175     "}\n"
4176     "event generate $w <<ListboxSelect>>\n"
4177     "}\n"
4178     ;
4179     static char Et_zFile17[] =
4180     "bind Menubutton <FocusIn> {}\n"
4181     "bind Menubutton <Enter> {\n"
4182     "tkMbEnter %W\n"
4183     "}\n"
4184     "bind Menubutton <Leave> {\n"
4185     "tkMbLeave %W\n"
4186     "}\n"
4187     "bind Menubutton <1> {\n"
4188     "if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
4189     "tkMbPost $tkPriv(inMenubutton) %X %Y\n"
4190     "}\n"
4191     "}\n"
4192     "bind Menubutton <Motion> {\n"
4193     "tkMbMotion %W up %X %Y\n"
4194     "}\n"
4195     "bind Menubutton <B1-Motion> {\n"
4196     "tkMbMotion %W down %X %Y\n"
4197     "}\n"
4198     "bind Menubutton <ButtonRelease-1> {\n"
4199     "tkMbButtonUp %W\n"
4200     "}\n"
4201     "bind Menubutton <space> {\n"
4202     "tkMbPost %W\n"
4203     "tkMenuFirstEntry [%W cget -menu]\n"
4204     "}\n"
4205     "bind Menu <FocusIn> {}\n"
4206     "bind Menu <Enter> {\n"
4207     "set tkPriv(window) %W\n"
4208     "if {[string equal [%W cget -type] \"tearoff\"]} {\n"
4209     "if {[string compare \"%m\" \"NotifyUngrab\"]} {\n"
4210     "if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
4211     "tk_menuSetFocus %W\n"
4212     "}\n"
4213     "}\n"
4214     "}\n"
4215     "tkMenuMotion %W %x %y %s\n"
4216     "}\n"
4217     "bind Menu <Leave> {\n"
4218     "tkMenuLeave %W %X %Y %s\n"
4219     "}\n"
4220     "bind Menu <Motion> {\n"
4221     "tkMenuMotion %W %x %y %s\n"
4222     "}\n"
4223     "bind Menu <ButtonPress> {\n"
4224     "tkMenuButtonDown %W\n"
4225     "}\n"
4226     "bind Menu <ButtonRelease> {\n"
4227     "tkMenuInvoke %W 1\n"
4228     "}\n"
4229     "bind Menu <space> {\n"
4230     "tkMenuInvoke %W 0\n"
4231     "}\n"
4232     "bind Menu <Return> {\n"
4233     "tkMenuInvoke %W 0\n"
4234     "}\n"
4235     "bind Menu <Escape> {\n"
4236     "tkMenuEscape %W\n"
4237     "}\n"
4238     "bind Menu <Left> {\n"
4239     "tkMenuLeftArrow %W\n"
4240     "}\n"
4241     "bind Menu <Right> {\n"
4242     "tkMenuRightArrow %W\n"
4243     "}\n"
4244     "bind Menu <Up> {\n"
4245     "tkMenuUpArrow %W\n"
4246     "}\n"
4247     "bind Menu <Down> {\n"
4248     "tkMenuDownArrow %W\n"
4249     "}\n"
4250     "bind Menu <KeyPress> {\n"
4251     "tkTraverseWithinMenu %W %A\n"
4252     "}\n"
4253     "if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
4254     "bind all <Alt-KeyPress> {\n"
4255     "tkTraverseToMenu %W %A\n"
4256     "}\n"
4257     "bind all <F10> {\n"
4258     "tkFirstMenu %W\n"
4259     "}\n"
4260     "} else {\n"
4261     "bind Menubutton <Alt-KeyPress> {\n"
4262     "tkTraverseToMenu %W %A\n"
4263     "}\n"
4264     "bind Menubutton <F10> {\n"
4265     "tkFirstMenu %W\n"
4266     "}\n"
4267     "}\n"
4268     "proc tkMbEnter w {\n"
4269     "global tkPriv\n"
4270     "if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
4271     "tkMbLeave $tkPriv(inMenubutton)\n"
4272     "}\n"
4273     "set tkPriv(inMenubutton) $w\n"
4274     "if {[string compare [$w cget -state] \"disabled\"]} {\n"
4275     "$w configure -state active\n"
4276     "}\n"
4277     "}\n"
4278     "proc tkMbLeave w {\n"
4279     "global tkPriv\n"
4280     "set tkPriv(inMenubutton) {}\n"
4281     "if {![winfo exists $w]} {\n"
4282     "return\n"
4283     "}\n"
4284     "if {[string equal [$w cget -state] \"active\"]} {\n"
4285     "$w configure -state normal\n"
4286     "}\n"
4287     "}\n"
4288     "proc tkMbPost {w {x {}} {y {}}} {\n"
4289     "global tkPriv errorInfo\n"
4290     "global tcl_platform\n"
4291     "if {[string equal [$w cget -state] \"disabled\"] || \\\n"
4292     "\011 [string equal $w $tkPriv(postedMb)]} {\n"
4293     "return\n"
4294     "}\n"
4295     "set menu [$w cget -menu]\n"
4296     "if {[string equal $menu \"\"]} {\n"
4297     "return\n"
4298     "}\n"
4299     "set tearoff [expr {[string equal $tcl_platform(platform) \"unix\"] \\\n"
4300     "\011 || [string equal [$menu cget -type] \"tearoff\"]}]\n"
4301     "if {[string first $w $menu] != 0} {\n"
4302     "error \"can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)\"\n"
4303     "}\n"
4304     "set cur $tkPriv(postedMb)\n"
4305     "if {[string compare $cur \"\"]} {\n"
4306     "tkMenuUnpost {}\n"
4307     "}\n"
4308     "set tkPriv(cursor) [$w cget -cursor]\n"
4309     "set tkPriv(relief) [$w cget -relief]\n"
4310     "$w configure -cursor arrow\n"
4311     "$w configure -relief raised\n"
4312     "set tkPriv(postedMb) $w\n"
4313     "set tkPriv(focus) [focus]\n"
4314     "$menu activate none\n"
4315     "tkGenerateMenuSelect $menu\n"
4316     "update idletasks\n"
4317     "if {[catch {\n"
4318     "switch [$w cget -direction] {\n"
4319     "above {\n"
4320     "set x [winfo rootx $w]\n"
4321     "set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]\n"
4322     "$menu post $x $y\n"
4323     "}\n"
4324     "below {\n"
4325     "set x [winfo rootx $w]\n"
4326     "set y [expr {[winfo rooty $w] + [winfo height $w]}]\n"
4327     "$menu post $x $y\n"
4328     "}\n"
4329     "left {\n"
4330     "set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]\n"
4331     "set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]\n"
4332     "set entry [tkMenuFindName $menu [$w cget -text]]\n"
4333     "if {[$w cget -indicatoron]} {\n"
4334     "if {$entry == [$menu index last]} {\n"
4335     "incr y [expr {-([$menu yposition $entry] \\\n"
4336     "\011\011\011 \011+ [winfo reqheight $menu])/2}]\n"
4337     "} else {\n"
4338     "incr y [expr {-([$menu yposition $entry] \\\n"
4339     "\011\011\011 + [$menu yposition [expr {$entry+1}]])/2}]\n"
4340     "}\n"
4341     "}\n"
4342     "$menu post $x $y\n"
4343     "if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] \"disabled\"]} {\n"
4344     "$menu activate $entry\n"
4345     "tkGenerateMenuSelect $menu\n"
4346     "}\n"
4347     "}\n"
4348     "right {\n"
4349     "set x [expr {[winfo rootx $w] + [winfo width $w]}]\n"
4350     "set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]\n"
4351     "set entry [tkMenuFindName $menu [$w cget -text]]\n"
4352     "if {[$w cget -indicatoron]} {\n"
4353     "if {$entry == [$menu index last]} {\n"
4354     "incr y [expr {-([$menu yposition $entry] \\\n"
4355     "\011\011\011 \011+ [winfo reqheight $menu])/2}]\n"
4356     "} else {\n"
4357     "incr y [expr {-([$menu yposition $entry] \\\n"
4358     "\011\011\011 + [$menu yposition [expr {$entry+1}]])/2}]\n"
4359     "}\n"
4360     "}\n"
4361     "$menu post $x $y\n"
4362     "if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] \"disabled\"]} {\n"
4363     "$menu activate $entry\n"
4364     "tkGenerateMenuSelect $menu\n"
4365     "}\n"
4366     "}\n"
4367     "default {\n"
4368     "if {[$w cget -indicatoron]} {\n"
4369     "if {[string equal $y {}]} {\n"
4370     "set x [expr {[winfo rootx $w] + [winfo width $w]/2}]\n"
4371     "set y [expr {[winfo rooty $w] + [winfo height $w]/2}]\n"
4372     "}\n"
4373     "tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]\n"
4374     "} else {\n"
4375     "$menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]\n"
4376     "} \n"
4377     "}\n"
4378     "}\n"
4379     "} msg]} {\n"
4380     "set savedInfo $errorInfo\n"
4381     "tkMenuUnpost {}\n"
4382     "error $msg $savedInfo\n"
4383     "}\n"
4384     "set tkPriv(tearoff) $tearoff\n"
4385     "if {$tearoff != 0} {\n"
4386     "focus $menu\n"
4387     "if {[winfo viewable $w]} {\n"
4388     "tkSaveGrabInfo $w\n"
4389     "grab -global $w\n"
4390     "}\n"
4391     "}\n"
4392     "}\n"
4393     "proc tkMenuUnpost menu {\n"
4394     "global tcl_platform\n"
4395     "global tkPriv\n"
4396     "set mb $tkPriv(postedMb)\n"
4397     "catch {focus $tkPriv(focus)}\n"
4398     "set tkPriv(focus) \"\"\n"
4399     "catch {\n"
4400     "if {[string compare $mb \"\"]} {\n"
4401     "set menu [$mb cget -menu]\n"
4402     "$menu unpost\n"
4403     "set tkPriv(postedMb) {}\n"
4404     "$mb configure -cursor $tkPriv(cursor)\n"
4405     "$mb configure -relief $tkPriv(relief)\n"
4406     "} elseif {[string compare $tkPriv(popup) \"\"]} {\n"
4407     "$tkPriv(popup) unpost\n"
4408     "set tkPriv(popup) {}\n"
4409     "} elseif {[string compare [$menu cget -type] \"menubar\"] \\\n"
4410     "\011\011&& [string compare [$menu cget -type] \"tearoff\"]} {\n"
4411     "while {1} {\n"
4412     "set parent [winfo parent $menu]\n"
4413     "if {[string compare [winfo class $parent] \"Menu\"] \\\n"
4414     "\011\011\011|| ![winfo ismapped $parent]} {\n"
4415     "break\n"
4416     "}\n"
4417     "$parent activate none\n"
4418     "$parent postcascade none\n"
4419     "tkGenerateMenuSelect $parent\n"
4420     "set type [$parent cget -type]\n"
4421     "if {[string equal $type \"menubar\"] || \\\n"
4422     "\011\011\011[string equal $type \"tearoff\"]} {\n"
4423     "break\n"
4424     "}\n"
4425     "set menu $parent\n"
4426     "}\n"
4427     "if {[string compare [$menu cget -type] \"menubar\"]} {\n"
4428     "$menu unpost\n"
4429     "}\n"
4430     "}\n"
4431     "}\n"
4432     "if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) \"\"]} {\n"
4433     "if {[string compare $menu \"\"]} {\n"
4434     "set grab [grab current $menu]\n"
4435     "if {[string compare $grab \"\"]} {\n"
4436     "grab release $grab\n"
4437     "}\n"
4438     "}\n"
4439     "tkRestoreOldGrab\n"
4440     "if {[string compare $tkPriv(menuBar) \"\"]} {\n"
4441     "$tkPriv(menuBar) configure -cursor $tkPriv(cursor)\n"
4442     "set tkPriv(menuBar) {}\n"
4443     "}\n"
4444     "if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
4445     "set tkPriv(tearoff) 0\n"
4446     "}\n"
4447     "}\n"
4448     "}\n"
4449     "proc tkMbMotion {w upDown rootx rooty} {\n"
4450     "global tkPriv\n"
4451     "if {[string equal $tkPriv(inMenubutton) $w]} {\n"
4452     "return\n"
4453     "}\n"
4454     "set new [winfo containing $rootx $rooty]\n"
4455     "if {[string compare $new $tkPriv(inMenubutton)] \\\n"
4456     "\011 && ([string equal $new \"\"] \\\n"
4457     "\011 || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {\n"
4458     "if {[string compare $tkPriv(inMenubutton) \"\"]} {\n"
4459     "tkMbLeave $tkPriv(inMenubutton)\n"
4460     "}\n"
4461     "if {[string compare $new \"\"] \\\n"
4462     "\011\011&& [string equal [winfo class $new] \"Menubutton\"] \\\n"
4463     "\011\011&& ([$new cget -indicatoron] == 0) \\\n"
4464     "\011\011&& ([$w cget -indicatoron] == 0)} {\n"
4465     "if {[string equal $upDown \"down\"]} {\n"
4466     "tkMbPost $new $rootx $rooty\n"
4467     "} else {\n"
4468     "tkMbEnter $new\n"
4469     "}\n"
4470     "}\n"
4471     "}\n"
4472     "}\n"
4473     "proc tkMbButtonUp w {\n"
4474     "global tkPriv\n"
4475     "global tcl_platform\n"
4476     "set menu [$w cget -menu]\n"
4477     "set tearoff [expr {[string equal $tcl_platform(platform) \"unix\"] || \\\n"
4478     "\011 ([string compare $menu {}] && \\\n"
4479     "\011 [string equal [$menu cget -type] \"tearoff\"])}]\n"
4480     "if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \\\n"
4481     "\011 && [string equal $tkPriv(inMenubutton) $w]} {\n"
4482     "tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]\n"
4483     "} else {\n"
4484     "tkMenuUnpost {}\n"
4485     "}\n"
4486     "}\n"
4487     "proc tkMenuMotion {menu x y state} {\n"
4488     "global tkPriv\n"
4489     "if {[string equal $menu $tkPriv(window)]} {\n"
4490     "if {[string equal [$menu cget -type] \"menubar\"]} {\n"
4491     "if {[info exists tkPriv(focus)] && \\\n"
4492     "\011\011 [string compare $menu $tkPriv(focus)]} {\n"
4493     "$menu activate @$x,$y\n"
4494     "tkGenerateMenuSelect $menu\n"
4495     "}\n"
4496     "} else {\n"
4497     "$menu activate @$x,$y\n"
4498     "tkGenerateMenuSelect $menu\n"
4499     "}\n"
4500     "}\n"
4501     "if {($state & 0x1f00) != 0} {\n"
4502     "$menu postcascade active\n"
4503     "}\n"
4504     "}\n"
4505     "proc tkMenuButtonDown menu {\n"
4506     "global tkPriv\n"
4507     "global tcl_platform\n"
4508     "if {![winfo viewable $menu]} {\n"
4509     "return\n"
4510     "}\n"
4511     "$menu postcascade active\n"
4512     "if {[string compare $tkPriv(postedMb) \"\"] && \\\n"
4513     "\011 [winfo viewable $tkPriv(postedMb)]} {\n"
4514     "grab -global $tkPriv(postedMb)\n"
4515     "} else {\n"
4516     "while {[string equal [$menu cget -type] \"normal\"] \\\n"
4517     "\011\011&& [string equal [winfo class [winfo parent $menu]] \"Menu\"] \\\n"
4518     "\011\011&& [winfo ismapped [winfo parent $menu]]} {\n"
4519     "set menu [winfo parent $menu]\n"
4520     "}\n"
4521     "if {[string equal $tkPriv(menuBar) {}]} {\n"
4522     "set tkPriv(menuBar) $menu\n"
4523     "set tkPriv(cursor) [$menu cget -cursor]\n"
4524     "$menu configure -cursor arrow\n"
4525     "}\n"
4526     "if {[string compare $menu [grab current $menu]]} {\n"
4527     "tkSaveGrabInfo $menu\n"
4528     "}\n"
4529     "if {[string equal $tcl_platform(platform) \"unix\"]} {\n"
4530     "grab -global $menu\n"
4531     "}\n"
4532     "}\n"
4533     "}\n"
4534     "proc tkMenuLeave {menu rootx rooty state} {\n"
4535     "global tkPriv\n"
4536     "set tkPriv(window) {}\n"
4537     "if {[string equal [$menu index active] \"none\"]} {\n"
4538     "return\n"
4539     "}\n"
4540     "if {[string equal [$menu type active] \"cascade\"]\n"
4541     "&& [string equal [winfo containing $rootx $rooty] \\\n"
4542     " [$menu entrycget active -menu]]} {\n"
4543     "return\n"
4544     "}\n"
4545     "$menu activate none\n"
4546     "tkGenerateMenuSelect $menu\n"
4547     "}\n"
4548     "proc tkMenuInvoke {w buttonRelease} {\n"
4549     "global tkPriv\n"
4550     "if {$buttonRelease && [string equal $tkPriv(window) {}]} {\n"
4551     "$w postcascade none\n"
4552     "$w activate none\n"
4553     "event generate $w <<MenuSelect>>\n"
4554     "tkMenuUnpost $w\n"
4555     "return\n"
4556     "}\n"
4557     "if {[string equal [$w type active] \"cascade\"]} {\n"
4558     "$w postcascade active\n"
4559     "set menu [$w entrycget active -menu]\n"
4560     "tkMenuFirstEntry $menu\n"
4561     "} elseif {[string equal [$w type active] \"tearoff\"]} {\n"
4562     "tkTearOffMenu $w\n"
4563     "tkMenuUnpost $w\n"
4564     "} elseif {[string equal [$w cget -type] \"menubar\"]} {\n"
4565     "$w postcascade none\n"
4566     "set active [$w index active]\n"
4567     "set isCascade [string equal [$w type $active] \"cascade\"]\n"
4568     "if { $isCascade } {\n"
4569     "$w activate none\n"
4570     "event generate $w <<MenuSelect>>\n"
4571     "}\n"
4572     "tkMenuUnpost $w\n"
4573     "if { !$isCascade } {\n"
4574     "uplevel #0 [list $w invoke $active]\n"
4575     "}\n"
4576     "} else {\n"
4577     "tkMenuUnpost $w\n"
4578     "uplevel #0 [list $w invoke active]\n"
4579     "}\n"
4580     "}\n"
4581     "proc tkMenuEscape menu {\n"
4582     "set parent [winfo parent $menu]\n"
4583     "if {[string compare [winfo class $parent] \"Menu\"]} {\n"
4584     "tkMenuUnpost $menu\n"
4585     "} elseif {[string equal [$parent cget -type] \"menubar\"]} {\n"
4586     "tkMenuUnpost $menu\n"
4587     "tkRestoreOldGrab\n"
4588     "} else {\n"
4589     "tkMenuNextMenu $menu left\n"
4590     "}\n"
4591     "}\n"
4592     "proc tkMenuUpArrow {menu} {\n"
4593     "if {[string equal [$menu cget -type] \"menubar\"]} {\n"
4594     "tkMenuNextMenu $menu left\n"
4595     "} else {\n"
4596     "tkMenuNextEntry $menu -1\n"
4597     "}\n"
4598     "}\n"
4599     "proc tkMenuDownArrow {menu} {\n"
4600     "if {[string equal [$menu cget -type] \"menubar\"]} {\n"
4601     "tkMenuNextMenu $menu right\n"
4602     "} else {\n"
4603     "tkMenuNextEntry $menu 1\n"
4604     "}\n"
4605     "}\n"
4606     "proc tkMenuLeftArrow {menu} {\n"
4607     "if {[string equal [$menu cget -type] \"menubar\"]} {\n"
4608     "tkMenuNextEntry $menu -1\n"
4609     "} else {\n"
4610     "tkMenuNextMenu $menu left\n"
4611     "}\n"
4612     "}\n"
4613     "proc tkMenuRightArrow {menu} {\n"
4614     "if {[string equal [$menu cget -type] \"menubar\"]} {\n"
4615     "tkMenuNextEntry $menu 1\n"
4616     "} else {\n"
4617     "tkMenuNextMenu $menu right\n"
4618     "}\n"
4619     "}\n"
4620     "proc tkMenuNextMenu {menu direction} {\n"
4621     "global tkPriv\n"
4622     "if {[string equal $direction \"right\"]} {\n"
4623     "set count 1\n"
4624     "set parent [winfo parent $menu]\n"
4625     "set class [winfo class $parent]\n"
4626     "if {[string equal [$menu type active] \"cascade\"]} {\n"
4627     "$menu postcascade active\n"
4628     "set m2 [$menu entrycget active -menu]\n"
4629     "if {[string compare $m2 \"\"]} {\n"
4630     "tkMenuFirstEntry $m2\n"
4631     "}\n"
4632     "return\n"
4633     "} else {\n"
4634     "set parent [winfo parent $menu]\n"
4635     "while {[string compare $parent \".\"]} {\n"
4636     "if {[string equal [winfo class $parent] \"Menu\"] \\\n"
4637     "\011\011\011&& [string equal [$parent cget -type] \"menubar\"]} {\n"
4638     "tk_menuSetFocus $parent\n"
4639     "tkMenuNextEntry $parent 1\n"
4640     "return\n"
4641     "}\n"
4642     "set parent [winfo parent $parent]\n"
4643     "}\n"
4644     "}\n"
4645     "} else {\n"
4646     "set count -1\n"
4647     "set m2 [winfo parent $menu]\n"
4648     "if {[string equal [winfo class $m2] \"Menu\"]} {\n"
4649     "if {[string compare [$m2 cget -type] \"menubar\"]} {\n"
4650     "$menu activate none\n"
4651     "tkGenerateMenuSelect $menu\n"
4652     "tk_menuSetFocus $m2\n"
4653     "set tmp [$m2 index active]\n"
4654     "$m2 activate none\n"
4655     "$m2 activate $tmp\n"
4656     "return\n"
4657     "}\n"
4658     "}\n"
4659     "}\n"
4660     "set m2 [winfo parent $menu]\n"
4661     "if {[string equal [winfo class $m2] \"Menu\"]} {\n"
4662     "if {[string equal [$m2 cget -type] \"menubar\"]} {\n"
4663     "tk_menuSetFocus $m2\n"
4664     "tkMenuNextEntry $m2 -1\n"
4665     "return\n"
4666     "}\n"
4667     "}\n"
4668     "set w $tkPriv(postedMb)\n"
4669     "if {[string equal $w \"\"]} {\n"
4670     "return\n"
4671     "}\n"
4672     "set buttons [winfo children [winfo parent $w]]\n"
4673     "set length [llength $buttons]\n"
4674     "set i [expr {[lsearch -exact $buttons $w] + $count}]\n"
4675     "while {1} {\n"
4676     "while {$i < 0} {\n"
4677     "incr i $length\n"
4678     "}\n"
4679     "while {$i >= $length} {\n"
4680     "incr i -$length\n"
4681     "}\n"
4682     "set mb [lindex $buttons $i]\n"
4683     "if {[string equal [winfo class $mb] \"Menubutton\"] \\\n"
4684     "\011\011&& [string compare [$mb cget -state] \"disabled\"] \\\n"
4685     "\011\011&& [string compare [$mb cget -menu] \"\"] \\\n"
4686     "\011\011&& [string compare [[$mb cget -menu] index last] \"none\"]} {\n"
4687     "break\n"
4688     "}\n"
4689     "if {[string equal $mb $w]} {\n"
4690     "return\n"
4691     "}\n"
4692     "incr i $count\n"
4693     "}\n"
4694     "tkMbPost $mb\n"
4695     "tkMenuFirstEntry [$mb cget -menu]\n"
4696     "}\n"
4697     "proc tkMenuNextEntry {menu count} {\n"
4698     "global tkPriv\n"
4699     "if {[string equal [$menu index last] \"none\"]} {\n"
4700     "return\n"
4701     "}\n"
4702     "set length [expr {[$menu index last]+1}]\n"
4703     "set quitAfter $length\n"
4704     "set active [$menu index active]\n"
4705     "if {[string equal $active \"none\"]} {\n"
4706     "set i 0\n"
4707     "} else {\n"
4708     "set i [expr {$active + $count}]\n"
4709     "}\n"
4710     "while {1} {\n"
4711     "if {$quitAfter <= 0} {\n"
4712     "return\n"
4713     "}\n"
4714     "while {$i < 0} {\n"
4715     "incr i $length\n"
4716     "}\n"
4717     "while {$i >= $length} {\n"
4718     "incr i -$length\n"
4719     "}\n"
4720     "if {[catch {$menu entrycget $i -state} state] == 0} {\n"
4721     "if {[string compare $state \"disabled\"]} {\n"
4722     "break\n"
4723     "}\n"
4724     "}\n"
4725     "if {$i == $active} {\n"
4726     "return\n"
4727     "}\n"
4728     "incr i $count\n"
4729     "incr quitAfter -1\n"
4730     "}\n"
4731     "$menu activate $i\n"
4732     "tkGenerateMenuSelect $menu\n"
4733     "if {[string equal [$menu type $i] \"cascade\"]} {\n"
4734     "set cascade [$menu entrycget $i -menu]\n"
4735     "if {[string compare $cascade \"\"]} {\n"
4736     "$menu postcascade $i\n"
4737     "tkMenuFirstEntry $cascade\n"
4738     "}\n"
4739     "}\n"
4740     "}\n"
4741     "proc tkMenuFind {w char} {\n"
4742     "global tkPriv\n"
4743     "set char [string tolower $char]\n"
4744     "set windowlist [winfo child $w]\n"
4745     "foreach child $windowlist {\n"
4746     "if {[string compare [winfo toplevel [focus]] \\\n"
4747     "\011\011[winfo toplevel $child]]} {\n"
4748     "continue\n"
4749     "}\n"
4750     "if {[string equal [winfo class $child] \"Menu\"] && \\\n"
4751     "\011\011[string equal [$child cget -type] \"menubar\"]} {\n"
4752     "if {[string equal $char \"\"]} {\n"
4753     "return $child\n"
4754     "}\n"
4755     "set last [$child index last]\n"
4756     "for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {\n"
4757     "if {[string equal [$child type $i] \"separator\"]} {\n"
4758     "continue\n"
4759     "}\n"
4760     "set char2 [string index [$child entrycget $i -label] \\\n"
4761     "\011\011\011[$child entrycget $i -underline]]\n"
4762     "if {[string equal $char [string tolower $char2]] \\\n"
4763     "\011\011\011|| [string equal $char \"\"]} {\n"
4764     "if {[string compare [$child entrycget $i -state] \"disabled\"]} {\n"
4765     "return $child\n"
4766     "}\n"
4767     "}\n"
4768     "}\n"
4769     "}\n"
4770     "}\n"
4771     "foreach child $windowlist {\n"
4772     "if {[string compare [winfo toplevel [focus]] \\\n"
4773     "\011\011[winfo toplevel $child]]} {\n"
4774     "continue\n"
4775     "}\n"
4776     "switch [winfo class $child] {\n"
4777     "Menubutton {\n"
4778     "set char2 [string index [$child cget -text] \\\n"
4779     "\011\011\011[$child cget -underline]]\n"
4780     "if {[string equal $char [string tolower $char2]] \\\n"
4781     "\011\011\011|| [string equal $char \"\"]} {\n"
4782     "if {[string compare [$child cget -state] \"disabled\"]} {\n"
4783     "return $child\n"
4784     "}\n"
4785     "}\n"
4786     "}\n"
4787     "default {\n"
4788     "set match [tkMenuFind $child $char]\n"
4789     "if {[string compare $match \"\"]} {\n"
4790     "return $match\n"
4791     "}\n"
4792     "}\n"
4793     "}\n"
4794     "}\n"
4795     "return {}\n"
4796     "}\n"
4797     "proc tkTraverseToMenu {w char} {\n"
4798     "global tkPriv\n"
4799     "if {[string equal $char \"\"]} {\n"
4800     "return\n"
4801     "}\n"
4802     "while {[string equal [winfo class $w] \"Menu\"]} {\n"
4803     "if {[string compare [$w cget -type] \"menubar\"] \\\n"
4804     "\011\011&& [string equal $tkPriv(postedMb) \"\"]} {\n"
4805     "return\n"
4806     "}\n"
4807     "if {[string equal [$w cget -type] \"menubar\"]} {\n"
4808     "break\n"
4809     "}\n"
4810     "set w [winfo parent $w]\n"
4811     "}\n"
4812     "set w [tkMenuFind [winfo toplevel $w] $char]\n"
4813     "if {[string compare $w \"\"]} {\n"
4814     "if {[string equal [winfo class $w] \"Menu\"]} {\n"
4815     "tk_menuSetFocus $w\n"
4816     "set tkPriv(window) $w\n"
4817     "tkSaveGrabInfo $w\n"
4818     "grab -global $w\n"
4819     "tkTraverseWithinMenu $w $char\n"
4820     "} else {\n"
4821     "tkMbPost $w\n"
4822     "tkMenuFirstEntry [$w cget -menu]\n"
4823     "}\n"
4824     "}\n"
4825     "}\n"
4826     "proc tkFirstMenu w {\n"
4827     "set w [tkMenuFind [winfo toplevel $w] \"\"]\n"
4828     "if {[string compare $w \"\"]} {\n"
4829     "if {[string equal [winfo class $w] \"Menu\"]} {\n"
4830     "tk_menuSetFocus $w\n"
4831     "set tkPriv(window) $w\n"
4832     "tkSaveGrabInfo $w\n"
4833     "grab -global $w\n"
4834     "tkMenuFirstEntry $w\n"
4835     "} else {\n"
4836     "tkMbPost $w\n"
4837     "tkMenuFirstEntry [$w cget -menu]\n"
4838     "}\n"
4839     "}\n"
4840     "}\n"
4841     "proc tkTraverseWithinMenu {w char} {\n"
4842     "if {[string equal $char \"\"]} {\n"
4843     "return\n"
4844     "}\n"
4845     "set char [string tolower $char]\n"
4846     "set last [$w index last]\n"
4847     "if {[string equal $last \"none\"]} {\n"
4848     "return\n"
4849     "}\n"
4850     "for {set i 0} {$i <= $last} {incr i} {\n"
4851     "if {[catch {set char2 [string index \\\n"
4852     "\011\011[$w entrycget $i -label] [$w entrycget $i -underline]]}]} {\n"
4853     "continue\n"
4854     "}\n"
4855     "if {[string equal $char [string tolower $char2]]} {\n"
4856     "if {[string equal [$w type $i] \"cascade\"]} {\n"
4857     "$w activate $i\n"
4858     "$w postcascade active\n"
4859     "event generate $w <<MenuSelect>>\n"
4860     "set m2 [$w entrycget $i -menu]\n"
4861     "if {[string compare $m2 \"\"]} {\n"
4862     "tkMenuFirstEntry $m2\n"
4863     "}\n"
4864     "} else {\n"
4865     "tkMenuUnpost $w\n"
4866     "uplevel #0 [list $w invoke $i]\n"
4867     "}\n"
4868     "return\n"
4869     "}\n"
4870     "}\n"
4871     "}\n"
4872     "proc tkMenuFirstEntry menu {\n"
4873     "if {[string equal $menu \"\"]} {\n"
4874     "return\n"
4875     "}\n"
4876     "tk_menuSetFocus $menu\n"
4877     "if {[string compare [$menu index active] \"none\"]} {\n"
4878     "return\n"
4879     "}\n"
4880     "set last [$menu index last]\n"
4881     "if {[string equal $last \"none\"]} {\n"
4882     "return\n"
4883     "}\n"
4884     "for {set i 0} {$i <= $last} {incr i} {\n"
4885     "if {([catch {set state [$menu entrycget $i -state]}] == 0) \\\n"
4886     "\011\011&& [string compare $state \"disabled\"] \\\n"
4887     "\011\011&& [string compare [$menu type $i] \"tearoff\"]} {\n"
4888     "$menu activate $i\n"
4889     "tkGenerateMenuSelect $menu\n"
4890     "if {[string equal [$menu type $i] \"cascade\"] && \\\n"
4891     "\011\011[string equal [$menu cget -type] \"menubar\"]} {\n"
4892     "set cascade [$menu entrycget $i -menu]\n"
4893     "if {[string compare $cascade \"\"]} {\n"
4894     "$menu postcascade $i\n"
4895     "tkMenuFirstEntry $cascade\n"
4896     "}\n"
4897     "}\n"
4898     "return\n"
4899     "}\n"
4900     "}\n"
4901     "}\n"
4902     "proc tkMenuFindName {menu s} {\n"
4903     "set i \"\"\n"
4904     "if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {\n"
4905     "catch {set i [$menu index $s]}\n"
4906     "return $i\n"
4907     "}\n"
4908     "set last [$menu index last]\n"
4909     "if {[string equal $last \"none\"]} {\n"
4910     "return\n"
4911     "}\n"
4912     "for {set i 0} {$i <= $last} {incr i} {\n"
4913     "if {![catch {$menu entrycget $i -label} label]} {\n"
4914     "if {[string equal $label $s]} {\n"
4915     "return $i\n"
4916     "}\n"
4917     "}\n"
4918     "}\n"
4919     "return \"\"\n"
4920     "}\n"
4921     "proc tkPostOverPoint {menu x y {entry {}}} {\n"
4922     "global tcl_platform\n"
4923     "if {[string compare $entry {}]} {\n"
4924     "if {$entry == [$menu index last]} {\n"
4925     "incr y [expr {-([$menu yposition $entry] \\\n"
4926     "\011\011 + [winfo reqheight $menu])/2}]\n"
4927     "} else {\n"
4928     "incr y [expr {-([$menu yposition $entry] \\\n"
4929     "\011\011 + [$menu yposition [expr {$entry+1}]])/2}]\n"
4930     "}\n"
4931     "incr x [expr {-[winfo reqwidth $menu]/2}]\n"
4932     "}\n"
4933     "$menu post $x $y\n"
4934     "if {[string compare $entry {}] \\\n"
4935     "\011 && [string compare [$menu entrycget $entry -state] \"disabled\"]} {\n"
4936     "$menu activate $entry\n"
4937     "tkGenerateMenuSelect $menu\n"
4938     "}\n"
4939     "}\n"
4940     "proc tkSaveGrabInfo w {\n"
4941     "global tkPriv\n"
4942     "set tkPriv(oldGrab) [grab current $w]\n"
4943     "if {[string compare $tkPriv(oldGrab) \"\"]} {\n"
4944     "set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]\n"
4945     "}\n"
4946     "}\n"
4947     "proc tkRestoreOldGrab {} {\n"
4948     "global tkPriv\n"
4949     "if {[string compare $tkPriv(oldGrab) \"\"]} {\n"
4950     "catch {\n"
4951     "if {[string equal $tkPriv(grabStatus) \"global\"]} {\n"
4952     "grab set -global $tkPriv(oldGrab)\n"
4953     "} else {\n"
4954     "grab set $tkPriv(oldGrab)\n"
4955     "}\n"
4956     "}\n"
4957     "set tkPriv(oldGrab) \"\"\n"
4958     "}\n"
4959     "}\n"
4960     "proc tk_menuSetFocus {menu} {\n"
4961     "global tkPriv\n"
4962     "if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} {\n"
4963     "set tkPriv(focus) [focus]\n"
4964     "}\n"
4965     "focus $menu\n"
4966     "}\n"
4967     "proc tkGenerateMenuSelect {menu} {\n"
4968     "global tkPriv\n"
4969     "if {[string equal $tkPriv(activeMenu) $menu] \\\n"
4970     " && [string equal $tkPriv(activeItem) [$menu index active]]} {\n"
4971     "return\n"
4972     "}\n"
4973     "set tkPriv(activeMenu) $menu\n"
4974     "set tkPriv(activeItem) [$menu index active]\n"
4975     "event generate $menu <<MenuSelect>>\n"
4976     "}\n"
4977     "proc tk_popup {menu x y {entry {}}} {\n"
4978     "global tkPriv\n"
4979     "global tcl_platform\n"
4980     "if {[string compare $tkPriv(popup) \"\"] \\\n"
4981     "\011 || [string compare $tkPriv(postedMb) \"\"]} {\n"
4982     "tkMenuUnpost {}\n"
4983     "}\n"
4984     "tkPostOverPoint $menu $x $y $entry\n"
4985     "if {[string equal $tcl_platform(platform) \"unix\"] \\\n"
4986     "\011 && [winfo viewable $menu]} {\n"
4987     "tkSaveGrabInfo $menu\n"
4988     "grab -global $menu\n"
4989     "set tkPriv(popup) $menu\n"
4990     "tk_menuSetFocus $menu\n"
4991     "}\n"
4992     "}\n"
4993     ;
4994     static char Et_zFile18[] =
4995     "namespace eval ::tk::dialog {}\n"
4996     "image create bitmap ::tk::dialog::b1 -foreground black \\\n"
4997     "-data \"#define b1_width 32\\n#define b1_height 32\n"
4998     "static unsigned char q1_bits[] = {\n"
4999     "0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,\n"
5000     "0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,\n"
5001     "0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,\n"
5002     "0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,\n"
5003     "0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,\n"
5004     "0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,\n"
5005     "0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,\n"
5006     "0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,\n"
5007     "0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,\n"
5008     "0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,\n"
5009     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
5010     "image create bitmap ::tk::dialog::b2 -foreground white \\\n"
5011     "-data \"#define b2_width 32\\n#define b2_height 32\n"
5012     "static unsigned char b2_bits[] = {\n"
5013     "0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,\n"
5014     "0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,\n"
5015     "0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,\n"
5016     "0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,\n"
5017     "0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,\n"
5018     "0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,\n"
5019     "0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,\n"
5020     "0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,\n"
5021     "0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,\n"
5022     "0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5023     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
5024     "image create bitmap ::tk::dialog::q -foreground blue \\\n"
5025     "-data \"#define q_width 32\\n#define q_height 32\n"
5026     "static unsigned char q_bits[] = {\n"
5027     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5028     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,\n"
5029     "0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,\n"
5030     "0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,\n"
5031     "0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,\n"
5032     "0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,\n"
5033     "0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5034     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5035     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5036     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5037     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
5038     "image create bitmap ::tk::dialog::i -foreground blue \\\n"
5039     "-data \"#define i_width 32\\n#define i_height 32\n"
5040     "static unsigned char i_bits[] = {\n"
5041     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5042     "0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,\n"
5043     "0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5044     "0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,\n"
5045     "0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,\n"
5046     "0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,\n"
5047     "0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5048     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5049     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5050     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5051     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
5052     "image create bitmap ::tk::dialog::w1 -foreground black \\\n"
5053     "-data \"#define w1_width 32\\n#define w1_height 32\n"
5054     "static unsigned char w1_bits[] = {\n"
5055     "0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,\n"
5056     "0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,\n"
5057     "0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,\n"
5058     "0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,\n"
5059     "0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,\n"
5060     "0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,\n"
5061     "0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,\n"
5062     "0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,\n"
5063     "0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,\n"
5064     "0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,\n"
5065     "0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};\"\n"
5066     "image create bitmap ::tk::dialog::w2 -foreground yellow \\\n"
5067     "-data \"#define w2_width 32\\n#define w2_height 32\n"
5068     "static unsigned char w2_bits[] = {\n"
5069     "0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,\n"
5070     "0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,\n"
5071     "0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,\n"
5072     "0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,\n"
5073     "0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,\n"
5074     "0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,\n"
5075     "0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,\n"
5076     "0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,\n"
5077     "0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,\n"
5078     "0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,\n"
5079     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
5080     "image create bitmap ::tk::dialog::w3 -foreground black \\\n"
5081     "-data \"#define w3_width 32\\n#define w3_height 32\n"
5082     "static unsigned char w3_bits[] = {\n"
5083     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5084     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5085     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5086     "0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,\n"
5087     "0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,\n"
5088     "0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,\n"
5089     "0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,\n"
5090     "0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,\n"
5091     "0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5092     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,\n"
5093     "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};\"\n"
5094     "proc tkMessageBox {args} {\n"
5095     "global tkPriv tcl_platform tk_strictMotif\n"
5096     "set w tkPrivMsgBox\n"
5097     "upvar #0 $w data\n"
5098     "set specs {\n"
5099     "{-default \"\" \"\" \"\"}\n"
5100     "{-icon \"\" \"\" \"info\"}\n"
5101     "{-message \"\" \"\" \"\"}\n"
5102     "{-parent \"\" \"\" .}\n"
5103     "{-title \"\" \"\" \" \"}\n"
5104     "{-type \"\" \"\" \"ok\"}\n"
5105     "}\n"
5106     "tclParseConfigSpec $w $specs \"\" $args\n"
5107     "if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {\n"
5108     "error \"bad -icon value \\\"$data(-icon)\\\": must be error, info, question, or warning\"\n"
5109     "}\n"
5110     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
5111     "switch -- $data(-icon) {\n"
5112     "\"error\" {set data(-icon) \"stop\"}\n"
5113     "\"warning\" {set data(-icon) \"caution\"}\n"
5114     "\"info\" {set data(-icon) \"note\"}\n"
5115     "}\n"
5116     "}\n"
5117     "if {![winfo exists $data(-parent)]} {\n"
5118     "error \"bad window path name \\\"$data(-parent)\\\"\"\n"
5119     "}\n"
5120     "switch -- $data(-type) {\n"
5121     "abortretryignore {\n"
5122     "set buttons {\n"
5123     "{abort -width 6 -text Abort -under 0}\n"
5124     "{retry -width 6 -text Retry -under 0}\n"
5125     "{ignore -width 6 -text Ignore -under 0}\n"
5126     "}\n"
5127     "}\n"
5128     "ok {\n"
5129     "set buttons {\n"
5130     "{ok -width 6 -text OK -under 0}\n"
5131     "}\n"
5132     "if {[string equal $data(-default) \"\"]} {\n"
5133     "set data(-default) \"ok\"\n"
5134     "}\n"
5135     "}\n"
5136     "okcancel {\n"
5137     "set buttons {\n"
5138     "{ok -width 6 -text OK -under 0}\n"
5139     "{cancel -width 6 -text Cancel -under 0}\n"
5140     "}\n"
5141     "}\n"
5142     "retrycancel {\n"
5143     "set buttons {\n"
5144     "{retry -width 6 -text Retry -under 0}\n"
5145     "{cancel -width 6 -text Cancel -under 0}\n"
5146     "}\n"
5147     "}\n"
5148     "yesno {\n"
5149     "set buttons {\n"
5150     "{yes -width 6 -text Yes -under 0}\n"
5151     "{no -width 6 -text No -under 0}\n"
5152     "}\n"
5153     "}\n"
5154     "yesnocancel {\n"
5155     "set buttons {\n"
5156     "{yes -width 6 -text Yes -under 0}\n"
5157     "{no -width 6 -text No -under 0}\n"
5158     "{cancel -width 6 -text Cancel -under 0}\n"
5159     "}\n"
5160     "}\n"
5161     "default {\n"
5162     "error \"bad -type value \\\"$data(-type)\\\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel\"\n"
5163     "}\n"
5164     "}\n"
5165     "if {[string compare $data(-default) \"\"]} {\n"
5166     "set valid 0\n"
5167     "foreach btn $buttons {\n"
5168     "if {[string equal [lindex $btn 0] $data(-default)]} {\n"
5169     "set valid 1\n"
5170     "break\n"
5171     "}\n"
5172     "}\n"
5173     "if {!$valid} {\n"
5174     "error \"invalid default button \\\"$data(-default)\\\"\"\n"
5175     "}\n"
5176     "}\n"
5177     "if {[string compare $data(-parent) .]} {\n"
5178     "set w $data(-parent).__tk__messagebox\n"
5179     "} else {\n"
5180     "set w .__tk__messagebox\n"
5181     "}\n"
5182     "catch {destroy $w}\n"
5183     "toplevel $w -class Dialog\n"
5184     "wm title $w $data(-title)\n"
5185     "wm iconname $w Dialog\n"
5186     "wm protocol $w WM_DELETE_WINDOW { }\n"
5187     "if { [winfo viewable [winfo toplevel $data(-parent)]] } {\n"
5188     "wm transient $w $data(-parent)\n"
5189     "} \n"
5190     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
5191     "unsupported1 style $w dBoxProc\n"
5192     "}\n"
5193     "frame $w.bot\n"
5194     "pack $w.bot -side bottom -fill both\n"
5195     "frame $w.top\n"
5196     "pack $w.top -side top -fill both -expand 1\n"
5197     "if {[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
5198     "$w.bot configure -relief raised -bd 1\n"
5199     "$w.top configure -relief raised -bd 1\n"
5200     "}\n"
5201     "option add *Dialog.msg.wrapLength 3i widgetDefault\n"
5202     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
5203     "option add *Dialog.msg.font system widgetDefault\n"
5204     "} else {\n"
5205     "option add *Dialog.msg.font {Times 18} widgetDefault\n"
5206     "}\n"
5207     "label $w.msg -anchor nw -justify left -text $data(-message)\n"
5208     "if {[string compare $data(-icon) \"\"]} {\n"
5209     "if {[string equal $tcl_platform(platform) \"macintosh\"] \\\n"
5210     "\011\011|| ([winfo depth $w] < 4) || $tk_strictMotif} {\n"
5211     "label $w.bitmap -bitmap $data(-icon)\n"
5212     "} else {\n"
5213     "canvas $w.bitmap -width 32 -height 32 -highlightthickness 0\n"
5214     "switch $data(-icon) {\n"
5215     "error {\n"
5216     "$w.bitmap create oval 0 0 31 31 -fill red -outline black\n"
5217     "$w.bitmap create line 9 9 23 23 -fill white -width 4\n"
5218     "$w.bitmap create line 9 23 23 9 -fill white -width 4\n"
5219     "}\n"
5220     "info {\n"
5221     "$w.bitmap create image 0 0 -anchor nw \\\n"
5222     "\011\011\011 -image ::tk::dialog::b1\n"
5223     "$w.bitmap create image 0 0 -anchor nw \\\n"
5224     "\011\011\011 -image ::tk::dialog::b2\n"
5225     "$w.bitmap create image 0 0 -anchor nw \\\n"
5226     "\011\011\011 -image ::tk::dialog::i\n"
5227     "}\n"
5228     "question {\n"
5229     "$w.bitmap create image 0 0 -anchor nw \\\n"
5230     "\011\011\011 -image ::tk::dialog::b1\n"
5231     "$w.bitmap create image 0 0 -anchor nw \\\n"
5232     "\011\011\011 -image ::tk::dialog::b2\n"
5233     "$w.bitmap create image 0 0 -anchor nw \\\n"
5234     "\011\011\011 -image ::tk::dialog::q\n"
5235     "}\n"
5236     "default {\n"
5237     "$w.bitmap create image 0 0 -anchor nw \\\n"
5238     "\011\011\011 -image ::tk::dialog::w1\n"
5239     "$w.bitmap create image 0 0 -anchor nw \\\n"
5240     "\011\011\011 -image ::tk::dialog::w2\n"
5241     "$w.bitmap create image 0 0 -anchor nw \\\n"
5242     "\011\011\011 -image ::tk::dialog::w3\n"
5243     "}\n"
5244     "}\n"
5245     "}\n"
5246     "}\n"
5247     "grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m\n"
5248     "grid columnconfigure $w.top 1 -weight 1\n"
5249     "grid rowconfigure $w.top 0 -weight 1\n"
5250     "set i 0\n"
5251     "foreach but $buttons {\n"
5252     "set name [lindex $but 0]\n"
5253     "set opts [lrange $but 1 end]\n"
5254     "if {![llength $opts]} {\n"
5255     "set capName [string toupper $name 0]\n"
5256     "set opts [list -text $capName]\n"
5257     "}\n"
5258     "eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]\n"
5259     "if {[string equal $name $data(-default)]} {\n"
5260     "$w.$name configure -default active\n"
5261     "}\n"
5262     "pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m\n"
5263     "set underIdx [$w.$name cget -under]\n"
5264     "if {$underIdx >= 0} {\n"
5265     "set key [string index [$w.$name cget -text] $underIdx]\n"
5266     "bind $w <Alt-[string tolower $key]> [list $w.$name invoke]\n"
5267     "bind $w <Alt-[string toupper $key]> [list $w.$name invoke]\n"
5268     "}\n"
5269     "incr i\n"
5270     "}\n"
5271     "if {[string compare {} $data(-default)]} {\n"
5272     "bind $w <FocusIn> {\n"
5273     "if {[string equal Button [winfo class %W]]} {\n"
5274     "%W configure -default active\n"
5275     "}\n"
5276     "}\n"
5277     "bind $w <FocusOut> {\n"
5278     "if {[string equal Button [winfo class %W]]} {\n"
5279     "%W configure -default normal\n"
5280     "}\n"
5281     "}\n"
5282     "}\n"
5283     "bind $w <Return> {\n"
5284     "if {[string equal Button [winfo class %W]]} {\n"
5285     "tkButtonInvoke %W\n"
5286     "}\n"
5287     "}\n"
5288     "::tk::PlaceWindow $w widget $data(-parent)\n"
5289     "if {[string compare $data(-default) \"\"]} {\n"
5290     "set focus $w.$data(-default)\n"
5291     "} else {\n"
5292     "set focus $w\n"
5293     "}\n"
5294     "::tk::SetFocusGrab $w $focus\n"
5295     "tkwait variable tkPriv(button)\n"
5296     "::tk::RestoreFocusGrab $w $focus\n"
5297     "return $tkPriv(button)\n"
5298     "}\n"
5299     ;
5300     static char Et_zFile19[] =
5301     "proc tk_menuBar args {}\n"
5302     "proc tk_bindForTraversal args {}\n"
5303     ;
5304     static char Et_zFile20[] =
5305     "proc tk_optionMenu {w varName firstValue args} {\n"
5306     "upvar #0 $varName var\n"
5307     "if {![info exists var]} {\n"
5308     "set var $firstValue\n"
5309     "}\n"
5310     "menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \\\n"
5311     "\011 -relief raised -bd 2 -highlightthickness 2 -anchor c \\\n"
5312     "\011 -direction flush\n"
5313     "menu $w.menu -tearoff 0\n"
5314     "$w.menu add radiobutton -label $firstValue -variable $varName\n"
5315     "foreach i $args {\n"
5316     "$w.menu add radiobutton -label $i -variable $varName\n"
5317     "}\n"
5318     "return $w.menu\n"
5319     "}\n"
5320     ;
5321     static char Et_zFile21[] =
5322     "proc tk_setPalette {args} {\n"
5323     "if {[winfo depth .] == 1} {\n"
5324     "return\n"
5325     "}\n"
5326     "global tkPalette\n"
5327     "if {[llength $args] == 1} {\n"
5328     "set new(background) [lindex $args 0]\n"
5329     "} else {\n"
5330     "array set new $args\n"
5331     "}\n"
5332     "if {![info exists new(background)]} {\n"
5333     "error \"must specify a background color\"\n"
5334     "}\n"
5335     "if {![info exists new(foreground)]} {\n"
5336     "set new(foreground) black\n"
5337     "}\n"
5338     "set bg [winfo rgb . $new(background)]\n"
5339     "set fg [winfo rgb . $new(foreground)]\n"
5340     "set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \\\n"
5341     "\011 [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]]\n"
5342     "foreach i {activeForeground insertBackground selectForeground \\\n"
5343     "\011 highlightColor} {\n"
5344     "if {![info exists new($i)]} {\n"
5345     "set new($i) $new(foreground)\n"
5346     "}\n"
5347     "}\n"
5348     "if {![info exists new(disabledForeground)]} {\n"
5349     "set new(disabledForeground) [format #%02x%02x%02x \\\n"
5350     "\011\011[expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \\\n"
5351     "\011\011[expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \\\n"
5352     "\011\011[expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]]\n"
5353     "}\n"
5354     "if {![info exists new(highlightBackground)]} {\n"
5355     "set new(highlightBackground) $new(background)\n"
5356     "}\n"
5357     "if {![info exists new(activeBackground)]} {\n"
5358     "foreach i {0 1 2} {\n"
5359     "set light($i) [expr {[lindex $bg $i]/256}]\n"
5360     "set inc1 [expr {($light($i)*15)/100}]\n"
5361     "set inc2 [expr {(255-$light($i))/3}]\n"
5362     "if {$inc1 > $inc2} {\n"
5363     "incr light($i) $inc1\n"
5364     "} else {\n"
5365     "incr light($i) $inc2\n"
5366     "}\n"
5367     "if {$light($i) > 255} {\n"
5368     "set light($i) 255\n"
5369     "}\n"
5370     "}\n"
5371     "set new(activeBackground) [format #%02x%02x%02x $light(0) \\\n"
5372     "\011\011$light(1) $light(2)]\n"
5373     "}\n"
5374     "if {![info exists new(selectBackground)]} {\n"
5375     "set new(selectBackground) $darkerBg\n"
5376     "}\n"
5377     "if {![info exists new(troughColor)]} {\n"
5378     "set new(troughColor) $darkerBg\n"
5379     "}\n"
5380     "if {![info exists new(selectColor)]} {\n"
5381     "set new(selectColor) #b03060\n"
5382     "}\n"
5383     "toplevel .___tk_set_palette\n"
5384     "wm withdraw .___tk_set_palette\n"
5385     "foreach q {button canvas checkbutton entry frame label listbox \\\n"
5386     "\011 menubutton menu message radiobutton scale scrollbar text} {\n"
5387     "$q .___tk_set_palette.$q\n"
5388     "}\n"
5389     "eval [tkRecolorTree . new]\n"
5390     "catch {destroy .___tk_set_palette}\n"
5391     "foreach option [array names new] {\n"
5392     "option add *$option $new($option) widgetDefault\n"
5393     "}\n"
5394     "array set tkPalette [array get new]\n"
5395     "}\n"
5396     "proc tkRecolorTree {w colors} {\n"
5397     "global tkPalette\n"
5398     "upvar $colors c\n"
5399     "set result {}\n"
5400     "foreach dbOption [array names c] {\n"
5401     "set option -[string tolower $dbOption]\n"
5402     "if {![catch {$w config $option} value]} {\n"
5403     "set defaultcolor [option get $w $dbOption widgetDefault]\n"
5404     "if {[string match {} $defaultcolor]} {\n"
5405     "set defaultcolor [winfo rgb . [lindex $value 3]]\n"
5406     "} else {\n"
5407     "set defaultcolor [winfo rgb . $defaultcolor]\n"
5408     "}\n"
5409     "set chosencolor [winfo rgb . [lindex $value 4]]\n"
5410     "if {[string match $defaultcolor $chosencolor]} {\n"
5411     "append result \";\\noption add [list \\\n"
5412     "\011\011 *[winfo class $w].$dbOption $c($dbOption) 60]\"\n"
5413     "$w configure $option $c($dbOption)\n"
5414     "}\n"
5415     "}\n"
5416     "}\n"
5417     "foreach child [winfo children $w] {\n"
5418     "append result \";\\n[tkRecolorTree $child c]\"\n"
5419     "}\n"
5420     "return $result\n"
5421     "}\n"
5422     "proc tkDarken {color percent} {\n"
5423     "foreach {red green blue} [winfo rgb . $color] {\n"
5424     "set red [expr {($red/256)*$percent/100}]\n"
5425     "set green [expr {($green/256)*$percent/100}]\n"
5426     "set blue [expr {($blue/256)*$percent/100}]\n"
5427     "break\n"
5428     "}\n"
5429     "if {$red > 255} {\n"
5430     "set red 255\n"
5431     "}\n"
5432     "if {$green > 255} {\n"
5433     "set green 255\n"
5434     "}\n"
5435     "if {$blue > 255} {\n"
5436     "set blue 255\n"
5437     "}\n"
5438     "return [format \"#%02x%02x%02x\" $red $green $blue]\n"
5439     "}\n"
5440     "proc tk_bisque {} {\n"
5441     "tk_setPalette activeBackground #e6ceb1 activeForeground black \\\n"
5442     "\011 background #ffe4c4 disabledForeground #b0b0b0 foreground black \\\n"
5443     "\011 highlightBackground #ffe4c4 highlightColor black \\\n"
5444     "\011 insertBackground black selectColor #b03060 \\\n"
5445     "\011 selectBackground #e6ceb1 selectForeground black \\\n"
5446     "\011 troughColor #cdb79e\n"
5447     "}\n"
5448     ;
5449     static char Et_zFile22[] =
5450     "package require opt 0.4.1;\n"
5451     "namespace eval ::safe {\n"
5452     "variable tkSafeId 0;\n"
5453     "proc ::safe::tkInterpInit {slave argv} {\n"
5454     "global env tk_library\n"
5455     "allowTk $slave $argv\n"
5456     "::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]\n"
5457     "return $slave\n"
5458     "}\n"
5459     "proc ::safe::loadTk {} {}\n"
5460     "::tcl::OptProc loadTk {\n"
5461     "{slave -interp \"name of the slave interpreter\"}\n"
5462     "{-use -windowId {} \"window Id to use (new toplevel otherwise)\"}\n"
5463     "{-display -displayName {} \"display name to use (current one otherwise)\"}\n"
5464     "} {\n"
5465     "set displayGiven [::tcl::OptProcArgGiven \"-display\"]\n"
5466     "if {!$displayGiven} {\n"
5467     "if {[catch {set display [winfo screen .]}]} {\n"
5468     "if {[info exists ::env(DISPLAY)]} {\n"
5469     "set display $::env(DISPLAY)\n"
5470     "} else {\n"
5471     "Log $slave \"no winfo screen . nor env(DISPLAY)\" WARNING\n"
5472     "set display \":0.0\"\n"
5473     "}\n"
5474     "}\n"
5475     "}\n"
5476     "if {![::tcl::OptProcArgGiven \"-use\"]} {\n"
5477     "::tcl::Lassign [tkTopLevel $slave $display] w use\n"
5478     "Set [DeleteHookName $slave] [list tkDelete {} $w]\n"
5479     "} else {\n"
5480     "Set [DeleteHookName $slave] [list disallowTk]\n"
5481     "if {[string match \".*\" $use]} {\n"
5482     "set windowName $use\n"
5483     "set use [winfo id $windowName]\n"
5484     "set nDisplay [winfo screen $windowName]\n"
5485     "} else {\n"
5486     "if {![catch {winfo pathname $use} name]} {\n"
5487     "set nDisplay [winfo screen $name]\n"
5488     "} else {\n"
5489     "set nDisplay $display\n"
5490     "}\n"
5491     "}\n"
5492     "if {[string compare $nDisplay $display]} {\n"
5493     "if {$displayGiven} {\n"
5494     "error \"conflicting -display $display and -use\\\n"
5495     "\011\011\011$use -> $nDisplay\"\n"
5496     "} else {\n"
5497     "set display $nDisplay\n"
5498     "}\n"
5499     "}\n"
5500     "}\n"
5501     "tkInterpInit $slave [list \"-use\" $use \"-display\" $display]\n"
5502     "load {} Tk $slave\n"
5503     "return $slave\n"
5504     "}\n"
5505     "proc ::safe::TkInit {interpPath} {\n"
5506     "variable tkInit\n"
5507     "if {[info exists tkInit($interpPath)]} {\n"
5508     "set value $tkInit($interpPath)\n"
5509     "Log $interpPath \"TkInit called, returning \\\"$value\\\"\" NOTICE\n"
5510     "return $value\n"
5511     "} else {\n"
5512     "Log $interpPath \"TkInit called for interp with clearance:\\\n"
5513     "\011\011preventing Tk init\" ERROR\n"
5514     "error \"not allowed\"\n"
5515     "}\n"
5516     "}\n"
5517     "proc ::safe::allowTk {interpPath argv} {\n"
5518     "variable tkInit\n"
5519     "set tkInit($interpPath) $argv\n"
5520     "return\n"
5521     "}\n"
5522     "proc ::safe::disallowTk {interpPath} {\n"
5523     "variable tkInit\n"
5524     "if {[info exists tkInit($interpPath)]} {\n"
5525     "unset tkInit($interpPath)\n"
5526     "}\n"
5527     "return\n"
5528     "}\n"
5529     "proc ::safe::tkDelete {W window slave} {\n"
5530     "Log $slave \"Called tkDelete $W $window\" NOTICE\n"
5531     "if {[::interp exists $slave]} {\n"
5532     "if {[catch {::safe::interpDelete $slave} msg]} {\n"
5533     "Log $slave \"Deletion error : $msg\"\n"
5534     "}\n"
5535     "}\n"
5536     "if {[winfo exists $window]} {\n"
5537     "Log $slave \"Destroy toplevel $window\" NOTICE\n"
5538     "destroy $window\n"
5539     "}\n"
5540     "disallowTk $slave\n"
5541     "return\n"
5542     "}\n"
5543     "proc ::safe::tkTopLevel {slave display} {\n"
5544     "variable tkSafeId\n"
5545     "incr tkSafeId\n"
5546     "set w \".safe$tkSafeId\"\n"
5547     "if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {\n"
5548     "return -code error \"Unable to create toplevel for\\\n"
5549     "\011\011safe slave \\\"$slave\\\" ($msg)\"\n"
5550     "}\n"
5551     "Log $slave \"New toplevel $w\" NOTICE\n"
5552     "set msg \"Untrusted Tcl applet ($slave)\"\n"
5553     "wm title $w $msg\n"
5554     "set wc $w.fc\n"
5555     "frame $wc -bg red -borderwidth 3 -relief ridge\n"
5556     "bindtags $wc [concat Safe$wc [bindtags $wc]]\n"
5557     "bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]\n"
5558     "label $wc.l -text $msg -padx 2 -pady 0 -anchor w\n"
5559     "frame $wc.fb -bd 0\n"
5560     "button $wc.fb.b -text \"Delete\" \\\n"
5561     "\011 -bd 1 -padx 2 -pady 0 -highlightthickness 0 \\\n"
5562     "\011 -command [list ::safe::tkDelete $w $w $slave]\n"
5563     "pack $wc.fb.b -side right -fill both\n"
5564     "pack $wc.fb -side right -fill both -expand 1\n"
5565     "pack $wc.l -side left -fill both -expand 1\n"
5566     "pack $wc -side bottom -fill x\n"
5567     "frame $w.c -container 1\n"
5568     "pack $w.c -fill both -expand 1\n"
5569     "list $w [winfo id $w.c]\n"
5570     "}\n"
5571     "}\n"
5572     ;
5573     static char Et_zFile23[] =
5574     "bind Scale <Enter> {\n"
5575     "if {$tk_strictMotif} {\n"
5576     "set tkPriv(activeBg) [%W cget -activebackground]\n"
5577     "%W config -activebackground [%W cget -background]\n"
5578     "}\n"
5579     "tkScaleActivate %W %x %y\n"
5580     "}\n"
5581     "bind Scale <Motion> {\n"
5582     "tkScaleActivate %W %x %y\n"
5583     "}\n"
5584     "bind Scale <Leave> {\n"
5585     "if {$tk_strictMotif} {\n"
5586     "%W config -activebackground $tkPriv(activeBg)\n"
5587     "}\n"
5588     "if {[string equal [%W cget -state] \"active\"]} {\n"
5589     "%W configure -state normal\n"
5590     "}\n"
5591     "}\n"
5592     "bind Scale <1> {\n"
5593     "tkScaleButtonDown %W %x %y\n"
5594     "}\n"
5595     "bind Scale <B1-Motion> {\n"
5596     "tkScaleDrag %W %x %y\n"
5597     "}\n"
5598     "bind Scale <B1-Leave> { }\n"
5599     "bind Scale <B1-Enter> { }\n"
5600     "bind Scale <ButtonRelease-1> {\n"
5601     "tkCancelRepeat\n"
5602     "tkScaleEndDrag %W\n"
5603     "tkScaleActivate %W %x %y\n"
5604     "}\n"
5605     "bind Scale <2> {\n"
5606     "tkScaleButton2Down %W %x %y\n"
5607     "}\n"
5608     "bind Scale <B2-Motion> {\n"
5609     "tkScaleDrag %W %x %y\n"
5610     "}\n"
5611     "bind Scale <B2-Leave> { }\n"
5612     "bind Scale <B2-Enter> { }\n"
5613     "bind Scale <ButtonRelease-2> {\n"
5614     "tkCancelRepeat\n"
5615     "tkScaleEndDrag %W\n"
5616     "tkScaleActivate %W %x %y\n"
5617     "}\n"
5618     "bind Scale <Control-1> {\n"
5619     "tkScaleControlPress %W %x %y\n"
5620     "}\n"
5621     "bind Scale <Up> {\n"
5622     "tkScaleIncrement %W up little noRepeat\n"
5623     "}\n"
5624     "bind Scale <Down> {\n"
5625     "tkScaleIncrement %W down little noRepeat\n"
5626     "}\n"
5627     "bind Scale <Left> {\n"
5628     "tkScaleIncrement %W up little noRepeat\n"
5629     "}\n"
5630     "bind Scale <Right> {\n"
5631     "tkScaleIncrement %W down little noRepeat\n"
5632     "}\n"
5633     "bind Scale <Control-Up> {\n"
5634     "tkScaleIncrement %W up big noRepeat\n"
5635     "}\n"
5636     "bind Scale <Control-Down> {\n"
5637     "tkScaleIncrement %W down big noRepeat\n"
5638     "}\n"
5639     "bind Scale <Control-Left> {\n"
5640     "tkScaleIncrement %W up big noRepeat\n"
5641     "}\n"
5642     "bind Scale <Control-Right> {\n"
5643     "tkScaleIncrement %W down big noRepeat\n"
5644     "}\n"
5645     "bind Scale <Home> {\n"
5646     "%W set [%W cget -from]\n"
5647     "}\n"
5648     "bind Scale <End> {\n"
5649     "%W set [%W cget -to]\n"
5650     "}\n"
5651     "proc tkScaleActivate {w x y} {\n"
5652     "if {[string equal [$w cget -state] \"disabled\"]} {\n"
5653     "return\n"
5654     "}\n"
5655     "if {[string equal [$w identify $x $y] \"slider\"]} {\n"
5656     "set state active\n"
5657     "} else {\n"
5658     "set state normal\n"
5659     "}\n"
5660     "if {[string compare [$w cget -state] $state]} {\n"
5661     "$w configure -state $state\n"
5662     "}\n"
5663     "}\n"
5664     "proc tkScaleButtonDown {w x y} {\n"
5665     "global tkPriv\n"
5666     "set tkPriv(dragging) 0\n"
5667     "set el [$w identify $x $y]\n"
5668     "if {[string equal $el \"trough1\"]} {\n"
5669     "tkScaleIncrement $w up little initial\n"
5670     "} elseif {[string equal $el \"trough2\"]} {\n"
5671     "tkScaleIncrement $w down little initial\n"
5672     "} elseif {[string equal $el \"slider\"]} {\n"
5673     "set tkPriv(dragging) 1\n"
5674     "set tkPriv(initValue) [$w get]\n"
5675     "set coords [$w coords]\n"
5676     "set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]\n"
5677     "set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]\n"
5678     "$w configure -sliderrelief sunken\n"
5679     "}\n"
5680     "}\n"
5681     "proc tkScaleDrag {w x y} {\n"
5682     "global tkPriv\n"
5683     "if {!$tkPriv(dragging)} {\n"
5684     "return\n"
5685     "}\n"
5686     "$w set [$w get [expr {$x-$tkPriv(deltaX)}] [expr {$y-$tkPriv(deltaY)}]]\n"
5687     "}\n"
5688     "proc tkScaleEndDrag {w} {\n"
5689     "global tkPriv\n"
5690     "set tkPriv(dragging) 0\n"
5691     "$w configure -sliderrelief raised\n"
5692     "}\n"
5693     "proc tkScaleIncrement {w dir big repeat} {\n"
5694     "global tkPriv\n"
5695     "if {![winfo exists $w]} return\n"
5696     "if {[string equal $big \"big\"]} {\n"
5697     "set inc [$w cget -bigincrement]\n"
5698     "if {$inc == 0} {\n"
5699     "set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]\n"
5700     "}\n"
5701     "if {$inc < [$w cget -resolution]} {\n"
5702     "set inc [$w cget -resolution]\n"
5703     "}\n"
5704     "} else {\n"
5705     "set inc [$w cget -resolution]\n"
5706     "}\n"
5707     "if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir \"up\"]} {\n"
5708     "set inc [expr {-$inc}]\n"
5709     "}\n"
5710     "$w set [expr {[$w get] + $inc}]\n"
5711     "if {[string equal $repeat \"again\"]} {\n"
5712     "set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n"
5713     "\011\011[list tkScaleIncrement $w $dir $big again]]\n"
5714     "} elseif {[string equal $repeat \"initial\"]} {\n"
5715     "set delay [$w cget -repeatdelay]\n"
5716     "if {$delay > 0} {\n"
5717     "set tkPriv(afterId) [after $delay \\\n"
5718     "\011\011 [list tkScaleIncrement $w $dir $big again]]\n"
5719     "}\n"
5720     "}\n"
5721     "}\n"
5722     "proc tkScaleControlPress {w x y} {\n"
5723     "set el [$w identify $x $y]\n"
5724     "if {[string equal $el \"trough1\"]} {\n"
5725     "$w set [$w cget -from]\n"
5726     "} elseif {[string equal $el \"trough2\"]} {\n"
5727     "$w set [$w cget -to]\n"
5728     "}\n"
5729     "}\n"
5730     "proc tkScaleButton2Down {w x y} {\n"
5731     "global tkPriv\n"
5732     "if {[string equal [$w cget -state] \"disabled\"]} {\n"
5733     "return\n"
5734     "}\n"
5735     "$w configure -state active\n"
5736     "$w set [$w get $x $y]\n"
5737     "set tkPriv(dragging) 1\n"
5738     "set tkPriv(initValue) [$w get]\n"
5739     "set coords \"$x $y\"\n"
5740     "set tkPriv(deltaX) 0\n"
5741     "set tkPriv(deltaY) 0\n"
5742     "}\n"
5743     ;
5744     static char Et_zFile24[] =
5745     "if {[string compare $tcl_platform(platform) \"windows\"] && \\\n"
5746     "\011[string compare $tcl_platform(platform) \"macintosh\"]} {\n"
5747     "bind Scrollbar <Enter> {\n"
5748     "if {$tk_strictMotif} {\n"
5749     "set tkPriv(activeBg) [%W cget -activebackground]\n"
5750     "%W config -activebackground [%W cget -background]\n"
5751     "}\n"
5752     "%W activate [%W identify %x %y]\n"
5753     "}\n"
5754     "bind Scrollbar <Motion> {\n"
5755     "%W activate [%W identify %x %y]\n"
5756     "}\n"
5757     "bind Scrollbar <Leave> {\n"
5758     "if {$tk_strictMotif && [info exists tkPriv(activeBg)]} {\n"
5759     "%W config -activebackground $tkPriv(activeBg)\n"
5760     "}\n"
5761     "%W activate {}\n"
5762     "}\n"
5763     "bind Scrollbar <1> {\n"
5764     "tkScrollButtonDown %W %x %y\n"
5765     "}\n"
5766     "bind Scrollbar <B1-Motion> {\n"
5767     "tkScrollDrag %W %x %y\n"
5768     "}\n"
5769     "bind Scrollbar <B1-B2-Motion> {\n"
5770     "tkScrollDrag %W %x %y\n"
5771     "}\n"
5772     "bind Scrollbar <ButtonRelease-1> {\n"
5773     "tkScrollButtonUp %W %x %y\n"
5774     "}\n"
5775     "bind Scrollbar <B1-Leave> {\n"
5776     "}\n"
5777     "bind Scrollbar <B1-Enter> {\n"
5778     "}\n"
5779     "bind Scrollbar <2> {\n"
5780     "tkScrollButton2Down %W %x %y\n"
5781     "}\n"
5782     "bind Scrollbar <B1-2> {\n"
5783     "}\n"
5784     "bind Scrollbar <B2-1> {\n"
5785     "}\n"
5786     "bind Scrollbar <B2-Motion> {\n"
5787     "tkScrollDrag %W %x %y\n"
5788     "}\n"
5789     "bind Scrollbar <ButtonRelease-2> {\n"
5790     "tkScrollButtonUp %W %x %y\n"
5791     "}\n"
5792     "bind Scrollbar <B1-ButtonRelease-2> {\n"
5793     "}\n"
5794     "bind Scrollbar <B2-ButtonRelease-1> {\n"
5795     "}\n"
5796     "bind Scrollbar <B2-Leave> {\n"
5797     "}\n"
5798     "bind Scrollbar <B2-Enter> {\n"
5799     "}\n"
5800     "bind Scrollbar <Control-1> {\n"
5801     "tkScrollTopBottom %W %x %y\n"
5802     "}\n"
5803     "bind Scrollbar <Control-2> {\n"
5804     "tkScrollTopBottom %W %x %y\n"
5805     "}\n"
5806     "bind Scrollbar <Up> {\n"
5807     "tkScrollByUnits %W v -1\n"
5808     "}\n"
5809     "bind Scrollbar <Down> {\n"
5810     "tkScrollByUnits %W v 1\n"
5811     "}\n"
5812     "bind Scrollbar <Control-Up> {\n"
5813     "tkScrollByPages %W v -1\n"
5814     "}\n"
5815     "bind Scrollbar <Control-Down> {\n"
5816     "tkScrollByPages %W v 1\n"
5817     "}\n"
5818     "bind Scrollbar <Left> {\n"
5819     "tkScrollByUnits %W h -1\n"
5820     "}\n"
5821     "bind Scrollbar <Right> {\n"
5822     "tkScrollByUnits %W h 1\n"
5823     "}\n"
5824     "bind Scrollbar <Control-Left> {\n"
5825     "tkScrollByPages %W h -1\n"
5826     "}\n"
5827     "bind Scrollbar <Control-Right> {\n"
5828     "tkScrollByPages %W h 1\n"
5829     "}\n"
5830     "bind Scrollbar <Prior> {\n"
5831     "tkScrollByPages %W hv -1\n"
5832     "}\n"
5833     "bind Scrollbar <Next> {\n"
5834     "tkScrollByPages %W hv 1\n"
5835     "}\n"
5836     "bind Scrollbar <Home> {\n"
5837     "tkScrollToPos %W 0\n"
5838     "}\n"
5839     "bind Scrollbar <End> {\n"
5840     "tkScrollToPos %W 1\n"
5841     "}\n"
5842     "}\n"
5843     "proc tkScrollButtonDown {w x y} {\n"
5844     "global tkPriv\n"
5845     "set tkPriv(relief) [$w cget -activerelief]\n"
5846     "$w configure -activerelief sunken\n"
5847     "set element [$w identify $x $y]\n"
5848     "if {[string equal $element \"slider\"]} {\n"
5849     "tkScrollStartDrag $w $x $y\n"
5850     "} else {\n"
5851     "tkScrollSelect $w $element initial\n"
5852     "}\n"
5853     "}\n"
5854     "proc tkScrollButtonUp {w x y} {\n"
5855     "global tkPriv\n"
5856     "tkCancelRepeat\n"
5857     "if {[info exists tkPriv(relief)]} {\n"
5858     "$w configure -activerelief $tkPriv(relief)\n"
5859     "tkScrollEndDrag $w $x $y\n"
5860     "$w activate [$w identify $x $y]\n"
5861     "}\n"
5862     "}\n"
5863     "proc tkScrollSelect {w element repeat} {\n"
5864     "global tkPriv\n"
5865     "if {![winfo exists $w]} return\n"
5866     "switch -- $element {\n"
5867     "\"arrow1\"\011{tkScrollByUnits $w hv -1}\n"
5868     "\"trough1\"\011{tkScrollByPages $w hv -1}\n"
5869     "\"trough2\"\011{tkScrollByPages $w hv 1}\n"
5870     "\"arrow2\"\011{tkScrollByUnits $w hv 1}\n"
5871     "default\011\011{return}\n"
5872     "}\n"
5873     "if {[string equal $repeat \"again\"]} {\n"
5874     "set tkPriv(afterId) [after [$w cget -repeatinterval] \\\n"
5875     "\011\011[list tkScrollSelect $w $element again]]\n"
5876     "} elseif {[string equal $repeat \"initial\"]} {\n"
5877     "set delay [$w cget -repeatdelay]\n"
5878     "if {$delay > 0} {\n"
5879     "set tkPriv(afterId) [after $delay \\\n"
5880     "\011\011 [list tkScrollSelect $w $element again]]\n"
5881     "}\n"
5882     "}\n"
5883     "}\n"
5884     "proc tkScrollStartDrag {w x y} {\n"
5885     "global tkPriv\n"
5886     "if {[string equal [$w cget -command] \"\"]} {\n"
5887     "return\n"
5888     "}\n"
5889     "set tkPriv(pressX) $x\n"
5890     "set tkPriv(pressY) $y\n"
5891     "set tkPriv(initValues) [$w get]\n"
5892     "set iv0 [lindex $tkPriv(initValues) 0]\n"
5893     "if {[llength $tkPriv(initValues)] == 2} {\n"
5894     "set tkPriv(initPos) $iv0\n"
5895     "} elseif {$iv0 == 0} {\n"
5896     "set tkPriv(initPos) 0.0\n"
5897     "} else {\n"
5898     "set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \\\n"
5899     "\011\011/ [lindex $tkPriv(initValues) 0]}]\n"
5900     "}\n"
5901     "}\n"
5902     "proc tkScrollDrag {w x y} {\n"
5903     "global tkPriv\n"
5904     "if {[string equal $tkPriv(initPos) \"\"]} {\n"
5905     "return\n"
5906     "}\n"
5907     "set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]\n"
5908     "if {[$w cget -jump]} {\n"
5909     "if {[llength $tkPriv(initValues)] == 2} {\n"
5910     "$w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \\\n"
5911     "\011\011 [expr {[lindex $tkPriv(initValues) 1] + $delta}]\n"
5912     "} else {\n"
5913     "set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]\n"
5914     "eval [list $w] set [lreplace $tkPriv(initValues) 2 3 \\\n"
5915     "\011\011 [expr {[lindex $tkPriv(initValues) 2] + $delta}] \\\n"
5916     "\011\011 [expr {[lindex $tkPriv(initValues) 3] + $delta}]]\n"
5917     "}\n"
5918     "} else {\n"
5919     "tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]\n"
5920     "}\n"
5921     "}\n"
5922     "proc tkScrollEndDrag {w x y} {\n"
5923     "global tkPriv\n"
5924     "if {[string equal $tkPriv(initPos) \"\"]} {\n"
5925     "return\n"
5926     "}\n"
5927     "if {[$w cget -jump]} {\n"
5928     "set delta [$w delta [expr {$x - $tkPriv(pressX)}] \\\n"
5929     "\011\011[expr {$y - $tkPriv(pressY)}]]\n"
5930     "tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]\n"
5931     "}\n"
5932     "set tkPriv(initPos) \"\"\n"
5933     "}\n"
5934     "proc tkScrollByUnits {w orient amount} {\n"
5935     "set cmd [$w cget -command]\n"
5936     "if {[string equal $cmd \"\"] || ([string first \\\n"
5937     "\011 [string index [$w cget -orient] 0] $orient] < 0)} {\n"
5938     "return\n"
5939     "}\n"
5940     "set info [$w get]\n"
5941     "if {[llength $info] == 2} {\n"
5942     "uplevel #0 $cmd scroll $amount units\n"
5943     "} else {\n"
5944     "uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]\n"
5945     "}\n"
5946     "}\n"
5947     "proc tkScrollByPages {w orient amount} {\n"
5948     "set cmd [$w cget -command]\n"
5949     "if {[string equal $cmd \"\"] || ([string first \\\n"
5950     "\011 [string index [$w cget -orient] 0] $orient] < 0)} {\n"
5951     "return\n"
5952     "}\n"
5953     "set info [$w get]\n"
5954     "if {[llength $info] == 2} {\n"
5955     "uplevel #0 $cmd scroll $amount pages\n"
5956     "} else {\n"
5957     "uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]\n"
5958     "}\n"
5959     "}\n"
5960     "proc tkScrollToPos {w pos} {\n"
5961     "set cmd [$w cget -command]\n"
5962     "if {[string equal $cmd \"\"]} {\n"
5963     "return\n"
5964     "}\n"
5965     "set info [$w get]\n"
5966     "if {[llength $info] == 2} {\n"
5967     "uplevel #0 $cmd moveto $pos\n"
5968     "} else {\n"
5969     "uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]\n"
5970     "}\n"
5971     "}\n"
5972     "proc tkScrollTopBottom {w x y} {\n"
5973     "global tkPriv\n"
5974     "set element [$w identify $x $y]\n"
5975     "if {[string match *1 $element]} {\n"
5976     "tkScrollToPos $w 0\n"
5977     "} elseif {[string match *2 $element]} {\n"
5978     "tkScrollToPos $w 1\n"
5979     "}\n"
5980     "set tkPriv(relief) [$w cget -activerelief]\n"
5981     "}\n"
5982     "proc tkScrollButton2Down {w x y} {\n"
5983     "global tkPriv\n"
5984     "set element [$w identify $x $y]\n"
5985     "if {[string match {arrow[12]} $element]} {\n"
5986     "tkScrollButtonDown $w $x $y\n"
5987     "return\n"
5988     "}\n"
5989     "tkScrollToPos $w [$w fraction $x $y]\n"
5990     "set tkPriv(relief) [$w cget -activerelief]\n"
5991     "update idletasks\n"
5992     "$w configure -activerelief sunken\n"
5993     "$w activate slider\n"
5994     "tkScrollStartDrag $w $x $y\n"
5995     "}\n"
5996     ;
5997     static char Et_zFile25[] =
5998     "# Tcl autoload index file, version 2.0\n"
5999     "# This file is generated by the \"auto_mkindex\" command\n"
6000     "# and sourced to set up indexing information for one or\n"
6001     "# more commands. Typically each line is a command that\n"
6002     "# sets an element in the auto_index array, where the\n"
6003     "# element name is the name of a command and the value is\n"
6004     "# a script that loads the command.\n"
6005     "\n"
6006     "set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
6007     "set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
6008     "set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]\n"
6009     "set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
6010     "set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]\n"
6011     "set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
6012     "set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
6013     "set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
6014     "set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
6015     "set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
6016     "set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]\n"
6017     "set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]\n"
6018     "set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]\n"
6019     "set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]\n"
6020     "set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]\n"
6021     "set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]\n"
6022     "set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]\n"
6023     "set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]\n"
6024     "set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]\n"
6025     "set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]\n"
6026     "set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]\n"
6027     "set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]\n"
6028     "set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]\n"
6029     "set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]\n"
6030     "set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]\n"
6031     "set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]\n"
6032     "set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]\n"
6033     "set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]\n"
6034     "set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]\n"
6035     "set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]\n"
6036     "set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]\n"
6037     "set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]\n"
6038     "set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]\n"
6039     "set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]\n"
6040     "set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]\n"
6041     "set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]\n"
6042     "set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]\n"
6043     "set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]\n"
6044     "set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]\n"
6045     "set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]\n"
6046     "set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]\n"
6047     "set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]\n"
6048     "set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]\n"
6049     "set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]\n"
6050     "set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]\n"
6051     "set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]\n"
6052     "set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]\n"
6053     "set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]\n"
6054     "set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]\n"
6055     "set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]\n"
6056     "set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]\n"
6057     "set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]\n"
6058     "set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]\n"
6059     "set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]\n"
6060     "set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]\n"
6061     "set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]\n"
6062     "set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]\n"
6063     "set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]\n"
6064     "set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]\n"
6065     "set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]\n"
6066     "set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]\n"
6067     "set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]\n"
6068     "set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]\n"
6069     "set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]\n"
6070     "set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]\n"
6071     "set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]\n"
6072     "set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]\n"
6073     "set auto_index(tk_popup) [list source [file join $dir menu.tcl]]\n"
6074     "set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]\n"
6075     "set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]\n"
6076     "set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]\n"
6077     "set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]\n"
6078     "set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]\n"
6079     "set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]\n"
6080     "set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]\n"
6081     "set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]\n"
6082     "set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]\n"
6083     "set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]\n"
6084     "set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]\n"
6085     "set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]\n"
6086     "set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]\n"
6087     "set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]\n"
6088     "set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]\n"
6089     "set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]\n"
6090     "set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]\n"
6091     "set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]\n"
6092     "set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]\n"
6093     "set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]\n"
6094     "set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]\n"
6095     "set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]\n"
6096     "set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]\n"
6097     "set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]\n"
6098     "set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]\n"
6099     "set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]\n"
6100     "set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]\n"
6101     "set auto_index(tk_textCut) [list source [file join $dir text.tcl]]\n"
6102     "set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]\n"
6103     "set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]\n"
6104     "set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]\n"
6105     "set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]\n"
6106     "set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]\n"
6107     "set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]\n"
6108     "set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]\n"
6109     "set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]\n"
6110     "set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]\n"
6111     "set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]\n"
6112     "set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]\n"
6113     "set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]\n"
6114     "set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]\n"
6115     "set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]\n"
6116     "set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]\n"
6117     "set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]\n"
6118     "set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]\n"
6119     "set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]\n"
6120     "set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]\n"
6121     "set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]\n"
6122     "set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]\n"
6123     "set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]\n"
6124     "set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]\n"
6125     "set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]\n"
6126     "set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]\n"
6127     "set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]\n"
6128     "set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]\n"
6129     "set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]\n"
6130     "set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]\n"
6131     "set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]\n"
6132     "set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]\n"
6133     "set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]\n"
6134     "set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]\n"
6135     "set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]\n"
6136     "set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]\n"
6137     "set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]\n"
6138     "set auto_index(tkDarken) [list source [file join $dir palette.tcl]]\n"
6139     "set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]\n"
6140     "set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]\n"
6141     "set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]\n"
6142     "set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]\n"
6143     "set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]\n"
6144     "set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]\n"
6145     "set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]\n"
6146     "set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]\n"
6147     "set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]\n"
6148     "set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]\n"
6149     "set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]]\n"
6150     "set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]]\n"
6151     "set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]\n"
6152     "set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]\n"
6153     "set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]\n"
6154     "set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]]\n"
6155     "set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]\n"
6156     "set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]\n"
6157     "set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]\n"
6158     "set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]\n"
6159     "set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]\n"
6160     "set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]\n"
6161     "set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]\n"
6162     "set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]\n"
6163     "set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]\n"
6164     "set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]\n"
6165     "set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]\n"
6166     "set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]\n"
6167     "set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]\n"
6168     "set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]\n"
6169     "set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]\n"
6170     "set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]\n"
6171     "set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]\n"
6172     "set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]\n"
6173     "set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]\n"
6174     "set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]\n"
6175     "set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]\n"
6176     "set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]\n"
6177     "set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]\n"
6178     "set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]\n"
6179     "set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]\n"
6180     "set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]\n"
6181     "set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]\n"
6182     "set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]\n"
6183     "set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]\n"
6184     "set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]\n"
6185     "set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]\n"
6186     "set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]\n"
6187     "set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]\n"
6188     "set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]\n"
6189     "set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]\n"
6190     "set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]\n"
6191     "set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]\n"
6192     "set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]\n"
6193     "set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]\n"
6194     "set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]\n"
6195     "set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]\n"
6196     "set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]\n"
6197     "set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]\n"
6198     "set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]\n"
6199     "set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]\n"
6200     "set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]\n"
6201     "set auto_index(::tk::dialog::file::tkFDialog) [list source [file join $dir tkfbox.tcl]]\n"
6202     "set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]]\n"
6203     "set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]]\n"
6204     "set auto_index(::tk::dialog::file::UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]\n"
6205     "set auto_index(::tk::dialog::file::Update) [list source [file join $dir tkfbox.tcl]]\n"
6206     "set auto_index(::tk::dialog::file::SetPathSilently) [list source [file join $dir tkfbox.tcl]]\n"
6207     "set auto_index(::tk::dialog::file::SetPath) [list source [file join $dir tkfbox.tcl]]\n"
6208     "set auto_index(::tk::dialog::file::SetFilter) [list source [file join $dir tkfbox.tcl]]\n"
6209     "set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]\n"
6210     "set auto_index(::tk::dialog::file::EntFocusIn) [list source [file join $dir tkfbox.tcl]]\n"
6211     "set auto_index(::tk::dialog::file::EntFocusOut) [list source [file join $dir tkfbox.tcl]]\n"
6212     "set auto_index(::tk::dialog::file::ActivateEnt) [list source [file join $dir tkfbox.tcl]]\n"
6213     "set auto_index(::tk::dialog::file::InvokeBtn) [list source [file join $dir tkfbox.tcl]]\n"
6214     "set auto_index(::tk::dialog::file::UpDirCmd) [list source [file join $dir tkfbox.tcl]]\n"
6215     "set auto_index(::tk::dialog::file::JoinFile) [list source [file join $dir tkfbox.tcl]]\n"
6216     "set auto_index(::tk::dialog::file::OkCmd) [list source [file join $dir tkfbox.tcl]]\n"
6217     "set auto_index(::tk::dialog::file::CancelCmd) [list source [file join $dir tkfbox.tcl]]\n"
6218     "set auto_index(::tk::dialog::file::ListBrowse) [list source [file join $dir tkfbox.tcl]]\n"
6219     "set auto_index(::tk::dialog::file::ListInvoke) [list source [file join $dir tkfbox.tcl]]\n"
6220     "set auto_index(::tk::dialog::file::Done) [list source [file join $dir tkfbox.tcl]]\n"
6221     "set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]\n"
6222     "set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]\n"
6223     "set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]\n"
6224     "set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]\n"
6225     "set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]\n"
6226     "set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]\n"
6227     "set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]\n"
6228     "set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]\n"
6229     "set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]\n"
6230     "set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]\n"
6231     "set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]\n"
6232     "set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]\n"
6233     "set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]\n"
6234     "set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]\n"
6235     "set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]\n"
6236     "set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]\n"
6237     "set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]\n"
6238     "set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]\n"
6239     "set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]\n"
6240     "set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]\n"
6241     "set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]\n"
6242     "set auto_index(::tk::dialog::file::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]]\n"
6243     ;
6244     static char Et_zFile26[] =
6245     "proc tkTearOffMenu {w {x 0} {y 0}} {\n"
6246     "if {$x == 0} {\n"
6247     "set x [winfo rootx $w]\n"
6248     "}\n"
6249     "if {$y == 0} {\n"
6250     "set y [winfo rooty $w]\n"
6251     "}\n"
6252     "set parent [winfo parent $w]\n"
6253     "while {[string compare [winfo toplevel $parent] $parent] \\\n"
6254     "\011 || [string equal [winfo class $parent] \"Menu\"]} {\n"
6255     "set parent [winfo parent $parent]\n"
6256     "}\n"
6257     "if {[string equal $parent \".\"]} {\n"
6258     "set parent \"\"\n"
6259     "}\n"
6260     "for {set i 1} 1 {incr i} {\n"
6261     "set menu $parent.tearoff$i\n"
6262     "if {![winfo exists $menu]} {\n"
6263     "break\n"
6264     "}\n"
6265     "}\n"
6266     "$w clone $menu tearoff\n"
6267     "set parent [winfo parent $w]\n"
6268     "if {[string compare [$menu cget -title] \"\"]} {\n"
6269     "wm title $menu [$menu cget -title]\n"
6270     "} else {\n"
6271     "switch [winfo class $parent] {\n"
6272     "Menubutton {\n"
6273     "wm title $menu [$parent cget -text]\n"
6274     "}\n"
6275     "Menu {\n"
6276     "wm title $menu [$parent entrycget active -label]\n"
6277     "}\n"
6278     "}\n"
6279     "}\n"
6280     "$menu post $x $y\n"
6281     "if {[winfo exists $menu] == 0} {\n"
6282     "return \"\"\n"
6283     "}\n"
6284     "bind $menu <Enter> {\n"
6285     "set tkPriv(focus) %W\n"
6286     "}\n"
6287     "set cmd [$w cget -tearoffcommand]\n"
6288     "if {[string compare $cmd \"\"]} {\n"
6289     "uplevel #0 $cmd [list $w $menu]\n"
6290     "}\n"
6291     "return $menu\n"
6292     "}\n"
6293     "proc tkMenuDup {src dst type} {\n"
6294     "set cmd [list menu $dst -type $type]\n"
6295     "foreach option [$src configure] {\n"
6296     "if {[llength $option] == 2} {\n"
6297     "continue\n"
6298     "}\n"
6299     "if {[string equal [lindex $option 0] \"-type\"]} {\n"
6300     "continue\n"
6301     "}\n"
6302     "lappend cmd [lindex $option 0] [lindex $option 4]\n"
6303     "}\n"
6304     "eval $cmd\n"
6305     "set last [$src index last]\n"
6306     "if {[string equal $last \"none\"]} {\n"
6307     "return\n"
6308     "}\n"
6309     "for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {\n"
6310     "set cmd [list $dst add [$src type $i]]\n"
6311     "foreach option [$src entryconfigure $i] {\n"
6312     "lappend cmd [lindex $option 0] [lindex $option 4]\n"
6313     "}\n"
6314     "eval $cmd\n"
6315     "}\n"
6316     "set tags [bindtags $src]\n"
6317     "set srcLen [string length $src]\n"
6318     "while {[set index [string first $src $tags]] != -1} {\n"
6319     "append x [string range $tags 0 [expr {$index - 1}]]$dst\n"
6320     "set tags [string range $tags [expr {$index + $srcLen}] end]\n"
6321     "}\n"
6322     "append x $tags\n"
6323     "bindtags $dst $x\n"
6324     "foreach event [bind $src] {\n"
6325     "unset x\n"
6326     "set script [bind $src $event]\n"
6327     "set eventLen [string length $event]\n"
6328     "while {[set index [string first $event $script]] != -1} {\n"
6329     "append x [string range $script 0 [expr {$index - 1}]]\n"
6330     "append x $dst\n"
6331     "set script [string range $script [expr {$index + $eventLen}] end]\n"
6332     "}\n"
6333     "append x $script\n"
6334     "bind $dst $event $x\n"
6335     "}\n"
6336     "}\n"
6337     ;
6338     static char Et_zFile27[] =
6339     "bind Text <1> {\n"
6340     "tkTextButton1 %W %x %y\n"
6341     "%W tag remove sel 0.0 end\n"
6342     "}\n"
6343     "bind Text <B1-Motion> {\n"
6344     "set tkPriv(x) %x\n"
6345     "set tkPriv(y) %y\n"
6346     "tkTextSelectTo %W %x %y\n"
6347     "}\n"
6348     "bind Text <Double-1> {\n"
6349     "set tkPriv(selectMode) word\n"
6350     "tkTextSelectTo %W %x %y\n"
6351     "catch {%W mark set insert sel.last}\n"
6352     "catch {%W mark set anchor sel.first}\n"
6353     "}\n"
6354     "bind Text <Triple-1> {\n"
6355     "set tkPriv(selectMode) line\n"
6356     "tkTextSelectTo %W %x %y\n"
6357     "catch {%W mark set insert sel.last}\n"
6358     "catch {%W mark set anchor sel.first}\n"
6359     "}\n"
6360     "bind Text <Shift-1> {\n"
6361     "tkTextResetAnchor %W @%x,%y\n"
6362     "set tkPriv(selectMode) char\n"
6363     "tkTextSelectTo %W %x %y\n"
6364     "}\n"
6365     "bind Text <Double-Shift-1>\011{\n"
6366     "set tkPriv(selectMode) word\n"
6367     "tkTextSelectTo %W %x %y 1\n"
6368     "}\n"
6369     "bind Text <Triple-Shift-1>\011{\n"
6370     "set tkPriv(selectMode) line\n"
6371     "tkTextSelectTo %W %x %y\n"
6372     "}\n"
6373     "bind Text <B1-Leave> {\n"
6374     "set tkPriv(x) %x\n"
6375     "set tkPriv(y) %y\n"
6376     "tkTextAutoScan %W\n"
6377     "}\n"
6378     "bind Text <B1-Enter> {\n"
6379     "tkCancelRepeat\n"
6380     "}\n"
6381     "bind Text <ButtonRelease-1> {\n"
6382     "tkCancelRepeat\n"
6383     "}\n"
6384     "bind Text <Control-1> {\n"
6385     "%W mark set insert @%x,%y\n"
6386     "}\n"
6387     "bind Text <Left> {\n"
6388     "tkTextSetCursor %W insert-1c\n"
6389     "}\n"
6390     "bind Text <Right> {\n"
6391     "tkTextSetCursor %W insert+1c\n"
6392     "}\n"
6393     "bind Text <Up> {\n"
6394     "tkTextSetCursor %W [tkTextUpDownLine %W -1]\n"
6395     "}\n"
6396     "bind Text <Down> {\n"
6397     "tkTextSetCursor %W [tkTextUpDownLine %W 1]\n"
6398     "}\n"
6399     "bind Text <Shift-Left> {\n"
6400     "tkTextKeySelect %W [%W index {insert - 1c}]\n"
6401     "}\n"
6402     "bind Text <Shift-Right> {\n"
6403     "tkTextKeySelect %W [%W index {insert + 1c}]\n"
6404     "}\n"
6405     "bind Text <Shift-Up> {\n"
6406     "tkTextKeySelect %W [tkTextUpDownLine %W -1]\n"
6407     "}\n"
6408     "bind Text <Shift-Down> {\n"
6409     "tkTextKeySelect %W [tkTextUpDownLine %W 1]\n"
6410     "}\n"
6411     "bind Text <Control-Left> {\n"
6412     "tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
6413     "}\n"
6414     "bind Text <Control-Right> {\n"
6415     "tkTextSetCursor %W [tkTextNextWord %W insert]\n"
6416     "}\n"
6417     "bind Text <Control-Up> {\n"
6418     "tkTextSetCursor %W [tkTextPrevPara %W insert]\n"
6419     "}\n"
6420     "bind Text <Control-Down> {\n"
6421     "tkTextSetCursor %W [tkTextNextPara %W insert]\n"
6422     "}\n"
6423     "bind Text <Shift-Control-Left> {\n"
6424     "tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
6425     "}\n"
6426     "bind Text <Shift-Control-Right> {\n"
6427     "tkTextKeySelect %W [tkTextNextWord %W insert]\n"
6428     "}\n"
6429     "bind Text <Shift-Control-Up> {\n"
6430     "tkTextKeySelect %W [tkTextPrevPara %W insert]\n"
6431     "}\n"
6432     "bind Text <Shift-Control-Down> {\n"
6433     "tkTextKeySelect %W [tkTextNextPara %W insert]\n"
6434     "}\n"
6435     "bind Text <Prior> {\n"
6436     "tkTextSetCursor %W [tkTextScrollPages %W -1]\n"
6437     "}\n"
6438     "bind Text <Shift-Prior> {\n"
6439     "tkTextKeySelect %W [tkTextScrollPages %W -1]\n"
6440     "}\n"
6441     "bind Text <Next> {\n"
6442     "tkTextSetCursor %W [tkTextScrollPages %W 1]\n"
6443     "}\n"
6444     "bind Text <Shift-Next> {\n"
6445     "tkTextKeySelect %W [tkTextScrollPages %W 1]\n"
6446     "}\n"
6447     "bind Text <Control-Prior> {\n"
6448     "%W xview scroll -1 page\n"
6449     "}\n"
6450     "bind Text <Control-Next> {\n"
6451     "%W xview scroll 1 page\n"
6452     "}\n"
6453     "bind Text <Home> {\n"
6454     "tkTextSetCursor %W {insert linestart}\n"
6455     "}\n"
6456     "bind Text <Shift-Home> {\n"
6457     "tkTextKeySelect %W {insert linestart}\n"
6458     "}\n"
6459     "bind Text <End> {\n"
6460     "tkTextSetCursor %W {insert lineend}\n"
6461     "}\n"
6462     "bind Text <Shift-End> {\n"
6463     "tkTextKeySelect %W {insert lineend}\n"
6464     "}\n"
6465     "bind Text <Control-Home> {\n"
6466     "tkTextSetCursor %W 1.0\n"
6467     "}\n"
6468     "bind Text <Control-Shift-Home> {\n"
6469     "tkTextKeySelect %W 1.0\n"
6470     "}\n"
6471     "bind Text <Control-End> {\n"
6472     "tkTextSetCursor %W {end - 1 char}\n"
6473     "}\n"
6474     "bind Text <Control-Shift-End> {\n"
6475     "tkTextKeySelect %W {end - 1 char}\n"
6476     "}\n"
6477     "bind Text <Tab> {\n"
6478     "tkTextInsert %W \\t\n"
6479     "focus %W\n"
6480     "break\n"
6481     "}\n"
6482     "bind Text <Shift-Tab> {\n"
6483     "break\n"
6484     "}\n"
6485     "bind Text <Control-Tab> {\n"
6486     "focus [tk_focusNext %W]\n"
6487     "}\n"
6488     "bind Text <Control-Shift-Tab> {\n"
6489     "focus [tk_focusPrev %W]\n"
6490     "}\n"
6491     "bind Text <Control-i> {\n"
6492     "tkTextInsert %W \\t\n"
6493     "}\n"
6494     "bind Text <Return> {\n"
6495     "tkTextInsert %W \\n\n"
6496     "}\n"
6497     "bind Text <Delete> {\n"
6498     "if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
6499     "%W delete sel.first sel.last\n"
6500     "} else {\n"
6501     "%W delete insert\n"
6502     "%W see insert\n"
6503     "}\n"
6504     "}\n"
6505     "bind Text <BackSpace> {\n"
6506     "if {[string compare [%W tag nextrange sel 1.0 end] \"\"]} {\n"
6507     "%W delete sel.first sel.last\n"
6508     "} elseif {[%W compare insert != 1.0]} {\n"
6509     "%W delete insert-1c\n"
6510     "%W see insert\n"
6511     "}\n"
6512     "}\n"
6513     "bind Text <Control-space> {\n"
6514     "%W mark set anchor insert\n"
6515     "}\n"
6516     "bind Text <Select> {\n"
6517     "%W mark set anchor insert\n"
6518     "}\n"
6519     "bind Text <Control-Shift-space> {\n"
6520     "set tkPriv(selectMode) char\n"
6521     "tkTextKeyExtend %W insert\n"
6522     "}\n"
6523     "bind Text <Shift-Select> {\n"
6524     "set tkPriv(selectMode) char\n"
6525     "tkTextKeyExtend %W insert\n"
6526     "}\n"
6527     "bind Text <Control-slash> {\n"
6528     "%W tag add sel 1.0 end\n"
6529     "}\n"
6530     "bind Text <Control-backslash> {\n"
6531     "%W tag remove sel 1.0 end\n"
6532     "}\n"
6533     "bind Text <<Cut>> {\n"
6534     "tk_textCut %W\n"
6535     "}\n"
6536     "bind Text <<Copy>> {\n"
6537     "tk_textCopy %W\n"
6538     "}\n"
6539     "bind Text <<Paste>> {\n"
6540     "tk_textPaste %W\n"
6541     "}\n"
6542     "bind Text <<Clear>> {\n"
6543     "catch {%W delete sel.first sel.last}\n"
6544     "}\n"
6545     "bind Text <<PasteSelection>> {\n"
6546     "if {!$tkPriv(mouseMoved) || $tk_strictMotif} {\n"
6547     "tkTextPaste %W %x %y\n"
6548     "}\n"
6549     "}\n"
6550     "bind Text <Insert> {\n"
6551     "catch {tkTextInsert %W [selection get -displayof %W]}\n"
6552     "}\n"
6553     "bind Text <KeyPress> {\n"
6554     "tkTextInsert %W %A\n"
6555     "}\n"
6556     "bind Text <Alt-KeyPress> {# nothing }\n"
6557     "bind Text <Meta-KeyPress> {# nothing}\n"
6558     "bind Text <Control-KeyPress> {# nothing}\n"
6559     "bind Text <Escape> {# nothing}\n"
6560     "bind Text <KP_Enter> {# nothing}\n"
6561     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
6562     "bind Text <Command-KeyPress> {# nothing}\n"
6563     "}\n"
6564     "bind Text <Control-a> {\n"
6565     "if {!$tk_strictMotif} {\n"
6566     "tkTextSetCursor %W {insert linestart}\n"
6567     "}\n"
6568     "}\n"
6569     "bind Text <Control-b> {\n"
6570     "if {!$tk_strictMotif} {\n"
6571     "tkTextSetCursor %W insert-1c\n"
6572     "}\n"
6573     "}\n"
6574     "bind Text <Control-d> {\n"
6575     "if {!$tk_strictMotif} {\n"
6576     "%W delete insert\n"
6577     "}\n"
6578     "}\n"
6579     "bind Text <Control-e> {\n"
6580     "if {!$tk_strictMotif} {\n"
6581     "tkTextSetCursor %W {insert lineend}\n"
6582     "}\n"
6583     "}\n"
6584     "bind Text <Control-f> {\n"
6585     "if {!$tk_strictMotif} {\n"
6586     "tkTextSetCursor %W insert+1c\n"
6587     "}\n"
6588     "}\n"
6589     "bind Text <Control-k> {\n"
6590     "if {!$tk_strictMotif} {\n"
6591     "if {[%W compare insert == {insert lineend}]} {\n"
6592     "%W delete insert\n"
6593     "} else {\n"
6594     "%W delete insert {insert lineend}\n"
6595     "}\n"
6596     "}\n"
6597     "}\n"
6598     "bind Text <Control-n> {\n"
6599     "if {!$tk_strictMotif} {\n"
6600     "tkTextSetCursor %W [tkTextUpDownLine %W 1]\n"
6601     "}\n"
6602     "}\n"
6603     "bind Text <Control-o> {\n"
6604     "if {!$tk_strictMotif} {\n"
6605     "%W insert insert \\n\n"
6606     "%W mark set insert insert-1c\n"
6607     "}\n"
6608     "}\n"
6609     "bind Text <Control-p> {\n"
6610     "if {!$tk_strictMotif} {\n"
6611     "tkTextSetCursor %W [tkTextUpDownLine %W -1]\n"
6612     "}\n"
6613     "}\n"
6614     "bind Text <Control-t> {\n"
6615     "if {!$tk_strictMotif} {\n"
6616     "tkTextTranspose %W\n"
6617     "}\n"
6618     "}\n"
6619     "if {[string compare $tcl_platform(platform) \"windows\"]} {\n"
6620     "bind Text <Control-v> {\n"
6621     "if {!$tk_strictMotif} {\n"
6622     "tkTextScrollPages %W 1\n"
6623     "}\n"
6624     "}\n"
6625     "}\n"
6626     "bind Text <Meta-b> {\n"
6627     "if {!$tk_strictMotif} {\n"
6628     "tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
6629     "}\n"
6630     "}\n"
6631     "bind Text <Meta-d> {\n"
6632     "if {!$tk_strictMotif} {\n"
6633     "%W delete insert [tkTextNextWord %W insert]\n"
6634     "}\n"
6635     "}\n"
6636     "bind Text <Meta-f> {\n"
6637     "if {!$tk_strictMotif} {\n"
6638     "tkTextSetCursor %W [tkTextNextWord %W insert]\n"
6639     "}\n"
6640     "}\n"
6641     "bind Text <Meta-less> {\n"
6642     "if {!$tk_strictMotif} {\n"
6643     "tkTextSetCursor %W 1.0\n"
6644     "}\n"
6645     "}\n"
6646     "bind Text <Meta-greater> {\n"
6647     "if {!$tk_strictMotif} {\n"
6648     "tkTextSetCursor %W end-1c\n"
6649     "}\n"
6650     "}\n"
6651     "bind Text <Meta-BackSpace> {\n"
6652     "if {!$tk_strictMotif} {\n"
6653     "%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert\n"
6654     "}\n"
6655     "}\n"
6656     "bind Text <Meta-Delete> {\n"
6657     "if {!$tk_strictMotif} {\n"
6658     "%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert\n"
6659     "}\n"
6660     "}\n"
6661     "if {[string equal $tcl_platform(platform) \"macintosh\"]} {\n"
6662     "bind Text <FocusIn> {\n"
6663     "%W tag configure sel -borderwidth 0\n"
6664     "%W configure -selectbackground systemHighlight -selectforeground systemHighlightText\n"
6665     "}\n"
6666     "bind Text <FocusOut> {\n"
6667     "%W tag configure sel -borderwidth 1\n"
6668     "%W configure -selectbackground white -selectforeground black\n"
6669     "}\n"
6670     "bind Text <Option-Left> {\n"
6671     "tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
6672     "}\n"
6673     "bind Text <Option-Right> {\n"
6674     "tkTextSetCursor %W [tkTextNextWord %W insert]\n"
6675     "}\n"
6676     "bind Text <Option-Up> {\n"
6677     "tkTextSetCursor %W [tkTextPrevPara %W insert]\n"
6678     "}\n"
6679     "bind Text <Option-Down> {\n"
6680     "tkTextSetCursor %W [tkTextNextPara %W insert]\n"
6681     "}\n"
6682     "bind Text <Shift-Option-Left> {\n"
6683     "tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]\n"
6684     "}\n"
6685     "bind Text <Shift-Option-Right> {\n"
6686     "tkTextKeySelect %W [tkTextNextWord %W insert]\n"
6687     "}\n"
6688     "bind Text <Shift-Option-Up> {\n"
6689     "tkTextKeySelect %W [tkTextPrevPara %W insert]\n"
6690     "}\n"
6691     "bind Text <Shift-Option-Down> {\n"
6692     "tkTextKeySelect %W [tkTextNextPara %W insert]\n"
6693     "}\n"
6694     "}\n"
6695     "bind Text <Control-h> {\n"
6696     "if {!$tk_strictMotif} {\n"
6697     "if {[%W compare insert != 1.0]} {\n"
6698     "%W delete insert-1c\n"
6699     "%W see insert\n"
6700     "}\n"
6701     "}\n"
6702     "}\n"
6703     "bind Text <2> {\n"
6704     "if {!$tk_strictMotif} {\n"
6705     "%W scan mark %x %y\n"
6706     "set tkPriv(x) %x\n"
6707     "set tkPriv(y) %y\n"
6708     "set tkPriv(mouseMoved) 0\n"
6709     "}\n"
6710     "}\n"
6711     "bind Text <B2-Motion> {\n"
6712     "if {!$tk_strictMotif} {\n"
6713     "if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {\n"
6714     "set tkPriv(mouseMoved) 1\n"
6715     "}\n"
6716     "if {$tkPriv(mouseMoved)} {\n"
6717     "%W scan dragto %x %y\n"
6718     "}\n"
6719     "}\n"
6720     "}\n"
6721     "set tkPriv(prevPos) {}\n"
6722     "bind Text <MouseWheel> {\n"
6723     "%W yview scroll [expr {- (%D / 120) * 4}] units\n"
6724     "}\n"
6725     "if {[string equal \"unix\" $tcl_platform(platform)]} {\n"
6726     "bind Text <4> {\n"
6727     "if {!$tk_strictMotif} {\n"
6728     "%W yview scroll -5 units\n"
6729     "}\n"
6730     "}\n"
6731     "bind Text <5> {\n"
6732     "if {!$tk_strictMotif} {\n"
6733     "%W yview scroll 5 units\n"
6734     "}\n"
6735     "}\n"
6736     "}\n"
6737     "proc tkTextClosestGap {w x y} {\n"
6738     "set pos [$w index @$x,$y]\n"
6739     "set bbox [$w bbox $pos]\n"
6740     "if {[string equal $bbox \"\"]} {\n"
6741     "return $pos\n"
6742     "}\n"
6743     "if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {\n"
6744     "return $pos\n"
6745     "}\n"
6746     "$w index \"$pos + 1 char\"\n"
6747     "}\n"
6748     "proc tkTextButton1 {w x y} {\n"
6749     "global tkPriv\n"
6750     "set tkPriv(selectMode) char\n"
6751     "set tkPriv(mouseMoved) 0\n"
6752     "set tkPriv(pressX) $x\n"
6753     "$w mark set insert [tkTextClosestGap $w $x $y]\n"
6754     "$w mark set anchor insert\n"
6755     "if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
6756     "}\n"
6757     "proc tkTextSelectTo {w x y {extend 0}} {\n"
6758     "global tkPriv tcl_platform\n"
6759     "set cur [tkTextClosestGap $w $x $y]\n"
6760     "if {[catch {$w index anchor}]} {\n"
6761     "$w mark set anchor $cur\n"
6762     "}\n"
6763     "set anchor [$w index anchor]\n"
6764     "if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {\n"
6765     "set tkPriv(mouseMoved) 1\n"
6766     "}\n"
6767     "switch $tkPriv(selectMode) {\n"
6768     "char {\n"
6769     "if {[$w compare $cur < anchor]} {\n"
6770     "set first $cur\n"
6771     "set last anchor\n"
6772     "} else {\n"
6773     "set first anchor\n"
6774     "set last $cur\n"
6775     "}\n"
6776     "}\n"
6777     "word {\n"
6778     "if {[$w compare $cur < anchor]} {\n"
6779     "set first [tkTextPrevPos $w \"$cur + 1c\" tcl_wordBreakBefore]\n"
6780     "if { !$extend } {\n"
6781     "set last [tkTextNextPos $w \"anchor\" tcl_wordBreakAfter]\n"
6782     "} else {\n"
6783     "set last anchor\n"
6784     "}\n"
6785     "} else {\n"
6786     "set last [tkTextNextPos $w \"$cur - 1c\" tcl_wordBreakAfter]\n"
6787     "if { !$extend } {\n"
6788     "set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]\n"
6789     "} else {\n"
6790     "set first anchor\n"
6791     "}\n"
6792     "}\n"
6793     "}\n"
6794     "line {\n"
6795     "if {[$w compare $cur < anchor]} {\n"
6796     "set first [$w index \"$cur linestart\"]\n"
6797     "set last [$w index \"anchor - 1c lineend + 1c\"]\n"
6798     "} else {\n"
6799     "set first [$w index \"anchor linestart\"]\n"
6800     "set last [$w index \"$cur lineend + 1c\"]\n"
6801     "}\n"
6802     "}\n"
6803     "}\n"
6804     "if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) \"char\"]} {\n"
6805     "if {[string compare $tcl_platform(platform) \"unix\"] \\\n"
6806     "\011\011&& [$w compare $cur < anchor]} {\n"
6807     "$w mark set insert $first\n"
6808     "} else {\n"
6809     "$w mark set insert $last\n"
6810     "}\n"
6811     "$w tag remove sel 0.0 $first\n"
6812     "$w tag add sel $first $last\n"
6813     "$w tag remove sel $last end\n"
6814     "update idletasks\n"
6815     "}\n"
6816     "}\n"
6817     "proc tkTextKeyExtend {w index} {\n"
6818     "global tkPriv\n"
6819     "set cur [$w index $index]\n"
6820     "if {[catch {$w index anchor}]} {\n"
6821     "$w mark set anchor $cur\n"
6822     "}\n"
6823     "set anchor [$w index anchor]\n"
6824     "if {[$w compare $cur < anchor]} {\n"
6825     "set first $cur\n"
6826     "set last anchor\n"
6827     "} else {\n"
6828     "set first anchor\n"
6829     "set last $cur\n"
6830     "}\n"
6831     "$w tag remove sel 0.0 $first\n"
6832     "$w tag add sel $first $last\n"
6833     "$w tag remove sel $last end\n"
6834     "}\n"
6835     "proc tkTextPaste {w x y} {\n"
6836     "$w mark set insert [tkTextClosestGap $w $x $y]\n"
6837     "catch {$w insert insert [selection get -displayof $w]}\n"
6838     "if {[string equal [$w cget -state] \"normal\"]} {focus $w}\n"
6839     "}\n"
6840     "proc tkTextAutoScan {w} {\n"
6841     "global tkPriv\n"
6842     "if {![winfo exists $w]} return\n"
6843     "if {$tkPriv(y) >= [winfo height $w]} {\n"
6844     "$w yview scroll 2 units\n"
6845     "} elseif {$tkPriv(y) < 0} {\n"
6846     "$w yview scroll -2 units\n"
6847     "} elseif {$tkPriv(x) >= [winfo width $w]} {\n"
6848     "$w xview scroll 2 units\n"
6849     "} elseif {$tkPriv(x) < 0} {\n"
6850     "$w xview scroll -2 units\n"
6851     "} else {\n"
6852     "return\n"
6853     "}\n"
6854     "tkTextSelectTo $w $tkPriv(x) $tkPriv(y)\n"
6855     "set tkPriv(afterId) [after 50 [list tkTextAutoScan $w]]\n"
6856     "}\n"
6857     "proc tkTextSetCursor {w pos} {\n"
6858     "global tkPriv\n"
6859     "if {[$w compare $pos == end]} {\n"
6860     "set pos {end - 1 chars}\n"
6861     "}\n"
6862     "$w mark set insert $pos\n"
6863     "$w tag remove sel 1.0 end\n"
6864     "$w see insert\n"
6865     "}\n"
6866     "proc tkTextKeySelect {w new} {\n"
6867     "global tkPriv\n"
6868     "if {[string equal [$w tag nextrange sel 1.0 end] \"\"]} {\n"
6869     "if {[$w compare $new < insert]} {\n"
6870     "$w tag add sel $new insert\n"
6871     "} else {\n"
6872     "$w tag add sel insert $new\n"
6873     "}\n"
6874     "$w mark set anchor insert\n"
6875     "} else {\n"
6876     "if {[$w compare $new < anchor]} {\n"
6877     "set first $new\n"
6878     "set last anchor\n"
6879     "} else {\n"
6880     "set first anchor\n"
6881     "set last $new\n"
6882     "}\n"
6883     "$w tag remove sel 1.0 $first\n"
6884     "$w tag add sel $first $last\n"
6885     "$w tag remove sel $last end\n"
6886     "}\n"
6887     "$w mark set insert $new\n"
6888     "$w see insert\n"
6889     "update idletasks\n"
6890     "}\n"
6891     "proc tkTextResetAnchor {w index} {\n"
6892     "global tkPriv\n"
6893     "if {[string equal [$w tag ranges sel] \"\"]} {\n"
6894     "$w mark set anchor $index\n"
6895     "return\n"
6896     "}\n"
6897     "set a [$w index $index]\n"
6898     "set b [$w index sel.first]\n"
6899     "set c [$w index sel.last]\n"
6900     "if {[$w compare $a < $b]} {\n"
6901     "$w mark set anchor sel.last\n"
6902     "return\n"
6903     "}\n"
6904     "if {[$w compare $a > $c]} {\n"
6905     "$w mark set anchor sel.first\n"
6906     "return\n"
6907     "}\n"
6908     "scan $a \"%d.%d\" lineA chA\n"
6909     "scan $b \"%d.%d\" lineB chB\n"
6910     "scan $c \"%d.%d\" lineC chC\n"
6911     "if {$lineB < $lineC+2} {\n"
6912     "set total [string length [$w get $b $c]]\n"
6913     "if {$total <= 2} {\n"
6914     "return\n"
6915     "}\n"
6916     "if {[string length [$w get $b $a]] < ($total/2)} {\n"
6917     "$w mark set anchor sel.last\n"
6918     "} else {\n"
6919     "$w mark set anchor sel.first\n"
6920     "}\n"
6921     "return\n"
6922     "}\n"
6923     "if {($lineA-$lineB) < ($lineC-$lineA)} {\n"
6924     "$w mark set anchor sel.last\n"
6925     "} else {\n"
6926     "$w mark set anchor sel.first\n"
6927     "}\n"
6928     "}\n"
6929     "proc tkTextInsert {w s} {\n"
6930     "if {[string equal $s \"\"] || [string equal [$w cget -state] \"disabled\"]} {\n"
6931     "return\n"
6932     "}\n"
6933     "catch {\n"
6934     "if {[$w compare sel.first <= insert] \\\n"
6935     "\011\011&& [$w compare sel.last >= insert]} {\n"
6936     "$w delete sel.first sel.last\n"
6937     "}\n"
6938     "}\n"
6939     "$w insert insert $s\n"
6940     "$w see insert\n"
6941     "}\n"
6942     "proc tkTextUpDownLine {w n} {\n"
6943     "global tkPriv\n"
6944     "set i [$w index insert]\n"
6945     "scan $i \"%d.%d\" line char\n"
6946     "if {[string compare $tkPriv(prevPos) $i]} {\n"
6947     "set tkPriv(char) $char\n"
6948     "}\n"
6949     "set new [$w index [expr {$line + $n}].$tkPriv(char)]\n"
6950     "if {[$w compare $new == end] || [$w compare $new == \"insert linestart\"]} {\n"
6951     "set new $i\n"
6952     "}\n"
6953     "set tkPriv(prevPos) $new\n"
6954     "return $new\n"
6955     "}\n"
6956     "proc tkTextPrevPara {w pos} {\n"
6957     "set pos [$w index \"$pos linestart\"]\n"
6958     "while {1} {\n"
6959     "if {([string equal [$w get \"$pos - 1 line\"] \"\\n\"] \\\n"
6960     "\011\011&& [string compare [$w get $pos] \"\\n\"]) \\\n"
6961     "\011\011|| [string equal $pos \"1.0\"]} {\n"
6962     "if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n"
6963     "\011\011 dummy index]} {\n"
6964     "set pos [$w index \"$pos + [lindex $index 0] chars\"]\n"
6965     "}\n"
6966     "if {[$w compare $pos != insert] || [string equal $pos 1.0]} {\n"
6967     "return $pos\n"
6968     "}\n"
6969     "}\n"
6970     "set pos [$w index \"$pos - 1 line\"]\n"
6971     "}\n"
6972     "}\n"
6973     "proc tkTextNextPara {w start} {\n"
6974     "set pos [$w index \"$start linestart + 1 line\"]\n"
6975     "while {[string compare [$w get $pos] \"\\n\"]} {\n"
6976     "if {[$w compare $pos == end]} {\n"
6977     "return [$w index \"end - 1c\"]\n"
6978     "}\n"
6979     "set pos [$w index \"$pos + 1 line\"]\n"
6980     "}\n"
6981     "while {[string equal [$w get $pos] \"\\n\"]} {\n"
6982     "set pos [$w index \"$pos + 1 line\"]\n"
6983     "if {[$w compare $pos == end]} {\n"
6984     "return [$w index \"end - 1c\"]\n"
6985     "}\n"
6986     "}\n"
6987     "if {[regexp -indices {^[ \011]+(.)} [$w get $pos \"$pos lineend\"] \\\n"
6988     "\011 dummy index]} {\n"
6989     "return [$w index \"$pos + [lindex $index 0] chars\"]\n"
6990     "}\n"
6991     "return $pos\n"
6992     "}\n"
6993     "proc tkTextScrollPages {w count} {\n"
6994     "set bbox [$w bbox insert]\n"
6995     "$w yview scroll $count pages\n"
6996     "if {[string equal $bbox \"\"]} {\n"
6997     "return [$w index @[expr {[winfo height $w]/2}],0]\n"
6998     "}\n"
6999     "return [$w index @[lindex $bbox 0],[lindex $bbox 1]]\n"
7000     "}\n"
7001     "proc tkTextTranspose w {\n"
7002     "set pos insert\n"
7003     "if {[$w compare $pos != \"$pos lineend\"]} {\n"
7004     "set pos [$w index \"$pos + 1 char\"]\n"
7005     "}\n"
7006     "set new [$w get \"$pos - 1 char\"][$w get \"$pos - 2 char\"]\n"
7007     "if {[$w compare \"$pos - 1 char\" == 1.0]} {\n"
7008     "return\n"
7009     "}\n"
7010     "$w delete \"$pos - 2 char\" $pos\n"
7011     "$w insert insert $new\n"
7012     "$w see insert\n"
7013     "}\n"
7014     "proc tk_textCopy w {\n"
7015     "if {![catch {set data [$w get sel.first sel.last]}]} {\n"
7016     "clipboard clear -displayof $w\n"
7017     "clipboard append -displayof $w $data\n"
7018     "}\n"
7019     "}\n"
7020     "proc tk_textCut w {\n"
7021     "if {![catch {set data [$w get sel.first sel.last]}]} {\n"
7022     "clipboard clear -displayof $w\n"
7023     "clipboard append -displayof $w $data\n"
7024     "$w delete sel.first sel.last\n"
7025     "}\n"
7026     "}\n"
7027     "proc tk_textPaste w {\n"
7028     "global tcl_platform\n"
7029     "catch {\n"
7030     "if {[string compare $tcl_platform(platform) \"unix\"]} {\n"
7031     "catch {\n"
7032     "$w delete sel.first sel.last\n"
7033     "}\n"
7034     "}\n"
7035     "$w insert insert [selection get -displayof $w -selection CLIPBOARD]\n"
7036     "}\n"
7037     "}\n"
7038     "if {[string equal $tcl_platform(platform) \"windows\"]} {\n"
7039     "proc tkTextNextWord {w start} {\n"
7040     "tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \\\n"
7041     "\011 tcl_startOfNextWord\n"
7042     "}\n"
7043     "} else {\n"
7044     "proc tkTextNextWord {w start} {\n"
7045     "tkTextNextPos $w $start tcl_endOfWord\n"
7046     "}\n"
7047     "}\n"
7048     "proc tkTextNextPos {w start op} {\n"
7049     "set text \"\"\n"
7050     "set cur $start\n"
7051     "while {[$w compare $cur < end]} {\n"
7052     "set text $text[$w get $cur \"$cur lineend + 1c\"]\n"
7053     "set pos [$op $text 0]\n"
7054     "if {$pos >= 0} {\n"
7055     "set dump [$w dump -image -window $start \"$start + $pos c\"]\n"
7056     "if {[llength $dump]} {\n"
7057     "set pos [expr {$pos + ([llength $dump]/3)}]\n"
7058     "}\n"
7059     "return [$w index \"$start + $pos c\"]\n"
7060     "}\n"
7061     "set cur [$w index \"$cur lineend +1c\"]\n"
7062     "}\n"
7063     "return end\n"
7064     "}\n"
7065     "proc tkTextPrevPos {w start op} {\n"
7066     "set text \"\"\n"
7067     "set cur $start\n"
7068     "while {[$w compare $cur > 0.0]} {\n"
7069     "set text [$w get \"$cur linestart - 1c\" $cur]$text\n"
7070     "set pos [$op $text end]\n"
7071     "if {$pos >= 0} {\n"
7072     "set dump [$w dump -image -window \"$cur linestart\" \"$start - 1c\"]\n"
7073     "if {[llength $dump]} {\n"
7074     "if {[$w compare [lindex $dump 2] > \\\n"
7075     "\011\011\011\"$cur linestart - 1c + $pos c\"]} {\n"
7076     "incr pos -1\n"
7077     "}\n"
7078     "set pos [expr {$pos + ([llength $dump]/3)}]\n"
7079     "}\n"
7080     "return [$w index \"$cur linestart - 1c + $pos c\"]\n"
7081     "}\n"
7082     "set cur [$w index \"$cur linestart - 1c\"]\n"
7083     "}\n"
7084     "return 0.0\n"
7085     "}\n"
7086     ;
7087     static char Et_zFile28[] =
7088     "package require -exact Tk 8.3\n"
7089     "package require -exact Tcl 8.3\n"
7090     "if {[info exists auto_path] && [string compare {} $tk_library] && \\\n"
7091     "\011[lsearch -exact $auto_path $tk_library] < 0} {\n"
7092     "lappend auto_path $tk_library\n"
7093     "}\n"
7094     "set tk_strictMotif 0\n"
7095     "namespace eval ::tk {\n"
7096     "}\n"
7097     "proc ::tk::PlaceWindow {w {place \"\"} {anchor \"\"}} {\n"
7098     "wm withdraw $w\n"
7099     "update idletasks\n"
7100     "set checkBounds 1\n"
7101     "if {[string equal -len [string length $place] $place \"pointer\"]} {\n"
7102     "if {[string equal -len [string length $anchor] $anchor \"center\"]} {\n"
7103     "set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]\n"
7104     "set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]\n"
7105     "} else {\n"
7106     "set x [winfo pointerx $w]\n"
7107     "set y [winfo pointery $w]\n"
7108     "}\n"
7109     "} elseif {[string equal -len [string length $place] $place \"widget\"] && \\\n"
7110     "\011 [winfo exists $anchor] && [winfo ismapped $anchor]} {\n"
7111     "set x [expr {[winfo rootx $anchor] + \\\n"
7112     "\011\011([winfo width $anchor]-[winfo reqwidth $w])/2}]\n"
7113     "set y [expr {[winfo rooty $anchor] + \\\n"
7114     "\011\011([winfo height $anchor]-[winfo reqheight $w])/2}]\n"
7115     "} else {\n"
7116     "set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]\n"
7117     "set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]\n"
7118     "set checkBounds 0\n"
7119     "}\n"
7120     "if {$checkBounds} {\n"
7121     "if {$x < 0} {\n"
7122     "set x 0\n"
7123     "} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {\n"
7124     "set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]\n"
7125     "}\n"
7126     "if {$y < 0} {\n"
7127     "set y 0\n"
7128     "} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {\n"
7129     "set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]\n"
7130     "}\n"
7131     "}\n"
7132     "wm geometry $w +$x+$y\n"
7133     "wm deiconify $w\n"
7134     "}\n"
7135     "proc ::tk::SetFocusGrab {grab {focus {}}} {\n"
7136     "set index \"$grab,$focus\"\n"
7137     "upvar ::tk::FocusGrab($index) data\n"
7138     "lappend data [focus]\n"
7139     "set oldGrab [grab current $grab]\n"
7140     "lappend data $oldGrab\n"
7141     "if {[winfo exists $oldGrab]} {\n"
7142     "lappend data [grab status $oldGrab]\n"
7143     "}\n"
7144     "grab $grab\n"
7145     "if {[winfo exists $focus]} {\n"
7146     "focus $focus\n"
7147     "}\n"
7148     "}\n"
7149     "proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {\n"
7150     "set index \"$grab,$focus\"\n"
7151     "foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }\n"
7152     "unset ::tk::FocusGrab($index)\n"
7153     "catch {focus $oldFocus}\n"
7154     "grab release $grab\n"
7155     "if {[string equal $destroy \"withdraw\"]} {\n"
7156     "wm withdraw $grab\n"
7157     "} else {\n"
7158     "destroy $grab\n"
7159     "}\n"
7160     "if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {\n"
7161     "if {[string equal $oldStatus \"global\"]} {\n"
7162     "grab -global $oldGrab\n"
7163     "} else {\n"
7164     "grab $oldGrab\n"
7165     "}\n"
7166     "}\n"
7167     "}\n"
7168     "proc tkScreenChanged screen {\n"
7169     "set x [string last . $screen]\n"
7170     "if {$x > 0} {\n"
7171     "set disp [string range $screen 0 [expr {$x - 1}]]\n"
7172     "} else {\n"
7173     "set disp $screen\n"
7174     "}\n"
7175     "uplevel #0 upvar #0 tkPriv.$disp tkPriv\n"
7176     "global tkPriv\n"
7177     "global tcl_platform\n"
7178     "if {[info exists tkPriv]} {\n"
7179     "set tkPriv(screen) $screen\n"
7180     "return\n"
7181     "}\n"
7182     "array set tkPriv {\n"
7183     "activeMenu\011{}\n"
7184     "activeItem\011{}\n"
7185     "afterId\011\011{}\n"
7186     "buttons\011\0110\n"
7187     "buttonWindow\011{}\n"
7188     "dragging\0110\n"
7189     "focus\011\011{}\n"
7190     "grab\011\011{}\n"
7191     "initPos\011\011{}\n"
7192     "inMenubutton\011{}\n"
7193     "listboxPrev\011{}\n"
7194     "menuBar\011\011{}\n"
7195     "mouseMoved\0110\n"
7196     "oldGrab\011\011{}\n"
7197     "popup\011\011{}\n"
7198     "postedMb\011{}\n"
7199     "pressX\011\0110\n"
7200     "pressY\011\0110\n"
7201     "prevPos\011\0110\n"
7202     "selectMode\011char\n"
7203     "}\n"
7204     "set tkPriv(screen) $screen\n"
7205     "set tkPriv(tearoff) [string equal $tcl_platform(platform) \"unix\"]\n"
7206     "set tkPriv(window) {}\n"
7207     "}\n"
7208     "tkScreenChanged [winfo screen .]\n"
7209     "proc tkEventMotifBindings {n1 dummy dummy} {\n"
7210     "upvar $n1 name\n"
7211     "if {$name} {\n"
7212     "set op delete\n"
7213     "} else {\n"
7214     "set op add\n"
7215     "}\n"
7216     "event $op <<Cut>> <Control-Key-w>\n"
7217     "event $op <<Copy>> <Meta-Key-w> \n"
7218     "event $op <<Paste>> <Control-Key-y>\n"
7219     "}\n"
7220     "if {[string equal [info commands tk_chooseColor] \"\"]} {\n"
7221     "proc tk_chooseColor {args} {\n"
7222     "return [eval tkColorDialog $args]\n"
7223     "}\n"
7224     "}\n"
7225     "if {[string equal [info commands tk_getOpenFile] \"\"]} {\n"
7226     "proc tk_getOpenFile {args} {\n"
7227     "if {$::tk_strictMotif} {\n"
7228     "return [eval tkMotifFDialog open $args]\n"
7229     "} else {\n"
7230     "return [eval ::tk::dialog::file::tkFDialog open $args]\n"
7231     "}\n"
7232     "}\n"
7233     "}\n"
7234     "if {[string equal [info commands tk_getSaveFile] \"\"]} {\n"
7235     "proc tk_getSaveFile {args} {\n"
7236     "if {$::tk_strictMotif} {\n"
7237     "return [eval tkMotifFDialog save $args]\n"
7238     "} else {\n"
7239     "return [eval ::tk::dialog::file::tkFDialog save $args]\n"
7240     "}\n"
7241     "}\n"
7242     "}\n"
7243     "if {[string equal [info commands tk_messageBox] \"\"]} {\n"
7244     "proc tk_messageBox {args} {\n"
7245     "return [eval tkMessageBox $args]\n"
7246     "}\n"
7247     "}\n"
7248     "if {[string equal [info command tk_chooseDirectory] \"\"]} {\n"
7249     "proc tk_chooseDirectory {args} {\n"
7250     "return [eval ::tk::dialog::file::chooseDir::tkChooseDirectory $args]\n"
7251     "}\n"
7252     "}\n"
7253     "switch $tcl_platform(platform) {\n"
7254     "\"unix\" {\n"
7255     "event add <<Cut>> <Control-Key-x> <Key-F20> \n"
7256     "event add <<Copy>> <Control-Key-c> <Key-F16>\n"
7257     "event add <<Paste>> <Control-Key-v> <Key-F18>\n"
7258     "event add <<PasteSelection>> <ButtonRelease-2>\n"
7259     "if {[info exists tcl_platform(os)]} {\n"
7260     "switch $tcl_platform(os) {\n"
7261     "\"IRIX\" -\n"
7262     "\"Linux\" { event add <<PrevWindow>> <ISO_Left_Tab> }\n"
7263     "\"HP-UX\" { event add <<PrevWindow>> <hpBackTab> }\n"
7264     "}\n"
7265     "}\n"
7266     "trace variable tk_strictMotif w tkEventMotifBindings\n"
7267     "set tk_strictMotif $tk_strictMotif\n"
7268     "}\n"
7269     "\"windows\" {\n"
7270     "event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>\n"
7271     "event add <<Copy>> <Control-Key-c> <Control-Key-Insert>\n"
7272     "event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>\n"
7273     "event add <<PasteSelection>> <ButtonRelease-2>\n"
7274     "}\n"
7275     "\"macintosh\" {\n"
7276     "event add <<Cut>> <Control-Key-x> <Key-F2> \n"
7277     "event add <<Copy>> <Control-Key-c> <Key-F3>\n"
7278     "event add <<Paste>> <Control-Key-v> <Key-F4>\n"
7279     "event add <<PasteSelection>> <ButtonRelease-2>\n"
7280     "event add <<Clear>> <Clear>\n"
7281     "}\n"
7282     "}\n"
7283     "if {[string compare $tcl_platform(platform) \"macintosh\"] && \\\n"
7284     "\011[string compare {} $tk_library]} {\n"
7285     "source [file join $tk_library button.tcl]\n"
7286     "source [file join $tk_library entry.tcl]\n"
7287     "source [file join $tk_library listbox.tcl]\n"
7288     "source [file join $tk_library menu.tcl]\n"
7289     "source [file join $tk_library scale.tcl]\n"
7290     "source [file join $tk_library scrlbar.tcl]\n"
7291     "source [file join $tk_library text.tcl]\n"
7292     "}\n"
7293     "event add <<PrevWindow>> <Shift-Tab>\n"
7294     "bind all <Tab> {tkTabToWindow [tk_focusNext %W]}\n"
7295     "bind all <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}\n"
7296     "proc tkCancelRepeat {} {\n"
7297     "global tkPriv\n"
7298     "after cancel $tkPriv(afterId)\n"
7299     "set tkPriv(afterId) {}\n"
7300     "}\n"
7301     "proc tkTabToWindow {w} {\n"
7302     "if {[string equal [winfo class $w] Entry]} {\n"
7303     "$w selection range 0 end\n"
7304     "$w icursor end\n"
7305     "}\n"
7306     "focus $w\n"
7307     "}\n"
7308     ;
7309     static char Et_zFile29[] =
7310     "proc tkIconList {w args} {\n"
7311     "upvar #0 $w data\n"
7312     "tkIconList_Config $w $args\n"
7313     "tkIconList_Create $w\n"
7314     "}\n"
7315     "proc tkIconList_Config {w argList} {\n"
7316     "upvar #0 $w data\n"
7317     "set specs {\n"
7318     "{-browsecmd \"\" \"\" \"\"}\n"
7319     "{-command \"\" \"\" \"\"}\n"
7320     "}\n"
7321     "tclParseConfigSpec $w $specs \"\" $argList\n"
7322     "}\n"
7323     "proc tkIconList_Create {w} {\n"
7324     "upvar #0 $w data\n"
7325     "frame $w\n"
7326     "set data(sbar) [scrollbar $w.sbar -orient horizontal \\\n"
7327     "\011-highlightthickness 0 -takefocus 0]\n"
7328     "set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \\\n"
7329     "\011-width 400 -height 120 -takefocus 1]\n"
7330     "pack $data(sbar) -side bottom -fill x -padx 2\n"
7331     "pack $data(canvas) -expand yes -fill both\n"
7332     "$data(sbar) config -command [list $data(canvas) xview]\n"
7333     "$data(canvas) config -xscrollcommand [list $data(sbar) set]\n"
7334     "set data(maxIW) 1\n"
7335     "set data(maxIH) 1\n"
7336     "set data(maxTW) 1\n"
7337     "set data(maxTH) 1\n"
7338     "set data(numItems) 0\n"
7339     "set data(curItem) {}\n"
7340     "set data(noScroll) 1\n"
7341     "bind $data(canvas) <Configure>\011[list tkIconList_Arrange $w]\n"
7342     "bind $data(canvas) <1>\011\011[list tkIconList_Btn1 $w %x %y]\n"
7343     "bind $data(canvas) <B1-Motion>\011[list tkIconList_Motion1 $w %x %y]\n"
7344     "bind $data(canvas) <B1-Leave>\011[list tkIconList_Leave1 $w %x %y]\n"
7345     "bind $data(canvas) <B1-Enter>\011[list tkCancelRepeat]\n"
7346     "bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat]\n"
7347     "bind $data(canvas) <Double-ButtonRelease-1> \\\n"
7348     "\011 [list tkIconList_Double1 $w %x %y]\n"
7349     "bind $data(canvas) <Up>\011\011[list tkIconList_UpDown $w -1]\n"
7350     "bind $data(canvas) <Down>\011\011[list tkIconList_UpDown $w 1]\n"
7351     "bind $data(canvas) <Left>\011\011[list tkIconList_LeftRight $w -1]\n"
7352     "bind $data(canvas) <Right>\011\011[list tkIconList_LeftRight $w 1]\n"
7353     "bind $data(canvas) <Return>\011\011[list tkIconList_ReturnKey $w]\n"
7354     "bind $data(canvas) <KeyPress>\011[list tkIconList_KeyPress $w %A]\n"
7355     "bind $data(canvas) <Control-KeyPress> \";\"\n"
7356     "bind $data(canvas) <Alt-KeyPress>\011\";\"\n"
7357     "bind $data(canvas) <FocusIn>\011[list tkIconList_FocusIn $w]\n"
7358     "return $w\n"
7359     "}\n"
7360     "proc tkIconList_AutoScan {w} {\n"
7361     "upvar #0 $w data\n"
7362     "global tkPriv\n"
7363     "if {![winfo exists $w]} return\n"
7364     "set x $tkPriv(x)\n"
7365     "set y $tkPriv(y)\n"
7366     "if {$data(noScroll)} {\n"
7367     "return\n"
7368     "}\n"
7369     "if {$x >= [winfo width $data(canvas)]} {\n"
7370     "$data(canvas) xview scroll 1 units\n"
7371     "} elseif {$x < 0} {\n"
7372     "$data(canvas) xview scroll -1 units\n"
7373     "} elseif {$y >= [winfo height $data(canvas)]} {\n"
7374     "} elseif {$y < 0} {\n"
7375     "} else {\n"
7376     "return\n"
7377     "}\n"
7378     "tkIconList_Motion1 $w $x $y\n"
7379     "set tkPriv(afterId) [after 50 [list tkIconList_AutoScan $w]]\n"
7380     "}\n"
7381     "proc tkIconList_DeleteAll {w} {\n"
7382     "upvar #0 $w data\n"
7383     "upvar #0 $w:itemList itemList\n"
7384     "$data(canvas) delete all\n"
7385     "catch {unset data(selected)}\n"
7386     "catch {unset data(rect)}\n"
7387     "catch {unset data(list)}\n"
7388     "catch {unset itemList}\n"
7389     "set data(maxIW) 1\n"
7390     "set data(maxIH) 1\n"
7391     "set data(maxTW) 1\n"
7392     "set data(maxTH) 1\n"
7393     "set data(numItems) 0\n"
7394     "set data(curItem) {}\n"
7395     "set data(noScroll) 1\n"
7396     "$data(sbar) set 0.0 1.0\n"
7397     "$data(canvas) xview moveto 0\n"
7398     "}\n"
7399     "proc tkIconList_Add {w image text} {\n"
7400     "upvar #0 $w data\n"
7401     "upvar #0 $w:itemList itemList\n"
7402     "upvar #0 $w:textList textList\n"
7403     "set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]\n"
7404     "set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \\\n"
7405     "\011-font $data(font)]\n"
7406     "set rTag [$data(canvas) create rect 0 0 0 0 -fill \"\" -outline \"\"]\n"
7407     "set b [$data(canvas) bbox $iTag]\n"
7408     "set iW [expr {[lindex $b 2]-[lindex $b 0]}]\n"
7409     "set iH [expr {[lindex $b 3]-[lindex $b 1]}]\n"
7410     "if {$data(maxIW) < $iW} {\n"
7411     "set data(maxIW) $iW\n"
7412     "}\n"
7413     "if {$data(maxIH) < $iH} {\n"
7414     "set data(maxIH) $iH\n"
7415     "}\n"
7416     "set b [$data(canvas) bbox $tTag]\n"
7417     "set tW [expr {[lindex $b 2]-[lindex $b 0]}]\n"
7418     "set tH [expr {[lindex $b 3]-[lindex $b 1]}]\n"
7419     "if {$data(maxTW) < $tW} {\n"
7420     "set data(maxTW) $tW\n"
7421     "}\n"
7422     "if {$data(maxTH) < $tH} {\n"
7423     "set data(maxTH) $tH\n"
7424     "}\n"
7425     "lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]\n"
7426     "set itemList($rTag) [list $iTag $tTag $text $data(numItems)]\n"
7427     "set textList($data(numItems)) [string tolower $text]\n"
7428     "incr data(numItems)\n"
7429     "}\n"
7430     "proc tkIconList_Arrange {w} {\n"
7431     "upvar #0 $w data\n"
7432     "if {![info exists data(list)]} {\n"
7433     "if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {\n"
7434     "set data(noScroll) 1\n"
7435     "$data(sbar) config -command \"\"\n"
7436     "}\n"
7437     "return\n"
7438     "}\n"
7439     "set W [winfo width $data(canvas)]\n"
7440     "set H [winfo height $data(canvas)]\n"
7441     "set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n"
7442     "\011 [$data(canvas) cget -bd]}]\n"
7443     "if {$pad < 2} {\n"
7444     "set pad 2\n"
7445     "}\n"
7446     "incr W -[expr {$pad*2}]\n"
7447     "incr H -[expr {$pad*2}]\n"
7448     "set dx [expr {$data(maxIW) + $data(maxTW) + 8}]\n"
7449     "if {$data(maxTH) > $data(maxIH)} {\n"
7450     "set dy $data(maxTH)\n"
7451     "} else {\n"
7452     "set dy $data(maxIH)\n"
7453     "}\n"
7454     "incr dy 2\n"
7455     "set shift [expr {$data(maxIW) + 4}]\n"
7456     "set x [expr {$pad * 2}]\n"
7457     "set y [expr {$pad * 1}] ; # Why * 1 ?\n"
7458     "set usedColumn 0\n"
7459     "foreach sublist $data(list) {\n"
7460     "set usedColumn 1\n"
7461     "set iTag [lindex $sublist 0]\n"
7462     "set tTag [lindex $sublist 1]\n"
7463     "set rTag [lindex $sublist 2]\n"
7464     "set iW [lindex $sublist 3]\n"
7465     "set iH [lindex $sublist 4]\n"
7466     "set tW [lindex $sublist 5]\n"
7467     "set tH [lindex $sublist 6]\n"
7468     "set i_dy [expr {($dy - $iH)/2}]\n"
7469     "set t_dy [expr {($dy - $tH)/2}]\n"
7470     "$data(canvas) coords $iTag $x [expr {$y + $i_dy}]\n"
7471     "$data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]\n"
7472     "$data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]\n"
7473     "$data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]\n"
7474     "incr y $dy\n"
7475     "if {($y + $dy) > $H} {\n"
7476     "set y [expr {$pad * 1}] ; # *1 ?\n"
7477     "incr x $dx\n"
7478     "set usedColumn 0\n"
7479     "}\n"
7480     "}\n"
7481     "if {$usedColumn} {\n"
7482     "set sW [expr {$x + $dx}]\n"
7483     "} else {\n"
7484     "set sW $x\n"
7485     "}\n"
7486     "if {$sW < $W} {\n"
7487     "$data(canvas) config -scrollregion [list $pad $pad $sW $H]\n"
7488     "$data(sbar) config -command \"\"\n"
7489     "$data(canvas) xview moveto 0\n"
7490     "set data(noScroll) 1\n"
7491     "} else {\n"
7492     "$data(canvas) config -scrollregion [list $pad $pad $sW $H]\n"
7493     "$data(sbar) config -command [list $data(canvas) xview]\n"
7494     "set data(noScroll) 0\n"
7495     "}\n"
7496     "set data(itemsPerColumn) [expr {($H-$pad)/$dy}]\n"
7497     "if {$data(itemsPerColumn) < 1} {\n"
7498     "set data(itemsPerColumn) 1\n"
7499     "}\n"
7500     "if {$data(curItem) != \"\"} {\n"
7501     "tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0\n"
7502     "}\n"
7503     "}\n"
7504     "proc tkIconList_Invoke {w} {\n"
7505     "upvar #0 $w data\n"
7506     "if {$data(-command) != \"\" && [info exists data(selected)]} {\n"
7507     "uplevel #0 $data(-command)\n"
7508     "}\n"
7509     "}\n"
7510     "proc tkIconList_See {w rTag} {\n"
7511     "upvar #0 $w data\n"
7512     "upvar #0 $w:itemList itemList\n"
7513     "if {$data(noScroll)} {\n"
7514     "return\n"
7515     "}\n"
7516     "set sRegion [$data(canvas) cget -scrollregion]\n"
7517     "if {[string equal $sRegion {}]} {\n"
7518     "return\n"
7519     "}\n"
7520     "if {![info exists itemList($rTag)]} {\n"
7521     "return\n"
7522     "}\n"
7523     "set bbox [$data(canvas) bbox $rTag]\n"
7524     "set pad [expr {[$data(canvas) cget -highlightthickness] + \\\n"
7525     "\011 [$data(canvas) cget -bd]}]\n"
7526     "set x1 [lindex $bbox 0]\n"
7527     "set x2 [lindex $bbox 2]\n"
7528     "incr x1 -[expr {$pad * 2}]\n"
7529     "incr x2 -[expr {$pad * 1}] ; # *1 ?\n"
7530     "set cW [expr {[winfo width $data(canvas)] - $pad*2}]\n"
7531     "set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]\n"
7532     "set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]\n"
7533     "set oldDispX $dispX\n"
7534     "if {($x2 - $dispX) >= $cW} {\n"
7535     "set dispX [expr {$x2 - $cW}]\n"
7536     "}\n"
7537     "if {($x1 - $dispX) < 0} {\n"
7538     "set dispX $x1\n"
7539     "}\n"
7540     "if {$oldDispX != $dispX} {\n"
7541     "set fraction [expr {double($dispX)/double($scrollW)}]\n"
7542     "$data(canvas) xview moveto $fraction\n"
7543     "}\n"
7544     "}\n"
7545     "proc tkIconList_SelectAtXY {w x y} {\n"
7546     "upvar #0 $w data\n"
7547     "tkIconList_Select $w [$data(canvas) find closest \\\n"
7548     "\011 [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]\n"
7549     "}\n"
7550     "proc tkIconList_Select {w rTag {callBrowse 1}} {\n"
7551     "upvar #0 $w data\n"
7552     "upvar #0 $w:itemList itemList\n"
7553     "if {![info exists itemList($rTag)]} {\n"
7554     "return\n"
7555     "}\n"
7556     "set iTag [lindex $itemList($rTag) 0]\n"
7557     "set tTag [lindex $itemList($rTag) 1]\n"
7558     "set text [lindex $itemList($rTag) 2]\n"
7559     "set serial [lindex $itemList($rTag) 3]\n"
7560     "if {![info exists data(rect)]} {\n"
7561     "set data(rect) [$data(canvas) create rect 0 0 0 0 \\\n"
7562     "\011\011-fill #a0a0ff -outline #a0a0ff]\n"
7563     "}\n"
7564     "$data(canvas) lower $data(rect)\n"
7565     "set bbox [$data(canvas) bbox $tTag]\n"
7566     "eval [list $data(canvas) coords $data(rect)] $bbox\n"
7567     "set data(curItem) $serial\n"
7568     "set data(selected) $text\n"
7569     "if {$callBrowse && $data(-browsecmd) != \"\"} {\n"
7570     "eval $data(-browsecmd) [list $text]\n"
7571     "}\n"
7572     "}\n"
7573     "proc tkIconList_Unselect {w} {\n"
7574     "upvar #0 $w data\n"
7575     "if {[info exists data(rect)]} {\n"
7576     "$data(canvas) delete $data(rect)\n"
7577     "unset data(rect)\n"
7578     "}\n"
7579     "if {[info exists data(selected)]} {\n"
7580     "unset data(selected)\n"
7581     "}\n"
7582     "#set data(curItem) {}\n"
7583     "}\n"
7584     "proc tkIconList_Get {w} {\n"
7585     "upvar #0 $w data\n"
7586     "if {[info exists data(selected)]} {\n"
7587     "return $data(selected)\n"
7588     "} else {\n"
7589     "return \"\"\n"
7590     "}\n"
7591     "}\n"
7592     "proc tkIconList_Btn1 {w x y} {\n"
7593     "upvar #0 $w data\n"
7594     "focus $data(canvas)\n"
7595     "tkIconList_SelectAtXY $w $x $y\n"
7596     "}\n"
7597     "proc tkIconList_Motion1 {w x y} {\n"
7598     "global tkPriv\n"
7599     "set tkPriv(x) $x\n"
7600     "set tkPriv(y) $y\n"
7601     "tkIconList_SelectAtXY $w $x $y\n"
7602     "}\n"
7603     "proc tkIconList_Double1 {w x y} {\n"
7604     "upvar #0 $w data\n"
7605     "if {[string compare $data(curItem) {}]} {\n"
7606     "tkIconList_Invoke $w\n"
7607     "}\n"
7608     "}\n"
7609     "proc tkIconList_ReturnKey {w} {\n"
7610     "tkIconList_Invoke $w\n"
7611     "}\n"
7612     "proc tkIconList_Leave1 {w x y} {\n"
7613     "global tkPriv\n"
7614     "set tkPriv(x) $x\n"
7615     "set tkPriv(y) $y\n"
7616     "tkIconList_AutoScan $w\n"
7617     "}\n"
7618     "proc tkIconList_FocusIn {w} {\n"
7619     "upvar #0 $w data\n"
7620     "if {![info exists data(list)]} {\n"
7621     "return\n"
7622     "}\n"
7623     "if {[string compare $data(curItem) {}]} {\n"
7624     "tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 1\n"
7625     "}\n"
7626     "}\n"
7627     "proc tkIconList_UpDown {w amount} {\n"
7628     "upvar #0 $w data\n"
7629     "if {![info exists data(list)]} {\n"
7630     "return\n"
7631     "}\n"
7632     "if {[string equal $data(curItem) {}]} {\n"
7633     "set rTag [lindex [lindex $data(list) 0] 2]\n"
7634     "} else {\n"
7635     "set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]\n"
7636     "set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]\n"
7637     "if {[string equal $rTag \"\"]} {\n"
7638     "set rTag $oldRTag\n"
7639     "}\n"
7640     "}\n"
7641     "if {[string compare $rTag \"\"]} {\n"
7642     "tkIconList_Select $w $rTag\n"
7643     "tkIconList_See $w $rTag\n"
7644     "}\n"
7645     "}\n"
7646     "proc tkIconList_LeftRight {w amount} {\n"
7647     "upvar #0 $w data\n"
7648     "if {![info exists data(list)]} {\n"
7649     "return\n"
7650     "}\n"
7651     "if {[string equal $data(curItem) {}]} {\n"
7652     "set rTag [lindex [lindex $data(list) 0] 2]\n"
7653     "} else {\n"
7654     "set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]\n"
7655     "set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]\n"
7656     "set rTag [lindex [lindex $data(list) $newItem] 2]\n"
7657     "if {[string equal $rTag \"\"]} {\n"
7658     "set rTag $oldRTag\n"
7659     "}\n"
7660     "}\n"
7661     "if {[string compare $rTag \"\"]} {\n"
7662     "tkIconList_Select $w $rTag\n"
7663     "tkIconList_See $w $rTag\n"
7664     "}\n"
7665     "}\n"
7666     "proc tkIconList_KeyPress {w key} {\n"
7667     "global tkPriv\n"
7668     "append tkPriv(ILAccel,$w) $key\n"
7669     "tkIconList_Goto $w $tkPriv(ILAccel,$w)\n"
7670     "catch {\n"
7671     "after cancel $tkPriv(ILAccel,$w,afterId)\n"
7672     "}\n"
7673     "set tkPriv(ILAccel,$w,afterId) [after 500 [list tkIconList_Reset $w]]\n"
7674     "}\n"
7675     "proc tkIconList_Goto {w text} {\n"
7676     "upvar #0 $w data\n"
7677     "upvar #0 $w:textList textList\n"
7678     "global tkPriv\n"
7679     "if {![info exists data(list)]} {\n"
7680     "return\n"
7681     "}\n"
7682     "if {[string equal {} $text]} {\n"
7683     "return\n"
7684     "}\n"
7685     "if {$data(curItem) == \"\" || $data(curItem) == 0} {\n"
7686     "set start 0\n"
7687     "} else {\n"
7688     "set start $data(curItem)\n"
7689     "}\n"
7690     "set text [string tolower $text]\n"
7691     "set theIndex -1\n"
7692     "set less 0\n"
7693     "set len [string length $text]\n"
7694     "set len0 [expr {$len-1}]\n"
7695     "set i $start\n"
7696     "while {1} {\n"
7697     "set sub [string range $textList($i) 0 $len0]\n"
7698     "if {[string equal $text $sub]} {\n"
7699     "set theIndex $i\n"
7700     "break\n"
7701     "}\n"
7702     "incr i\n"
7703     "if {$i == $data(numItems)} {\n"
7704     "set i 0\n"
7705     "}\n"
7706     "if {$i == $start} {\n"
7707     "break\n"
7708     "}\n"
7709     "}\n"
7710     "if {$theIndex > -1} {\n"
7711     "set rTag [lindex [lindex $data(list) $theIndex] 2]\n"
7712     "tkIconList_Select $w $rTag\n"
7713     "tkIconList_See $w $rTag\n"
7714     "}\n"
7715     "}\n"
7716     "proc tkIconList_Reset {w} {\n"
7717     "global tkPriv\n"
7718     "catch {unset tkPriv(ILAccel,$w)}\n"
7719     "}\n"
7720     "namespace eval ::tk::dialog {}\n"
7721     "namespace eval ::tk::dialog::file {}\n"
7722     "proc ::tk::dialog::file::tkFDialog {type args} {\n"
7723     "global tkPriv\n"
7724     "set dataName __tk_filedialog\n"
7725     "upvar ::tk::dialog::file::$dataName data\n"
7726     "::tk::dialog::file::Config $dataName $type $args\n"
7727     "if {[string equal $data(-parent) .]} {\n"
7728     "set w .$dataName\n"
7729     "} else {\n"
7730     "set w $data(-parent).$dataName\n"
7731     "}\n"
7732     "if {![winfo exists $w]} {\n"
7733     "::tk::dialog::file::Create $w TkFDialog\n"
7734     "} elseif {[string compare [winfo class $w] TkFDialog]} {\n"
7735     "destroy $w\n"
7736     "::tk::dialog::file::Create $w TkFDialog\n"
7737     "} else {\n"
7738     "set data(dirMenuBtn) $w.f1.menu\n"
7739     "set data(dirMenu) $w.f1.menu.menu\n"
7740     "set data(upBtn) $w.f1.up\n"
7741     "set data(icons) $w.icons\n"
7742     "set data(ent) $w.f2.ent\n"
7743     "set data(typeMenuLab) $w.f3.lab\n"
7744     "set data(typeMenuBtn) $w.f3.menu\n"
7745     "set data(typeMenu) $data(typeMenuBtn).m\n"
7746     "set data(okBtn) $w.f2.ok\n"
7747     "set data(cancelBtn) $w.f3.cancel\n"
7748     "}\n"
7749     "wm transient $w $data(-parent)\n"
7750     "trace variable data(selectPath) w \"::tk::dialog::file::SetPath $w\"\n"
7751     "$data(dirMenuBtn) configure \\\n"
7752     "\011 -textvariable ::tk::dialog::file::${dataName}(selectPath)\n"
7753     "if {[llength $data(-filetypes)]} {\n"
7754     "$data(typeMenu) delete 0 end\n"
7755     "foreach type $data(-filetypes) {\n"
7756     "set title [lindex $type 0]\n"
7757     "set filter [lindex $type 1]\n"
7758     "$data(typeMenu) add command -label $title \\\n"
7759     "\011\011-command [list ::tk::dialog::file::SetFilter $w $type]\n"
7760     "}\n"
7761     "::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]\n"
7762     "$data(typeMenuBtn) config -state normal\n"
7763     "$data(typeMenuLab) config -state normal\n"
7764     "} else {\n"
7765     "set data(filter) \"*\"\n"
7766     "$data(typeMenuBtn) config -state disabled -takefocus 0\n"
7767     "$data(typeMenuLab) config -state disabled\n"
7768     "}\n"
7769     "::tk::dialog::file::UpdateWhenIdle $w\n"
7770     "::tk::PlaceWindow $w widget $data(-parent)\n"
7771     "wm title $w $data(-title)\n"
7772     "::tk::SetFocusGrab $w $data(ent)\n"
7773     "$data(ent) delete 0 end\n"
7774     "$data(ent) insert 0 $data(selectFile)\n"
7775     "$data(ent) selection range 0 end\n"
7776     "$data(ent) icursor end\n"
7777     "tkwait variable tkPriv(selectFilePath)\n"
7778     "::tk::RestoreFocusGrab $w $data(ent) withdraw\n"
7779     "foreach trace [trace vinfo data(selectPath)] {\n"
7780     "trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]\n"
7781     "}\n"
7782     "$data(dirMenuBtn) configure -textvariable {}\n"
7783     "return $tkPriv(selectFilePath)\n"
7784     "}\n"
7785     "proc ::tk::dialog::file::Config {dataName type argList} {\n"
7786     "upvar ::tk::dialog::file::$dataName data\n"
7787     "set data(type) $type\n"
7788     "foreach trace [trace vinfo data(selectPath)] {\n"
7789     "trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]\n"
7790     "}\n"
7791     "set specs {\n"
7792     "{-defaultextension \"\" \"\" \"\"}\n"
7793     "{-filetypes \"\" \"\" \"\"}\n"
7794     "{-initialdir \"\" \"\" \"\"}\n"
7795     "{-initialfile \"\" \"\" \"\"}\n"
7796     "{-parent \"\" \"\" \".\"}\n"
7797     "{-title \"\" \"\" \"\"}\n"
7798     "}\n"
7799     "if {![info exists data(selectPath)]} {\n"
7800     "set data(selectPath) [pwd]\n"
7801     "set data(selectFile) \"\"\n"
7802     "}\n"
7803     "tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n"
7804     "if {$data(-title) == \"\"} {\n"
7805     "if {[string equal $type \"open\"]} {\n"
7806     "set data(-title) \"Open\"\n"
7807     "} else {\n"
7808     "set data(-title) \"Save As\"\n"
7809     "}\n"
7810     "}\n"
7811     "if {$data(-initialdir) != \"\"} {\n"
7812     "if {[file isdirectory $data(-initialdir)]} {\n"
7813     "set old [pwd]\n"
7814     "cd $data(-initialdir)\n"
7815     "set data(selectPath) [pwd]\n"
7816     "cd $old\n"
7817     "} else {\n"
7818     "set data(selectPath) [pwd]\n"
7819     "}\n"
7820     "}\n"
7821     "set data(selectFile) $data(-initialfile)\n"
7822     "set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]\n"
7823     "if {![winfo exists $data(-parent)]} {\n"
7824     "error \"bad window path name \\\"$data(-parent)\\\"\"\n"
7825     "}\n"
7826     "}\n"
7827     "proc ::tk::dialog::file::Create {w class} {\n"
7828     "set dataName [lindex [split $w .] end]\n"
7829     "upvar ::tk::dialog::file::$dataName data\n"
7830     "global tk_library tkPriv\n"
7831     "toplevel $w -class $class\n"
7832     "set f1 [frame $w.f1]\n"
7833     "label $f1.lab -text \"Directory:\" -under 0\n"
7834     "set data(dirMenuBtn) $f1.menu\n"
7835     "set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] \"\"]\n"
7836     "set data(upBtn) [button $f1.up]\n"
7837     "if {![info exists tkPriv(updirImage)]} {\n"
7838     "set tkPriv(updirImage) [image create bitmap -data {\n"
7839     "#define updir_width 28\n"
7840     "#define updir_height 16\n"
7841     "static char updir_bits[] = {\n"
7842     "0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,\n"
7843     "0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,\n"
7844     "0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,\n"
7845     "0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,\n"
7846     "0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,\n"
7847     "0xf0, 0xff, 0xff, 0x01};}]\n"
7848     "}\n"
7849     "$data(upBtn) config -image $tkPriv(updirImage)\n"
7850     "$f1.menu config -takefocus 1 -highlightthickness 2\n"
7851     "pack $data(upBtn) -side right -padx 4 -fill both\n"
7852     "pack $f1.lab -side left -padx 4 -fill both\n"
7853     "pack $f1.menu -expand yes -fill both -padx 4\n"
7854     "if { [string equal $class TkFDialog] } {\n"
7855     "set fNameCaption \"File name:\"\n"
7856     "set fNameUnder 5\n"
7857     "set iconListCommand [list ::tk::dialog::file::OkCmd $w]\n"
7858     "} else {\n"
7859     "set fNameCaption \"Selection:\"\n"
7860     "set fNameUnder 0\n"
7861     "set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]\n"
7862     "}\n"
7863     "set data(icons) [tkIconList $w.icons \\\n"
7864     "\011-browsecmd [list ::tk::dialog::file::ListBrowse $w] \\\n"
7865     "\011-command $iconListCommand]\n"
7866     "set f2 [frame $w.f2 -bd 0]\n"
7867     "label $f2.lab -text $fNameCaption -anchor e -width 14 \\\n"
7868     "\011 -under $fNameUnder -pady 0\n"
7869     "set data(ent) [entry $f2.ent]\n"
7870     "global $w.icons\n"
7871     "set $w.icons(font) [$data(ent) cget -font]\n"
7872     "set f3 [frame $w.f3 -bd 0]\n"
7873     "if { [string equal $class TkFDialog] } {\n"
7874     "set data(typeMenuLab) [button $f3.lab -text \"Files of type:\" \\\n"
7875     "\011\011-anchor e -width 14 -under 9 \\\n"
7876     "\011\011-bd [$f2.lab cget -bd] \\\n"
7877     "\011\011-highlightthickness [$f2.lab cget -highlightthickness] \\\n"
7878     "\011\011-relief [$f2.lab cget -relief] \\\n"
7879     "\011\011-padx [$f2.lab cget -padx] \\\n"
7880     "\011\011-pady [$f2.lab cget -pady]]\n"
7881     "bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \\\n"
7882     "\011\011[winfo toplevel $data(typeMenuLab)] all]\n"
7883     "set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 \\\n"
7884     "\011\011-menu $f3.menu.m]\n"
7885     "set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]\n"
7886     "$data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \\\n"
7887     "\011\011-relief raised -bd 2 -anchor w\n"
7888     "}\n"
7889     "set data(okBtn) [button $f2.ok -text OK -under 0 -width 6 \\\n"
7890     "\011-default active -pady 3]\n"
7891     "set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\\\n"
7892     "\011-default normal -pady 3]\n"
7893     "pack $data(okBtn) -side right -padx 4 -anchor e\n"
7894     "pack $f2.lab -side left -padx 4\n"
7895     "pack $f2.ent -expand yes -fill x -padx 2 -pady 0\n"
7896     "pack $data(cancelBtn) -side right -padx 4 -anchor w\n"
7897     "if { [string equal $class TkFDialog] } {\n"
7898     "pack $data(typeMenuLab) -side left -padx 4\n"
7899     "pack $data(typeMenuBtn) -expand yes -fill x -side right\n"
7900     "}\n"
7901     "pack $f1 -side top -fill x -pady 4\n"
7902     "pack $f3 -side bottom -fill x\n"
7903     "pack $f2 -side bottom -fill x\n"
7904     "pack $data(icons) -expand yes -fill both -padx 4 -pady 1\n"
7905     "wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]\n"
7906     "$data(upBtn) config -command [list ::tk::dialog::file::UpDirCmd $w]\n"
7907     "$data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w]\n"
7908     "bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]\n"
7909     "bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]\n"
7910     "bind $w <Alt-d> [list focus $data(dirMenuBtn)]\n"
7911     "if { [string equal $class TkFDialog] } {\n"
7912     "bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]\n"
7913     "$data(okBtn) config -command [list ::tk::dialog::file::OkCmd $w]\n"
7914     "bind $w <Alt-t> [format {\n"
7915     "if {[string equal [%s cget -state] \"normal\"]} {\n"
7916     "focus %s\n"
7917     "}\n"
7918     "} $data(typeMenuBtn) $data(typeMenuBtn)]\n"
7919     "bind $w <Alt-n> [list focus $data(ent)]\n"
7920     "bind $w <Alt-o> [list ::tk::dialog::file::InvokeBtn $w Open]\n"
7921     "bind $w <Alt-s> [list ::tk::dialog::file::InvokeBtn $w Save]\n"
7922     "} else {\n"
7923     "set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]\n"
7924     "bind $data(ent) <Return> $okCmd\n"
7925     "$data(okBtn) config -command $okCmd\n"
7926     "bind $w <Alt-s> [list focus $data(ent)]\n"
7927     "bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]\n"
7928     "}\n"
7929     "tkFocusGroup_Create $w\n"
7930     "tkFocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w]\n"
7931     "tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]\n"
7932     "}\n"
7933     "proc ::tk::dialog::file::UpdateWhenIdle {w} {\n"
7934     "upvar ::tk::dialog::file::[winfo name $w] data\n"
7935     "if {[info exists data(updateId)]} {\n"
7936     "return\n"
7937     "} else {\n"
7938     "set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]\n"
7939     "}\n"
7940     "}\n"
7941     "proc ::tk::dialog::file::Update {w} {\n"
7942     "if {![winfo exists $w]} {\n"
7943     "return\n"
7944     "}\n"
7945     "set class [winfo class $w]\n"
7946     "if { [string compare $class TkFDialog] && \\\n"
7947     "\011 [string compare $class TkChooseDir] } {\n"
7948     "return\n"
7949     "}\n"
7950     "set dataName [winfo name $w]\n"
7951     "upvar ::tk::dialog::file::$dataName data\n"
7952     "global tk_library tkPriv\n"
7953     "catch {unset data(updateId)}\n"
7954     "if {![info exists tkPriv(folderImage)]} {\n"
7955     "set tkPriv(folderImage) [image create photo -data {\n"
7956     "R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB\n"
7957     "QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]\n"
7958     "set tkPriv(fileImage) [image create photo -data {\n"
7959     "R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO\n"
7960     "rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]\n"
7961     "}\n"
7962     "set folder $tkPriv(folderImage)\n"
7963     "set file $tkPriv(fileImage)\n"
7964     "set appPWD [pwd]\n"
7965     "if {[catch {\n"
7966     "cd $data(selectPath)\n"
7967     "}]} {\n"
7968     "tk_messageBox -type ok -parent $w -message \\\n"
7969     "\011 \"Cannot change to the directory \\\"$data(selectPath)\\\".\\nPermission denied.\"\\\n"
7970     "\011 -icon warning\n"
7971     "cd $appPWD\n"
7972     "return\n"
7973     "}\n"
7974     "set entCursor [$data(ent) cget -cursor]\n"
7975     "set dlgCursor [$w cget -cursor]\n"
7976     "$data(ent) config -cursor watch\n"
7977     "$w config -cursor watch\n"
7978     "update idletasks\n"
7979     "tkIconList_DeleteAll $data(icons)\n"
7980     "foreach f [lsort -dictionary [glob -nocomplain .* *]] {\n"
7981     "if {[string equal $f .]} {\n"
7982     "continue\n"
7983     "}\n"
7984     "if {[string equal $f ..]} {\n"
7985     "continue\n"
7986     "}\n"
7987     "if {[file isdir ./$f]} {\n"
7988     "if {![info exists hasDoneDir($f)]} {\n"
7989     "tkIconList_Add $data(icons) $folder $f\n"
7990     "set hasDoneDir($f) 1\n"
7991     "}\n"
7992     "}\n"
7993     "}\n"
7994     "if { [string equal $class TkFDialog] } {\n"
7995     "if {[string equal $data(filter) *]} {\n"
7996     "set files [lsort -dictionary \\\n"
7997     "\011\011 [glob -nocomplain .* *]]\n"
7998     "} else {\n"
7999     "set files [lsort -dictionary \\\n"
8000     "\011\011 [eval glob -nocomplain $data(filter)]]\n"
8001     "}\n"
8002     "foreach f $files {\n"
8003     "if {![file isdir ./$f]} {\n"
8004     "if {![info exists hasDoneFile($f)]} {\n"
8005     "tkIconList_Add $data(icons) $file $f\n"
8006     "set hasDoneFile($f) 1\n"
8007     "}\n"
8008     "}\n"
8009     "}\n"
8010     "}\n"
8011     "tkIconList_Arrange $data(icons)\n"
8012     "set list \"\"\n"
8013     "set dir \"\"\n"
8014     "foreach subdir [file split $data(selectPath)] {\n"
8015     "set dir [file join $dir $subdir]\n"
8016     "lappend list $dir\n"
8017     "}\n"
8018     "$data(dirMenu) delete 0 end\n"
8019     "set var [format %s(selectPath) ::tk::dialog::file::$dataName]\n"
8020     "foreach path $list {\n"
8021     "$data(dirMenu) add command -label $path -command [list set $var $path]\n"
8022     "}\n"
8023     "cd $appPWD\n"
8024     "if { [string equal $class TkFDialog] } {\n"
8025     "if {[string equal $data(type) open]} {\n"
8026     "$data(okBtn) config -text \"Open\"\n"
8027     "} else {\n"
8028     "$data(okBtn) config -text \"Save\"\n"
8029     "}\n"
8030     "}\n"
8031     "$data(ent) config -cursor $entCursor\n"
8032     "$w config -cursor $dlgCursor\n"
8033     "}\n"
8034     "proc ::tk::dialog::file::SetPathSilently {w path} {\n"
8035     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8036     "trace vdelete data(selectPath) w [list ::tk::dialog::file::SetPath $w]\n"
8037     "set data(selectPath) $path\n"
8038     "trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]\n"
8039     "}\n"
8040     "proc ::tk::dialog::file::SetPath {w name1 name2 op} {\n"
8041     "if {[winfo exists $w]} {\n"
8042     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8043     "::tk::dialog::file::UpdateWhenIdle $w\n"
8044     "if { [string equal [winfo class $w] TkChooseDir] } {\n"
8045     "$data(ent) delete 0 end\n"
8046     "$data(ent) insert end $data(selectPath)\n"
8047     "}\n"
8048     "}\n"
8049     "}\n"
8050     "proc ::tk::dialog::file::SetFilter {w type} {\n"
8051     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8052     "upvar \\#0 $data(icons) icons\n"
8053     "set data(filter) [lindex $type 1]\n"
8054     "$data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1\n"
8055     "$icons(sbar) set 0.0 0.0\n"
8056     "::tk::dialog::file::UpdateWhenIdle $w\n"
8057     "}\n"
8058     "proc ::tk::dialog::file::ResolveFile {context text defaultext} {\n"
8059     "set appPWD [pwd]\n"
8060     "set path [::tk::dialog::file::JoinFile $context $text]\n"
8061     "if {![file isdirectory $path] && [string equal [file ext $path] \"\"]} {\n"
8062     "set path \"$path$defaultext\"\n"
8063     "}\n"
8064     "if {[catch {file exists $path}]} {\n"
8065     "return [list ERROR $path \"\"]\n"
8066     "}\n"
8067     "if {[file exists $path]} {\n"
8068     "if {[file isdirectory $path]} {\n"
8069     "if {[catch {cd $path}]} {\n"
8070     "return [list CHDIR $path \"\"]\n"
8071     "}\n"
8072     "set directory [pwd]\n"
8073     "set file \"\"\n"
8074     "set flag OK\n"
8075     "cd $appPWD\n"
8076     "} else {\n"
8077     "if {[catch {cd [file dirname $path]}]} {\n"
8078     "return [list CHDIR [file dirname $path] \"\"]\n"
8079     "}\n"
8080     "set directory [pwd]\n"
8081     "set file [file tail $path]\n"
8082     "set flag OK\n"
8083     "cd $appPWD\n"
8084     "}\n"
8085     "} else {\n"
8086     "set dirname [file dirname $path]\n"
8087     "if {[file exists $dirname]} {\n"
8088     "if {[catch {cd $dirname}]} {\n"
8089     "return [list CHDIR $dirname \"\"]\n"
8090     "}\n"
8091     "set directory [pwd]\n"
8092     "set file [file tail $path]\n"
8093     "if {[regexp {[*]|[?]} $file]} {\n"
8094     "set flag PATTERN\n"
8095     "} else {\n"
8096     "set flag FILE\n"
8097     "}\n"
8098     "cd $appPWD\n"
8099     "} else {\n"
8100     "set directory $dirname\n"
8101     "set file [file tail $path]\n"
8102     "set flag PATH\n"
8103     "}\n"
8104     "}\n"
8105     "return [list $flag $directory $file]\n"
8106     "}\n"
8107     "proc ::tk::dialog::file::EntFocusIn {w} {\n"
8108     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8109     "if {[string compare [$data(ent) get] \"\"]} {\n"
8110     "$data(ent) selection range 0 end\n"
8111     "$data(ent) icursor end\n"
8112     "} else {\n"
8113     "$data(ent) selection clear\n"
8114     "}\n"
8115     "tkIconList_Unselect $data(icons)\n"
8116     "if { [string equal [winfo class $w] TkFDialog] } {\n"
8117     "if {[string equal $data(type) open]} {\n"
8118     "$data(okBtn) config -text \"Open\"\n"
8119     "} else {\n"
8120     "$data(okBtn) config -text \"Save\"\n"
8121     "}\n"
8122     "}\n"
8123     "}\n"
8124     "proc ::tk::dialog::file::EntFocusOut {w} {\n"
8125     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8126     "$data(ent) selection clear\n"
8127     "}\n"
8128     "proc ::tk::dialog::file::ActivateEnt {w} {\n"
8129     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8130     "set text [string trim [$data(ent) get]]\n"
8131     "set list [::tk::dialog::file::ResolveFile $data(selectPath) $text \\\n"
8132     "\011\011 $data(-defaultextension)]\n"
8133     "set flag [lindex $list 0]\n"
8134     "set path [lindex $list 1]\n"
8135     "set file [lindex $list 2]\n"
8136     "switch -- $flag {\n"
8137     "OK {\n"
8138     "if {[string equal $file \"\"]} {\n"
8139     "set data(selectPath) $path\n"
8140     "$data(ent) delete 0 end\n"
8141     "} else {\n"
8142     "::tk::dialog::file::SetPathSilently $w $path\n"
8143     "set data(selectFile) $file\n"
8144     "::tk::dialog::file::Done $w\n"
8145     "}\n"
8146     "}\n"
8147     "PATTERN {\n"
8148     "set data(selectPath) $path\n"
8149     "set data(filter) $file\n"
8150     "}\n"
8151     "FILE {\n"
8152     "if {[string equal $data(type) open]} {\n"
8153     "tk_messageBox -icon warning -type ok -parent $w \\\n"
8154     "\011\011 -message \"File \\\"[file join $path $file]\\\" does not exist.\"\n"
8155     "$data(ent) selection range 0 end\n"
8156     "$data(ent) icursor end\n"
8157     "} else {\n"
8158     "::tk::dialog::file::SetPathSilently $w $path\n"
8159     "set data(selectFile) $file\n"
8160     "::tk::dialog::file::Done $w\n"
8161     "}\n"
8162     "}\n"
8163     "PATH {\n"
8164     "tk_messageBox -icon warning -type ok -parent $w \\\n"
8165     "\011\011-message \"Directory \\\"$path\\\" does not exist.\"\n"
8166     "$data(ent) selection range 0 end\n"
8167     "$data(ent) icursor end\n"
8168     "}\n"
8169     "CHDIR {\n"
8170     "tk_messageBox -type ok -parent $w -message \\\n"
8171     "\011 \"Cannot change to the directory \\\"$path\\\".\\nPermission denied.\"\\\n"
8172     "\011\011-icon warning\n"
8173     "$data(ent) selection range 0 end\n"
8174     "$data(ent) icursor end\n"
8175     "}\n"
8176     "ERROR {\n"
8177     "tk_messageBox -type ok -parent $w -message \\\n"
8178     "\011 \"Invalid file name \\\"$path\\\".\"\\\n"
8179     "\011\011-icon warning\n"
8180     "$data(ent) selection range 0 end\n"
8181     "$data(ent) icursor end\n"
8182     "}\n"
8183     "}\n"
8184     "}\n"
8185     "proc ::tk::dialog::file::InvokeBtn {w key} {\n"
8186     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8187     "if {[string equal [$data(okBtn) cget -text] $key]} {\n"
8188     "tkButtonInvoke $data(okBtn)\n"
8189     "}\n"
8190     "}\n"
8191     "proc ::tk::dialog::file::UpDirCmd {w} {\n"
8192     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8193     "if {[string compare $data(selectPath) \"/\"]} {\n"
8194     "set data(selectPath) [file dirname $data(selectPath)]\n"
8195     "}\n"
8196     "}\n"
8197     "proc ::tk::dialog::file::JoinFile {path file} {\n"
8198     "if {[string match {~*} $file] && [file exists $path/$file]} {\n"
8199     "return [file join $path ./$file]\n"
8200     "} else {\n"
8201     "return [file join $path $file]\n"
8202     "}\n"
8203     "}\n"
8204     "proc ::tk::dialog::file::OkCmd {w} {\n"
8205     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8206     "set text [tkIconList_Get $data(icons)]\n"
8207     "if {[string compare $text \"\"]} {\n"
8208     "set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n"
8209     "if {[file isdirectory $file]} {\n"
8210     "::tk::dialog::file::ListInvoke $w $text\n"
8211     "return\n"
8212     "}\n"
8213     "}\n"
8214     "::tk::dialog::file::ActivateEnt $w\n"
8215     "}\n"
8216     "proc ::tk::dialog::file::CancelCmd {w} {\n"
8217     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8218     "global tkPriv\n"
8219     "set tkPriv(selectFilePath) \"\"\n"
8220     "}\n"
8221     "proc ::tk::dialog::file::ListBrowse {w text} {\n"
8222     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8223     "if {[string equal $text \"\"]} {\n"
8224     "return\n"
8225     "}\n"
8226     "set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n"
8227     "if {![file isdirectory $file]} {\n"
8228     "$data(ent) delete 0 end\n"
8229     "$data(ent) insert 0 $text\n"
8230     "if { [string equal [winfo class $w] TkFDialog] } {\n"
8231     "if {[string equal $data(type) open]} {\n"
8232     "$data(okBtn) config -text \"Open\"\n"
8233     "} else {\n"
8234     "$data(okBtn) config -text \"Save\"\n"
8235     "}\n"
8236     "}\n"
8237     "} else {\n"
8238     "if { [string equal [winfo class $w] TkFDialog] } {\n"
8239     "$data(okBtn) config -text \"Open\"\n"
8240     "}\n"
8241     "}\n"
8242     "}\n"
8243     "proc ::tk::dialog::file::ListInvoke {w text} {\n"
8244     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8245     "if {[string equal $text \"\"]} {\n"
8246     "return\n"
8247     "}\n"
8248     "set file [::tk::dialog::file::JoinFile $data(selectPath) $text]\n"
8249     "set class [winfo class $w]\n"
8250     "if {[string equal $class TkChooseDir] || [file isdirectory $file]} {\n"
8251     "set appPWD [pwd]\n"
8252     "if {[catch {cd $file}]} {\n"
8253     "tk_messageBox -type ok -parent $w -message \\\n"
8254     "\011 \"Cannot change to the directory \\\"$file\\\".\\nPermission denied.\"\\\n"
8255     "\011\011-icon warning\n"
8256     "} else {\n"
8257     "cd $appPWD\n"
8258     "set data(selectPath) $file\n"
8259     "}\n"
8260     "} else {\n"
8261     "set data(selectFile) $file\n"
8262     "::tk::dialog::file::Done $w\n"
8263     "}\n"
8264     "}\n"
8265     "proc ::tk::dialog::file::Done {w {selectFilePath \"\"}} {\n"
8266     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8267     "global tkPriv\n"
8268     "if {[string equal $selectFilePath \"\"]} {\n"
8269     "set selectFilePath [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
8270     "\011\011$data(selectFile)]\n"
8271     "set tkPriv(selectFile) $data(selectFile)\n"
8272     "set tkPriv(selectPath) $data(selectPath)\n"
8273     "if {[file exists $selectFilePath] && [string equal $data(type) save]} {\n"
8274     "set reply [tk_messageBox -icon warning -type yesno\\\n"
8275     "\011\011 -parent $w -message \"File\\\n"
8276     "\011\011 \\\"$selectFilePath\\\" already exists.\\nDo\\\n"
8277     "\011\011 you want to overwrite it?\"]\n"
8278     "if {[string equal $reply \"no\"]} {\n"
8279     "return\n"
8280     "}\n"
8281     "}\n"
8282     "}\n"
8283     "set tkPriv(selectFilePath) $selectFilePath\n"
8284     "}\n"
8285     ;
8286     static char Et_zFile30[] =
8287     "namespace eval ::tk::dialog {}\n"
8288     "namespace eval ::tk::dialog::file {}\n"
8289     "proc tkMotifFDialog {type args} {\n"
8290     "global tkPriv\n"
8291     "set dataName __tk_filedialog\n"
8292     "upvar ::tk::dialog::file::$dataName data\n"
8293     "set w [tkMotifFDialog_Create $dataName $type $args]\n"
8294     "::tk::SetFocusGrab $w $data(sEnt)\n"
8295     "$data(sEnt) selection range 0 end\n"
8296     "tkwait variable tkPriv(selectFilePath)\n"
8297     "::tk::RestoreFocusGrab $w $data(sEnt) withdraw\n"
8298     "return $tkPriv(selectFilePath)\n"
8299     "}\n"
8300     "proc tkMotifFDialog_Create {dataName type argList} {\n"
8301     "global tkPriv\n"
8302     "upvar ::tk::dialog::file::$dataName data\n"
8303     "tkMotifFDialog_Config $dataName $type $argList\n"
8304     "if {[string equal $data(-parent) .]} {\n"
8305     "set w .$dataName\n"
8306     "} else {\n"
8307     "set w $data(-parent).$dataName\n"
8308     "}\n"
8309     "if {![winfo exists $w]} {\n"
8310     "tkMotifFDialog_BuildUI $w\n"
8311     "} elseif {[string compare [winfo class $w] TkMotifFDialog]} {\n"
8312     "destroy $w\n"
8313     "tkMotifFDialog_BuildUI $w\n"
8314     "} else {\n"
8315     "set data(fEnt) $w.top.f1.ent\n"
8316     "set data(dList) $w.top.f2.a.l\n"
8317     "set data(fList) $w.top.f2.b.l\n"
8318     "set data(sEnt) $w.top.f3.ent\n"
8319     "set data(okBtn) $w.bot.ok\n"
8320     "set data(filterBtn) $w.bot.filter\n"
8321     "set data(cancelBtn) $w.bot.cancel\n"
8322     "}\n"
8323     "wm transient $w $data(-parent)\n"
8324     "tkMotifFDialog_Update $w\n"
8325     "::tk::PlaceWindow $w\n"
8326     "wm title $w $data(-title)\n"
8327     "return $w\n"
8328     "}\n"
8329     "proc tkMotifFDialog_Config {dataName type argList} {\n"
8330     "upvar ::tk::dialog::file::$dataName data\n"
8331     "set data(type) $type\n"
8332     "set specs {\n"
8333     "{-defaultextension \"\" \"\" \"\"}\n"
8334     "{-filetypes \"\" \"\" \"\"}\n"
8335     "{-initialdir \"\" \"\" \"\"}\n"
8336     "{-initialfile \"\" \"\" \"\"}\n"
8337     "{-parent \"\" \"\" \".\"}\n"
8338     "{-title \"\" \"\" \"\"}\n"
8339     "}\n"
8340     "if {![info exists data(selectPath)]} {\n"
8341     "set data(selectPath) [pwd]\n"
8342     "set data(selectFile) \"\"\n"
8343     "}\n"
8344     "tclParseConfigSpec ::tk::dialog::file::$dataName $specs \"\" $argList\n"
8345     "if {[string equal $data(-title) \"\"]} {\n"
8346     "if {[string equal $type \"open\"]} {\n"
8347     "set data(-title) \"Open\"\n"
8348     "} else {\n"
8349     "set data(-title) \"Save As\"\n"
8350     "}\n"
8351     "}\n"
8352     "if {[string compare $data(-initialdir) \"\"]} {\n"
8353     "if {[file isdirectory $data(-initialdir)]} {\n"
8354     "set data(selectPath) [glob $data(-initialdir)]\n"
8355     "} else {\n"
8356     "set data(selectPath) [pwd]\n"
8357     "}\n"
8358     "set old [pwd]\n"
8359     "cd $data(selectPath)\n"
8360     "set data(selectPath) [pwd]\n"
8361     "cd $old\n"
8362     "}\n"
8363     "set data(selectFile) $data(-initialfile)\n"
8364     "set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]\n"
8365     "if {![info exists data(filter)]} {\n"
8366     "set data(filter) *\n"
8367     "}\n"
8368     "if {![winfo exists $data(-parent)]} {\n"
8369     "error \"bad window path name \\\"$data(-parent)\\\"\"\n"
8370     "}\n"
8371     "}\n"
8372     "proc tkMotifFDialog_BuildUI {w} {\n"
8373     "set dataName [lindex [split $w .] end]\n"
8374     "upvar ::tk::dialog::file::$dataName data\n"
8375     "toplevel $w -class TkMotifFDialog\n"
8376     "set top [frame $w.top -relief raised -bd 1]\n"
8377     "set bot [frame $w.bot -relief raised -bd 1]\n"
8378     "pack $w.bot -side bottom -fill x\n"
8379     "pack $w.top -side top -expand yes -fill both\n"
8380     "set f1 [frame $top.f1]\n"
8381     "set f2 [frame $top.f2]\n"
8382     "set f3 [frame $top.f3]\n"
8383     "pack $f1 -side top -fill x\n"
8384     "pack $f3 -side bottom -fill x\n"
8385     "pack $f2 -expand yes -fill both\n"
8386     "set f2a [frame $f2.a]\n"
8387     "set f2b [frame $f2.b]\n"
8388     "grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n"
8389     "\011-sticky news\n"
8390     "grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \\\n"
8391     "\011-sticky news\n"
8392     "grid rowconfig $f2 0 -minsize 0 -weight 1\n"
8393     "grid columnconfig $f2 0 -minsize 0 -weight 1\n"
8394     "grid columnconfig $f2 1 -minsize 150 -weight 2\n"
8395     "label $f1.lab -text \"Filter:\" -under 3 -anchor w\n"
8396     "entry $f1.ent\n"
8397     "pack $f1.lab -side top -fill x -padx 6 -pady 4\n"
8398     "pack $f1.ent -side top -fill x -padx 4 -pady 0\n"
8399     "set data(fEnt) $f1.ent\n"
8400     "set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]\n"
8401     "set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files: 2 FList]\n"
8402     "label $f3.lab -text \"Selection:\" -under 0 -anchor w\n"
8403     "entry $f3.ent\n"
8404     "pack $f3.lab -side top -fill x -padx 6 -pady 0\n"
8405     "pack $f3.ent -side top -fill x -padx 4 -pady 4\n"
8406     "set data(sEnt) $f3.ent\n"
8407     "set data(okBtn) [button $bot.ok -text OK -width 6 -under 0 \\\n"
8408     "\011-command [list tkMotifFDialog_OkCmd $w]]\n"
8409     "set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \\\n"
8410     "\011-command [list tkMotifFDialog_FilterCmd $w]]\n"
8411     "set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \\\n"
8412     "\011-command [list tkMotifFDialog_CancelCmd $w]]\n"
8413     "pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \\\n"
8414     "\011-side left\n"
8415     "bind $w <Alt-t> [list focus $data(fEnt)]\n"
8416     "bind $w <Alt-d> [list focus $data(dList)]\n"
8417     "bind $w <Alt-l> [list focus $data(fList)]\n"
8418     "bind $w <Alt-s> [list focus $data(sEnt)]\n"
8419     "bind $w <Alt-o> [list tkButtonInvoke $bot.ok]\n"
8420     "bind $w <Alt-f> [list tkButtonInvoke $bot.filter]\n"
8421     "bind $w <Alt-c> [list tkButtonInvoke $bot.cancel]\n"
8422     "bind $data(fEnt) <Return> [list tkMotifFDialog_ActivateFEnt $w]\n"
8423     "bind $data(sEnt) <Return> [list tkMotifFDialog_ActivateSEnt $w]\n"
8424     "wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w]\n"
8425     "}\n"
8426     "proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {\n"
8427     "label $f.lab -text $label -under $under -anchor w\n"
8428     "listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\\\n"
8429     "\011-xscrollcommand [list $f.h set]\011-yscrollcommand [list $f.v set]\n"
8430     "scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]\n"
8431     "scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]\n"
8432     "grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \\\n"
8433     "\011-padx 2 -pady 2\n"
8434     "grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news\n"
8435     "grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news\n"
8436     "grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news\n"
8437     "grid rowconfig $f 0 -weight 0 -minsize 0\n"
8438     "grid rowconfig $f 1 -weight 1 -minsize 0\n"
8439     "grid columnconfig $f 0 -weight 1 -minsize 0\n"
8440     "set list $f.l\n"
8441     "bind $list <Up>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
8442     "bind $list <Down>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
8443     "bind $list <space>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
8444     "bind $list <1>\011\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
8445     "bind $list <B1-Motion>\011[list tkMotifFDialog_Browse$cmdPrefix $w]\n"
8446     "bind $list <Double-ButtonRelease-1> \\\n"
8447     "\011 [list tkMotifFDialog_Activate$cmdPrefix $w]\n"
8448     "bind $list <Return> \"tkMotifFDialog_Browse$cmdPrefix [list $w]; \\\n"
8449     "\011 tkMotifFDialog_Activate$cmdPrefix [list $w]\"\n"
8450     "bindtags $list [list Listbox $list [winfo toplevel $list] all]\n"
8451     "tkListBoxKeyAccel_Set $list\n"
8452     "return $f.l\n"
8453     "}\n"
8454     "proc tkMotifFDialog_InterpFilter {w} {\n"
8455     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8456     "set text [string trim [$data(fEnt) get]]\n"
8457     "set badTilde 0\n"
8458     "if {[string equal [string index $text 0] ~]} {\n"
8459     "set list [file split $text]\n"
8460     "set tilde [lindex $list 0]\n"
8461     "if {[catch {set tilde [glob $tilde]}]} {\n"
8462     "set badTilde 1\n"
8463     "} else {\n"
8464     "set text [eval file join [concat $tilde [lrange $list 1 end]]]\n"
8465     "}\n"
8466     "}\n"
8467     "set relative 0\n"
8468     "if {[string equal [file pathtype $text] \"relative\"]} {\n"
8469     "set relative 1\n"
8470     "} elseif {$badTilde} {\n"
8471     "set relative 1\011\n"
8472     "}\n"
8473     "if {$relative} {\n"
8474     "tk_messageBox -icon warning -type ok \\\n"
8475     "\011 -message \"\\\"$text\\\" must be an absolute pathname\"\n"
8476     "$data(fEnt) delete 0 end\n"
8477     "$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
8478     "\011\011$data(filter)]\n"
8479     "return [list $data(selectPath) $data(filter)]\n"
8480     "}\n"
8481     "set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]\n"
8482     "if {[file isdirectory $resolved]} {\n"
8483     "set dir $resolved\n"
8484     "set fil $data(filter)\n"
8485     "} else {\n"
8486     "set dir [file dirname $resolved]\n"
8487     "set fil [file tail $resolved]\n"
8488     "}\n"
8489     "return [list $dir $fil]\n"
8490     "}\n"
8491     "proc tkMotifFDialog_Update {w} {\n"
8492     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8493     "$data(fEnt) delete 0 end\n"
8494     "$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n"
8495     "$data(sEnt) delete 0 end\n"
8496     "$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
8497     "\011 $data(selectFile)]\n"
8498     "tkMotifFDialog_LoadFiles $w\n"
8499     "}\n"
8500     "proc tkMotifFDialog_LoadFiles {w} {\n"
8501     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8502     "$data(dList) delete 0 end\n"
8503     "$data(fList) delete 0 end\n"
8504     "set appPWD [pwd]\n"
8505     "if {[catch {cd $data(selectPath)}]} {\n"
8506     "cd $appPWD\n"
8507     "$data(dList) insert end \"..\"\n"
8508     "return\n"
8509     "}\n"
8510     "foreach f [lsort -dictionary [glob -nocomplain .* *]] {\n"
8511     "if {[file isdir ./$f]} {\n"
8512     "$data(dList) insert end $f\n"
8513     "}\n"
8514     "}\n"
8515     "if {[string equal $data(filter) *]} {\n"
8516     "set files [lsort -dictionary [glob -nocomplain .* *]]\n"
8517     "} else {\n"
8518     "set files [lsort -dictionary \\\n"
8519     "\011 [glob -nocomplain $data(filter)]]\n"
8520     "}\n"
8521     "set top 0\n"
8522     "foreach f $files {\n"
8523     "if {![file isdir ./$f]} {\n"
8524     "regsub {^[.]/} $f \"\" f\n"
8525     "$data(fList) insert end $f\n"
8526     "if {[string match .* $f]} {\n"
8527     "incr top\n"
8528     "}\n"
8529     "}\n"
8530     "}\n"
8531     "$data(fList) yview $top\n"
8532     "cd $appPWD\n"
8533     "}\n"
8534     "proc tkMotifFDialog_BrowseDList {w} {\n"
8535     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8536     "focus $data(dList)\n"
8537     "if {[string equal [$data(dList) curselection] \"\"]} {\n"
8538     "return\n"
8539     "}\n"
8540     "set subdir [$data(dList) get [$data(dList) curselection]]\n"
8541     "if {[string equal $subdir \"\"]} {\n"
8542     "return\n"
8543     "}\n"
8544     "$data(fList) selection clear 0 end\n"
8545     "set list [tkMotifFDialog_InterpFilter $w]\n"
8546     "set data(filter) [lindex $list 1]\n"
8547     "switch -- $subdir {\n"
8548     ". {\n"
8549     "set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n"
8550     "}\n"
8551     ".. {\n"
8552     "set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \\\n"
8553     "\011\011$data(filter)]\n"
8554     "}\n"
8555     "default {\n"
8556     "set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \\\n"
8557     "\011\011 $data(selectPath) $subdir] $data(filter)]\n"
8558     "}\n"
8559     "}\n"
8560     "$data(fEnt) delete 0 end\n"
8561     "$data(fEnt) insert 0 $newSpec\n"
8562     "}\n"
8563     "proc tkMotifFDialog_ActivateDList {w} {\n"
8564     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8565     "if {[string equal [$data(dList) curselection] \"\"]} {\n"
8566     "return\n"
8567     "}\n"
8568     "set subdir [$data(dList) get [$data(dList) curselection]]\n"
8569     "if {[string equal $subdir \"\"]} {\n"
8570     "return\n"
8571     "}\n"
8572     "$data(fList) selection clear 0 end\n"
8573     "switch -- $subdir {\n"
8574     ". {\n"
8575     "set newDir $data(selectPath)\n"
8576     "}\n"
8577     ".. {\n"
8578     "set newDir [file dirname $data(selectPath)]\n"
8579     "}\n"
8580     "default {\n"
8581     "set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]\n"
8582     "}\n"
8583     "}\n"
8584     "set data(selectPath) $newDir\n"
8585     "tkMotifFDialog_Update $w\n"
8586     "if {[string compare $subdir ..]} {\n"
8587     "$data(dList) selection set 0\n"
8588     "$data(dList) activate 0\n"
8589     "} else {\n"
8590     "$data(dList) selection set 1\n"
8591     "$data(dList) activate 1\n"
8592     "}\n"
8593     "}\n"
8594     "proc tkMotifFDialog_BrowseFList {w} {\n"
8595     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8596     "focus $data(fList)\n"
8597     "if {[string equal [$data(fList) curselection] \"\"]} {\n"
8598     "return\n"
8599     "}\n"
8600     "set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n"
8601     "if {[string equal $data(selectFile) \"\"]} {\n"
8602     "return\n"
8603     "}\n"
8604     "$data(dList) selection clear 0 end\n"
8605     "$data(fEnt) delete 0 end\n"
8606     "$data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]\n"
8607     "$data(fEnt) xview end\n"
8608     "$data(sEnt) delete 0 end\n"
8609     "$data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \\\n"
8610     "\011 $data(selectFile)]\n"
8611     "$data(sEnt) xview end\n"
8612     "}\n"
8613     "proc tkMotifFDialog_ActivateFList {w} {\n"
8614     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8615     "if {[string equal [$data(fList) curselection] \"\"]} {\n"
8616     "return\n"
8617     "}\n"
8618     "set data(selectFile) [$data(fList) get [$data(fList) curselection]]\n"
8619     "if {[string equal $data(selectFile) \"\"]} {\n"
8620     "return\n"
8621     "} else {\n"
8622     "tkMotifFDialog_ActivateSEnt $w\n"
8623     "}\n"
8624     "}\n"
8625     "proc tkMotifFDialog_ActivateFEnt {w} {\n"
8626     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8627     "set list [tkMotifFDialog_InterpFilter $w]\n"
8628     "set data(selectPath) [lindex $list 0]\n"
8629     "set data(filter) [lindex $list 1]\n"
8630     "tkMotifFDialog_Update $w\n"
8631     "}\n"
8632     "proc tkMotifFDialog_ActivateSEnt {w} {\n"
8633     "global tkPriv\n"
8634     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8635     "set selectFilePath [string trim [$data(sEnt) get]]\n"
8636     "set selectFile [file tail $selectFilePath]\n"
8637     "set selectPath [file dirname $selectFilePath]\n"
8638     "if {[string equal $selectFilePath \"\"]} {\n"
8639     "tkMotifFDialog_FilterCmd $w\n"
8640     "return\n"
8641     "}\n"
8642     "if {[file isdirectory $selectFilePath]} {\n"
8643     "set data(selectPath) [glob $selectFilePath]\n"
8644     "set data(selectFile) \"\"\n"
8645     "tkMotifFDialog_Update $w\n"
8646     "return\n"
8647     "}\n"
8648     "if {[string compare [file pathtype $selectFilePath] \"absolute\"]} {\n"
8649     "tk_messageBox -icon warning -type ok \\\n"
8650     "\011 -message \"\\\"$selectFilePath\\\" must be an absolute pathname\"\n"
8651     "return\n"
8652     "}\n"
8653     "if {![file exists $selectPath]} {\n"
8654     "tk_messageBox -icon warning -type ok \\\n"
8655     "\011 -message \"Directory \\\"$selectPath\\\" does not exist.\"\n"
8656     "return\n"
8657     "}\n"
8658     "if {![file exists $selectFilePath]} {\n"
8659     "if {[string equal $data(type) open]} {\n"
8660     "tk_messageBox -icon warning -type ok \\\n"
8661     "\011\011-message \"File \\\"$selectFilePath\\\" does not exist.\"\n"
8662     "return\n"
8663     "}\n"
8664     "} else {\n"
8665     "if {[string equal $data(type) save]} {\n"
8666     "set message [format %s%s \\\n"
8667     "\011\011\"File \\\"$selectFilePath\\\" already exists.\\n\\n\" \\\n"
8668     "\011\011\"Replace existing file?\"]\n"
8669     "set answer [tk_messageBox -icon warning -type yesno \\\n"
8670     "\011\011-message $message]\n"
8671     "if {[string equal $answer \"no\"]} {\n"
8672     "return\n"
8673     "}\n"
8674     "}\n"
8675     "}\n"
8676     "set tkPriv(selectFilePath) $selectFilePath\n"
8677     "set tkPriv(selectFile) $selectFile\n"
8678     "set tkPriv(selectPath) $selectPath\n"
8679     "}\n"
8680     "proc tkMotifFDialog_OkCmd {w} {\n"
8681     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8682     "tkMotifFDialog_ActivateSEnt $w\n"
8683     "}\n"
8684     "proc tkMotifFDialog_FilterCmd {w} {\n"
8685     "upvar ::tk::dialog::file::[winfo name $w] data\n"
8686     "tkMotifFDialog_ActivateFEnt $w\n"
8687     "}\n"
8688     "proc tkMotifFDialog_CancelCmd {w} {\n"
8689     "global tkPriv\n"
8690     "set tkPriv(selectFilePath) \"\"\n"
8691     "set tkPriv(selectFile) \"\"\n"
8692     "set tkPriv(selectPath) \"\"\n"
8693     "}\n"
8694     "proc tkListBoxKeyAccel_Set {w} {\n"
8695     "bind Listbox <Any-KeyPress> \"\"\n"
8696     "bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w]\n"
8697     "bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A]\n"
8698     "}\n"
8699     "proc tkListBoxKeyAccel_Unset {w} {\n"
8700     "global tkPriv\n"
8701     "catch {after cancel $tkPriv(lbAccel,$w,afterId)}\n"
8702     "catch {unset tkPriv(lbAccel,$w)}\n"
8703     "catch {unset tkPriv(lbAccel,$w,afterId)}\n"
8704     "}\n"
8705     "proc tkListBoxKeyAccel_Key {w key} {\n"
8706     "global tkPriv\n"
8707     "append tkPriv(lbAccel,$w) $key\n"
8708     "tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)\n"
8709     "catch {\n"
8710     "after cancel $tkPriv(lbAccel,$w,afterId)\n"
8711     "}\n"
8712     "set tkPriv(lbAccel,$w,afterId) [after 500 \\\n"
8713     "\011 [list tkListBoxKeyAccel_Reset $w]]\n"
8714     "}\n"
8715     "proc tkListBoxKeyAccel_Goto {w string} {\n"
8716     "global tkPriv\n"
8717     "set string [string tolower $string]\n"
8718     "set end [$w index end]\n"
8719     "set theIndex -1\n"
8720     "for {set i 0} {$i < $end} {incr i} {\n"
8721     "set item [string tolower [$w get $i]]\n"
8722     "if {[string compare $string $item] >= 0} {\n"
8723     "set theIndex $i\n"
8724     "}\n"
8725     "if {[string compare $string $item] <= 0} {\n"
8726     "set theIndex $i\n"
8727     "break\n"
8728     "}\n"
8729     "}\n"
8730     "if {$theIndex >= 0} {\n"
8731     "$w selection clear 0 end\n"
8732     "$w selection set $theIndex $theIndex\n"
8733     "$w activate $theIndex\n"
8734     "$w see $theIndex\n"
8735     "}\n"
8736     "}\n"
8737     "proc tkListBoxKeyAccel_Reset {w} {\n"
8738     "global tkPriv\n"
8739     "catch {unset tkPriv(lbAccel,$w)}\n"
8740     "}\n"
8741     ;
8742     struct EtFile {
8743     char *zName;
8744     char *zData;
8745     int nData;
8746     int shrouded;
8747     struct EtFile *pNext;
8748     };
8749     static struct EtFile Et_FileSet[] = {
8750     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/auto.tcl", Et_zFile0, sizeof(Et_zFile0)-1, 0, 0 },
8751     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/history.tcl", Et_zFile1, sizeof(Et_zFile1)-1, 0, 0 },
8752     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/init.tcl", Et_zFile2, sizeof(Et_zFile2)-1, 0, 0 },
8753     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/package.tcl", Et_zFile3, sizeof(Et_zFile3)-1, 0, 0 },
8754     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/parray.tcl", Et_zFile4, sizeof(Et_zFile4)-1, 0, 0 },
8755     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/safe.tcl", Et_zFile5, sizeof(Et_zFile5)-1, 0, 0 },
8756     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/tclIndex", Et_zFile6, sizeof(Et_zFile6)-1, 0, 0 },
8757     { "C:/PROGRAM FILES/TCL/lib/tcl8.3/word.tcl", Et_zFile7, sizeof(Et_zFile7)-1, 0, 0 },
8758     { "C:/PROGRAM FILES/TCL/lib/tk8.3/bgerror.tcl", Et_zFile8, sizeof(Et_zFile8)-1, 0, 0 },
8759     { "C:/PROGRAM FILES/TCL/lib/tk8.3/button.tcl", Et_zFile9, sizeof(Et_zFile9)-1, 0, 0 },
8760     { "C:/PROGRAM FILES/TCL/lib/tk8.3/clrpick.tcl", Et_zFile10, sizeof(Et_zFile10)-1, 0, 0 },
8761     { "C:/PROGRAM FILES/TCL/lib/tk8.3/comdlg.tcl", Et_zFile11, sizeof(Et_zFile11)-1, 0, 0 },
8762     { "C:/PROGRAM FILES/TCL/lib/tk8.3/console.tcl", Et_zFile12, sizeof(Et_zFile12)-1, 0, 0 },
8763     { "C:/PROGRAM FILES/TCL/lib/tk8.3/dialog.tcl", Et_zFile13, sizeof(Et_zFile13)-1, 0, 0 },
8764     { "C:/PROGRAM FILES/TCL/lib/tk8.3/entry.tcl", Et_zFile14, sizeof(Et_zFile14)-1, 0, 0 },
8765     { "C:/PROGRAM FILES/TCL/lib/tk8.3/focus.tcl", Et_zFile15, sizeof(Et_zFile15)-1, 0, 0 },
8766     { "C:/PROGRAM FILES/TCL/lib/tk8.3/listbox.tcl", Et_zFile16, sizeof(Et_zFile16)-1, 0, 0 },
8767     { "C:/PROGRAM FILES/TCL/lib/tk8.3/menu.tcl", Et_zFile17, sizeof(Et_zFile17)-1, 0, 0 },
8768     { "C:/PROGRAM FILES/TCL/lib/tk8.3/msgbox.tcl", Et_zFile18, sizeof(Et_zFile18)-1, 0, 0 },
8769     { "C:/PROGRAM FILES/TCL/lib/tk8.3/obsolete.tcl", Et_zFile19, sizeof(Et_zFile19)-1, 0, 0 },
8770     { "C:/PROGRAM FILES/TCL/lib/tk8.3/optMenu.tcl", Et_zFile20, sizeof(Et_zFile20)-1, 0, 0 },
8771     { "C:/PROGRAM FILES/TCL/lib/tk8.3/palette.tcl", Et_zFile21, sizeof(Et_zFile21)-1, 0, 0 },
8772     { "C:/PROGRAM FILES/TCL/lib/tk8.3/safetk.tcl", Et_zFile22, sizeof(Et_zFile22)-1, 0, 0 },
8773     { "C:/PROGRAM FILES/TCL/lib/tk8.3/scale.tcl", Et_zFile23, sizeof(Et_zFile23)-1, 0, 0 },
8774     { "C:/PROGRAM FILES/TCL/lib/tk8.3/scrlbar.tcl", Et_zFile24, sizeof(Et_zFile24)-1, 0, 0 },
8775     { "C:/PROGRAM FILES/TCL/lib/tk8.3/tclIndex", Et_zFile25, sizeof(Et_zFile25)-1, 0, 0 },
8776     { "C:/PROGRAM FILES/TCL/lib/tk8.3/tearoff.tcl", Et_zFile26, sizeof(Et_zFile26)-1, 0, 0 },
8777     { "C:/PROGRAM FILES/TCL/lib/tk8.3/text.tcl", Et_zFile27, sizeof(Et_zFile27)-1, 0, 0 },
8778     { "C:/PROGRAM FILES/TCL/lib/tk8.3/tk.tcl", Et_zFile28, sizeof(Et_zFile28)-1, 0, 0 },
8779     { "C:/PROGRAM FILES/TCL/lib/tk8.3/tkfbox.tcl", Et_zFile29, sizeof(Et_zFile29)-1, 0, 0 },
8780     { "C:/PROGRAM FILES/TCL/lib/tk8.3/xmfbox.tcl", Et_zFile30, sizeof(Et_zFile30)-1, 0, 0 },
8781     {0, 0}};
8782     static struct EtFile *Et_FileHashTable[71];
8783     /* The following copyright notice applies to code generated by
8784     ** "mktclapp". The "mktclapp" program itself is covered by the
8785     ** GNU Public License.
8786     **
8787     ** Copyright (c) 1998 D. Richard Hipp
8788     **
8789     ** The author hereby grants permission to use, copy, modify, distribute,
8790     ** and license this software and its documentation for any purpose, provided
8791     ** that existing copyright notices are retained in all copies and that this
8792     ** notice is included verbatim in any distributions. No written agreement,
8793     ** license, or royalty fee is required for any of the authorized uses.
8794     ** Modifications to this software may be copyrighted by their authors
8795     ** and need not follow the licensing terms described here, provided that
8796     ** the new terms are clearly indicated on the first page of each file where
8797     ** they apply.
8798     **
8799     ** In no event shall the author or the distributors be liable to any party
8800     ** for direct, indirect, special, incidental, or consequential damages
8801     ** arising out of the use of this software, its documentation, or any
8802     ** derivatives thereof, even if the author has been advised of the
8803     ** possibility of such damage. The author and distributors specifically
8804     ** disclaim any warranties, including but not limited to the implied
8805     ** warranties of merchantability, fitness for a particular purpose, and
8806     ** non-infringment. This software is provided at no fee on an
8807     ** "as is" basis. The author and/or distritutors have no obligation
8808     ** to provide maintenance, support, updates, enhancements and/or
8809     ** modifications.
8810     **
8811     ** GOVERNMENT USE: If you are acquiring this software on behalf of the
8812     ** U.S. government, the Government shall have only "Restricted Rights"
8813     ** in the software and related documentation as defined in the Federal
8814     ** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
8815     ** are acquiring the software on behalf of the Department of Defense, the
8816     ** software shall be classified as "Commercial Computer Software" and the
8817     ** Government shall have only "Restricted Rights" as defined in Clause
8818     ** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
8819     ** author grants the U.S. Government and others acting in its behalf
8820     ** permission to use and distribute the software in accordance with the
8821     ** terms specified in this license.
8822     */
8823     #include <ctype.h>
8824     #include <string.h>
8825     #include <stdarg.h>
8826     #include <stdio.h>
8827     #include <stdlib.h>
8828     #include <sys/types.h>
8829     #include <sys/stat.h>
8830     #include <fcntl.h>
8831    
8832     /* Include either the Tcl or the Tk header file. Use the "Internal"
8833     ** version of the header file if and only if we are generating an
8834     ** extension that is linking against the Stub library.
8835     ** Many installations do not have the internal header files
8836     ** available, so using the internal headers only when absolutely
8837     ** necessary will help to reduce compilation problems.
8838     */
8839     #if ET_EXTENSION && defined(TCL_USE_STUBS)
8840     # if ET_ENABLE_TK
8841     # include <tkInt.h>
8842     # else
8843     # include <tclInt.h>
8844     # endif
8845     #else
8846     # if ET_ENABLE_TK
8847     # include <tk.h>
8848     # else
8849     # include <tcl.h>
8850     # endif
8851     #endif
8852    
8853     /*
8854     ** ET_WIN32 is true if we are running Tk under windows. The
8855     ** <tcl.h> module will define __WIN32__ for us if we are compiling
8856     ** for windows.
8857     */
8858     #if defined(__WIN32__) && ET_ENABLE_TK
8859     # define ET_WIN32 1
8860     # include <windows.h>
8861     #else
8862     # define ET_WIN32 0
8863     #endif
8864    
8865     /*
8866     ** Always disable ET_AUTO_FORK under windows. Windows doesn't
8867     ** fork well.
8868     */
8869     #if defined(__WIN32__)
8870     # undef ET_AUTO_FORK
8871     # define ET_AUTO_FORK 0
8872     #endif
8873    
8874     /*
8875     ** Omit <unistd.h> under windows. But we need it for Unix.
8876     */
8877     #if !defined(__WIN32__)
8878     # include <unistd.h>
8879     #endif
8880    
8881     /*
8882     ** The Tcl*InsertProc functions allow the system calls "stat",
8883     ** "access" and "open" to be overloaded. This in turns allows us
8884     ** to substituted compiled-in strings for files in the filesystem.
8885     ** But the Tcl*InsertProc functions are only available in Tcl8.0.3
8886     ** and later.
8887     **
8888     ** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing
8889     ** with Tcl8.0.3 or later.
8890     */
8891     #if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 || TCL_RELEASE_SERIAL>=3)
8892     # define ET_HAVE_INSERTPROC
8893     #endif
8894    
8895     /*
8896     ** If we are using the Tcl*InsertProc() functions, we should provide
8897     ** prototypes for them. But the prototypes are in the tclInt.h include
8898     ** file, which we don't want to require the user to have on hand. So
8899     ** we provide our own prototypes here.
8900     **
8901     ** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required
8902     ** anyway, so these prototypes are not included if TCL_USE_STUBS is
8903     ** defined.
8904     */
8905     #if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS)
8906     #ifdef __cplusplus
8907     extern "C" int TclStatInsertProc(int (*)(char*, struct stat *));
8908     extern "C" int TclAccessInsertProc(int (*)(char*, int));
8909     extern "C" int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
8910     char*,int));
8911     #else
8912     extern int TclStatInsertProc(int (*)(char*, struct stat *));
8913     extern int TclAccessInsertProc(int (*)(char*, int));
8914     extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,
8915     char*,int));
8916     #endif
8917     #endif
8918    
8919    
8920     /*
8921     ** Don't allow Win32 applications to read from stdin. Nor
8922     ** programs that automatically go into the background. Force
8923     ** the use of a console in these cases.
8924     */
8925     #if (ET_WIN32 || ET_AUTO_FORK) && ET_READ_STDIN
8926     # undef ET_READ_STDIN
8927     # undef ET_CONSOLE
8928     # define ET_READ_STDIN 0
8929     # define ET_CONSOLE 1
8930     #endif
8931    
8932     /*
8933     ** The console won't work without Tk.
8934     */
8935     #if ET_ENABLE_TK==0 && ET_CONSOLE
8936     # undef ET_CONSOLE
8937     # define ET_CONSOLE 0
8938     # undef ET_READ_STDIN
8939     # define ET_READ_STDIN 1
8940     #endif
8941    
8942     /*
8943     ** We MUST start using Tcl_GetStringResult() in Tcl8.3
8944     ** But these functions didn't exists in Tcl 7.6. So make
8945     ** them macros.
8946     */
8947     #if TCL_MAJOR_VERSION<8
8948     # define Tcl_GetStringResult(I) ((I)->result)
8949     #endif
8950    
8951     /*
8952     ** Set ET_HAVE_OBJ to true if we are able to link against the
8953     ** new Tcl_Obj interface. This is only the case for Tcl version
8954     ** 8.0 and later.
8955     */
8956     #if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8
8957     # define ET_HAVE_OBJ 1
8958     #else
8959     # define ET_HAVE_OBJ 0
8960     #endif
8961    
8962     /*
8963     ** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1
8964     ** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X
8965     */
8966     #if ET_HAVE_OBJ && TCL_MINOR_VERSION==0
8967     # define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj
8968     #endif
8969    
8970     /*
8971     ** Tcl code to implement the console.
8972     **
8973     ** This code is written and tested separately, then run through
8974     ** "mktclapp -stringify" and then pasted in here.
8975     */
8976     #if ET_ENABLE_TK && !ET_EXTENSION
8977     static char zEtConsole[] =
8978     "proc console:create {w prompt title} {\n"
8979     "upvar #0 $w.t v\n"
8980     "if {[winfo exists $w]} {destroy $w}\n"
8981     "if {[info exists v]} {unset v}\n"
8982     "toplevel $w\n"
8983     "wm title $w $title\n"
8984     "wm iconname $w $title\n"
8985     "frame $w.mb -bd 2 -relief raised\n"
8986     "pack $w.mb -side top -fill x\n"
8987     "menubutton $w.mb.file -text File -menu $w.mb.file.m\n"
8988     "menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\n"
8989     "pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\n"
8990     "set m [menu $w.mb.file.m]\n"
8991     "$m add command -label {Source...} -command \"console:SourceFile $w.t\"\n"
8992     "$m add command -label {Save As...} -command \"console:SaveFile $w.t\"\n"
8993     "$m add separator\n"
8994     "$m add command -label {Close} -command \"destroy $w\"\n"
8995     "$m add command -label {Exit} -command exit\n"
8996     "set m [menu $w.mb.edit.m]\n"
8997     "$m add command -label Cut -command \"console:Cut $w.t\"\n"
8998     "$m add command -label Copy -command \"console:Copy $w.t\"\n"
8999     "$m add command -label Paste -command \"console:Paste $w.t\"\n"
9000     "$m add command -label {Clear Screen} -command \"console:Clear $w.t\"\n"
9001     "catch {$m config -postcommand \"console:EnableEditMenu $w\"}\n"
9002     "scrollbar $w.sb -orient vertical -command \"$w.t yview\"\n"
9003     "pack $w.sb -side right -fill y\n"
9004     "text $w.t -font fixed -yscrollcommand \"$w.sb set\"\n"
9005     "pack $w.t -side right -fill both -expand 1\n"
9006     "bindtags $w.t Console\n"
9007     "set v(text) $w.t\n"
9008     "set v(history) 0\n"
9009     "set v(historycnt) 0\n"
9010     "set v(current) -1\n"
9011     "set v(prompt) $prompt\n"
9012     "set v(prior) {}\n"
9013     "set v(plength) [string length $v(prompt)]\n"
9014     "set v(x) 0\n"
9015     "set v(y) 0\n"
9016     "$w.t mark set insert end\n"
9017     "$w.t tag config ok -foreground blue\n"
9018     "$w.t tag config err -foreground red\n"
9019     "$w.t insert end $v(prompt)\n"
9020     "$w.t mark set out 1.0\n"
9021     "catch {rename puts console:oldputs$w}\n"
9022     "proc puts args [format {\n"
9023     "if {![winfo exists %s]} {\n"
9024     "rename puts {}\n"
9025     "rename console:oldputs%s puts\n"
9026     "return [uplevel #0 puts $args]\n"
9027     "}\n"
9028     "switch -glob -- \"[llength $args] $args\" {\n"
9029     "{1 *} {\n"
9030     "set msg [lindex $args 0]\\n\n"
9031     "set tag ok\n"
9032     "}\n"
9033     "{2 stdout *} {\n"
9034     "set msg [lindex $args 1]\\n\n"
9035     "set tag ok\n"
9036     "}\n"
9037     "{2 stderr *} {\n"
9038     "set msg [lindex $args 1]\\n\n"
9039     "set tag err\n"
9040     "}\n"
9041     "{2 -nonewline *} {\n"
9042     "set msg [lindex $args 1]\n"
9043     "set tag ok\n"
9044     "}\n"
9045     "{3 -nonewline stdout *} {\n"
9046     "set msg [lindex $args 2]\n"
9047     "set tag ok\n"
9048     "}\n"
9049     "{3 -nonewline stderr *} {\n"
9050     "set msg [lindex $args 2]\n"
9051     "set tag err\n"
9052     "}\n"
9053     "default {\n"
9054     "uplevel #0 console:oldputs%s $args\n"
9055     "return\n"
9056     "}\n"
9057     "}\n"
9058     "console:Puts %s $msg $tag\n"
9059     "} $w $w $w $w.t]\n"
9060     "after idle \"focus $w.t\"\n"
9061     "}\n"
9062     "bind Console <1> {console:Button1 %W %x %y}\n"
9063     "bind Console <B1-Motion> {console:B1Motion %W %x %y}\n"
9064     "bind Console <B1-Leave> {console:B1Leave %W %x %y}\n"
9065     "bind Console <B1-Enter> {console:cancelMotor %W}\n"
9066     "bind Console <ButtonRelease-1> {console:cancelMotor %W}\n"
9067     "bind Console <KeyPress> {console:Insert %W %A}\n"
9068     "bind Console <Left> {console:Left %W}\n"
9069     "bind Console <Control-b> {console:Left %W}\n"
9070     "bind Console <Right> {console:Right %W}\n"
9071     "bind Console <Control-f> {console:Right %W}\n"
9072     "bind Console <BackSpace> {console:Backspace %W}\n"
9073     "bind Console <Control-h> {console:Backspace %W}\n"
9074     "bind Console <Delete> {console:Delete %W}\n"
9075     "bind Console <Control-d> {console:Delete %W}\n"
9076     "bind Console <Home> {console:Home %W}\n"
9077     "bind Console <Control-a> {console:Home %W}\n"
9078     "bind Console <End> {console:End %W}\n"
9079     "bind Console <Control-e> {console:End %W}\n"
9080     "bind Console <Return> {console:Enter %W}\n"
9081     "bind Console <KP_Enter> {console:Enter %W}\n"
9082     "bind Console <Up> {console:Prior %W}\n"
9083     "bind Console <Control-p> {console:Prior %W}\n"
9084     "bind Console <Down> {console:Next %W}\n"
9085     "bind Console <Control-n> {console:Next %W}\n"
9086     "bind Console <Control-k> {console:EraseEOL %W}\n"
9087     "bind Console <<Cut>> {console:Cut %W}\n"
9088     "bind Console <<Copy>> {console:Copy %W}\n"
9089     "bind Console <<Paste>> {console:Paste %W}\n"
9090     "bind Console <<Clear>> {console:Clear %W}\n"
9091     "proc console:Puts {w t tag} {\n"
9092     "set nc [string length $t]\n"
9093     "set endc [string index $t [expr $nc-1]]\n"
9094     "if {$endc==\"\\n\"} {\n"
9095     "if {[$w index out]<[$w index {insert linestart}]} {\n"
9096     "$w insert out [string range $t 0 [expr $nc-2]] $tag\n"
9097     "$w mark set out {out linestart +1 lines}\n"
9098     "} else {\n"
9099     "$w insert out $t $tag\n"
9100     "}\n"
9101     "} else {\n"
9102     "if {[$w index out]<[$w index {insert linestart}]} {\n"
9103     "$w insert out $t $tag\n"
9104     "} else {\n"
9105     "$w insert out $t\\n $tag\n"
9106     "$w mark set out {out -1 char}\n"
9107     "}\n"
9108     "}\n"
9109     "$w yview insert\n"
9110     "}\n"
9111     "proc console:Insert {w a} {\n"
9112     "$w insert insert $a\n"
9113     "$w yview insert\n"
9114     "}\n"
9115     "proc console:Left {w} {\n"
9116     "upvar #0 $w v\n"
9117     "scan [$w index insert] %d.%d row col\n"
9118     "if {$col>$v(plength)} {\n"
9119     "$w mark set insert \"insert -1c\"\n"
9120     "}\n"
9121     "}\n"
9122     "proc console:Backspace {w} {\n"
9123     "upvar #0 $w v\n"
9124     "scan [$w index insert] %d.%d row col\n"
9125     "if {$col>$v(plength)} {\n"
9126     "$w delete {insert -1c}\n"
9127     "}\n"
9128     "}\n"
9129     "proc console:EraseEOL {w} {\n"
9130     "upvar #0 $w v\n"
9131     "scan [$w index insert] %d.%d row col\n"
9132     "if {$col>=$v(plength)} {\n"
9133     "$w delete insert {insert lineend}\n"
9134     "}\n"
9135     "}\n"
9136     "proc console:Right {w} {\n"
9137     "$w mark set insert \"insert +1c\"\n"
9138     "}\n"
9139     "proc console:Delete w {\n"
9140     "$w delete insert\n"
9141     "}\n"
9142     "proc console:Home w {\n"
9143     "upvar #0 $w v\n"
9144     "scan [$w index insert] %d.%d row col\n"
9145     "$w mark set insert $row.$v(plength)\n"
9146     "}\n"
9147     "proc console:End w {\n"
9148     "$w mark set insert {insert lineend}\n"
9149     "}\n"
9150     "proc console:Enter w {\n"
9151     "upvar #0 $w v\n"
9152     "scan [$w index insert] %d.%d row col\n"
9153     "set start $row.$v(plength)\n"
9154     "set line [$w get $start \"$start lineend\"]\n"
9155     "if {$v(historycnt)>0} {\n"
9156     "set last [lindex $v(history) [expr $v(historycnt)-1]]\n"
9157     "if {[string compare $last $line]} {\n"
9158     "lappend v(history) $line\n"
9159     "incr v(historycnt)\n"
9160     "}\n"
9161     "} else {\n"
9162     "set v(history) [list $line]\n"
9163     "set v(historycnt) 1\n"
9164     "}\n"
9165     "set v(current) $v(historycnt)\n"
9166     "$w insert end \\n\n"
9167     "$w mark set out end\n"
9168     "if {$v(prior)==\"\"} {\n"
9169     "set cmd $line\n"
9170     "} else {\n"
9171     "set cmd $v(prior)\\n$line\n"
9172     "}\n"
9173     "if {[info complete $cmd]} {\n"
9174     "set rc [catch {uplevel #0 $cmd} res]\n"
9175     "if {![winfo exists $w]} return\n"
9176     "if {$rc} {\n"
9177     "$w insert end $res\\n err\n"
9178     "} elseif {[string length $res]>0} {\n"
9179     "$w insert end $res\\n ok\n"
9180     "}\n"
9181     "set v(prior) {}\n"
9182     "$w insert end $v(prompt)\n"
9183     "} else {\n"
9184     "set v(prior) $cmd\n"
9185     "regsub -all {[^ ]} $v(prompt) . x\n"
9186     "$w insert end $x\n"
9187     "}\n"
9188     "$w mark set insert end\n"
9189     "$w mark set out {insert linestart}\n"
9190     "$w yview insert\n"
9191     "}\n"
9192     "proc console:Prior w {\n"
9193     "upvar #0 $w v\n"
9194     "if {$v(current)<=0} return\n"
9195     "incr v(current) -1\n"
9196     "set line [lindex $v(history) $v(current)]\n"
9197     "console:SetLine $w $line\n"
9198     "}\n"
9199     "proc console:Next w {\n"
9200     "upvar #0 $w v\n"
9201     "if {$v(current)>=$v(historycnt)} return\n"
9202     "incr v(current) 1\n"
9203     "set line [lindex $v(history) $v(current)]\n"
9204     "console:SetLine $w $line\n"
9205     "}\n"
9206     "proc console:SetLine {w line} {\n"
9207     "upvar #0 $w v\n"
9208     "scan [$w index insert] %d.%d row col\n"
9209     "set start $row.$v(plength)\n"
9210     "$w delete $start end\n"
9211     "$w insert end $line\n"
9212     "$w mark set insert end\n"
9213     "$w yview insert\n"
9214     "}\n"
9215     "proc console:Button1 {w x y} {\n"
9216     "global tkPriv\n"
9217     "upvar #0 $w v\n"
9218     "set v(mouseMoved) 0\n"
9219     "set v(pressX) $x\n"
9220     "set p [console:nearestBoundry $w $x $y]\n"
9221     "scan [$w index insert] %d.%d ix iy\n"
9222     "scan $p %d.%d px py\n"
9223     "if {$px==$ix} {\n"
9224     "$w mark set insert $p\n"
9225     "}\n"
9226     "$w mark set anchor $p\n"
9227     "focus $w\n"
9228     "}\n"
9229     "proc console:nearestBoundry {w x y} {\n"
9230     "set p [$w index @$x,$y]\n"
9231     "set bb [$w bbox $p]\n"
9232     "if {![string compare $bb \"\"]} {return $p}\n"
9233     "if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\n"
9234     "$w index \"$p + 1 char\"\n"
9235     "}\n"
9236     "proc console:SelectTo {w x y} {\n"
9237     "upvar #0 $w v\n"
9238     "set cur [console:nearestBoundry $w $x $y]\n"
9239     "if {[catch {$w index anchor}]} {\n"
9240     "$w mark set anchor $cur\n"
9241     "}\n"
9242     "set anchor [$w index anchor]\n"
9243     "if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {\n"
9244     "if {$v(mouseMoved)==0} {\n"
9245     "$w tag remove sel 0.0 end\n"
9246     "}\n"
9247     "set v(mouseMoved) 1\n"
9248     "}\n"
9249     "if {[$w compare $cur < anchor]} {\n"
9250     "set first $cur\n"
9251     "set last anchor\n"
9252     "} else {\n"
9253     "set first anchor\n"
9254     "set last $cur\n"
9255     "}\n"
9256     "if {$v(mouseMoved)} {\n"
9257     "$w tag remove sel 0.0 $first\n"
9258     "$w tag add sel $first $last\n"
9259     "$w tag remove sel $last end\n"
9260     "update idletasks\n"
9261     "}\n"
9262     "}\n"
9263     "proc console:B1Motion {w x y} {\n"
9264     "upvar #0 $w v\n"
9265     "set v(y) $y\n"
9266     "set v(x) $x\n"
9267     "console:SelectTo $w $x $y\n"
9268     "}\n"
9269     "proc console:B1Leave {w x y} {\n"
9270     "upvar #0 $w v\n"
9271     "set v(y) $y\n"
9272     "set v(x) $x\n"
9273     "console:motor $w\n"
9274     "}\n"
9275     "proc console:motor w {\n"
9276     "upvar #0 $w v\n"
9277     "if {![winfo exists $w]} return\n"
9278     "if {$v(y)>=[winfo height $w]} {\n"
9279     "$w yview scroll 1 units\n"
9280     "} elseif {$v(y)<0} {\n"
9281     "$w yview scroll -1 units\n"
9282     "} else {\n"
9283     "return\n"
9284     "}\n"
9285     "console:SelectTo $w $v(x) $v(y)\n"
9286     "set v(timer) [after 50 console:motor $w]\n"
9287     "}\n"
9288     "proc console:cancelMotor w {\n"
9289     "upvar #0 $w v\n"
9290     "catch {after cancel $v(timer)}\n"
9291     "catch {unset v(timer)}\n"
9292     "}\n"
9293     "proc console:Copy w {\n"
9294     "if {![catch {set text [$w get sel.first sel.last]}]} {\n"
9295     "clipboard clear -displayof $w\n"
9296     "clipboard append -displayof $w $text\n"
9297     "}\n"
9298     "}\n"
9299     "proc console:canCut w {\n"
9300     "set r [catch {\n"
9301     "scan [$w index sel.first] %d.%d s1x s1y\n"
9302     "scan [$w index sel.last] %d.%d s2x s2y\n"
9303     "scan [$w index insert] %d.%d ix iy\n"
9304     "}]\n"
9305     "if {$r==1} {return 0}\n"
9306     "if {$s1x==$ix && $s2x==$ix} {return 1}\n"
9307     "return 2\n"
9308     "}\n"
9309     "proc console:Cut w {\n"
9310     "if {[console:canCut $w]==1} {\n"
9311     "console:Copy $w\n"
9312     "$w delete sel.first sel.last\n"
9313     "}\n"
9314     "}\n"
9315     "proc console:Paste w {\n"
9316     "if {[console:canCut $w]==1} {\n"
9317     "$w delete sel.first sel.last\n"
9318     "}\n"
9319     "if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\n"
9320     "return\n"
9321     "}\n"
9322     "set prior 0\n"
9323     "foreach line [split $topaste \\n] {\n"
9324     "if {$prior} {\n"
9325     "console:Enter $w\n"
9326     "update\n"
9327     "}\n"
9328     "set prior 1\n"
9329     "$w insert insert $line\n"
9330     "}\n"
9331     "}\n"
9332     "proc console:EnableEditMenu w {\n"
9333     "set m $w.mb.edit.m\n"
9334     "switch [console:canCut $w.t] {\n"
9335     "0 {\n"
9336     "$m entryconf Copy -state disabled\n"
9337     "$m entryconf Cut -state disabled\n"
9338     "}\n"
9339     "1 {\n"
9340     "$m entryconf Copy -state normal\n"
9341     "$m entryconf Cut -state normal\n"
9342     "}\n"
9343     "2 {\n"
9344     "$m entryconf Copy -state normal\n"
9345     "$m entryconf Cut -state disabled\n"
9346     "}\n"
9347     "}\n"
9348     "}\n"
9349     "proc console:SourceFile w {\n"
9350     "set types {\n"
9351     "{{TCL Scripts} {.tcl}}\n"
9352     "{{All Files} *}\n"
9353     "}\n"
9354     "set f [tk_getOpenFile -filetypes $types -title \"TCL Script To Source...\"]\n"
9355     "if {$f!=\"\"} {\n"
9356     "uplevel #0 source $f\n"
9357     "}\n"
9358     "}\n"
9359     "proc console:SaveFile w {\n"
9360     "set types {\n"
9361     "{{Text Files} {.txt}}\n"
9362     "{{All Files} *}\n"
9363     "}\n"
9364     "set f [tk_getSaveFile -filetypes $types -title \"Write Screen To...\"]\n"
9365     "if {$f!=\"\"} {\n"
9366     "if {[catch {open $f w} fd]} {\n"
9367     "tk_messageBox -type ok -icon error -message $fd\n"
9368     "} else {\n"
9369     "puts $fd [string trimright [$w get 1.0 end] \\n]\n"
9370     "close $fd\n"
9371     "}\n"
9372     "}\n"
9373     "}\n"
9374     "proc console:Clear w {\n"
9375     "$w delete 1.0 {insert linestart}\n"
9376     "}\n"
9377     ; /* End of the console code */
9378     #endif /* ET_ENABLE_TK */
9379    
9380     /*
9381     ** The "printf" code that follows dates from the 1980's. It is in
9382     ** the public domain. The original comments are included here for
9383     ** completeness. They are slightly out-of-date.
9384     **
9385     ** The following modules is an enhanced replacement for the "printf" programs
9386     ** found in the standard library. The following enhancements are
9387     ** supported:
9388     **
9389     ** + Additional functions. The standard set of "printf" functions
9390     ** includes printf, fprintf, sprintf, vprintf, vfprintf, and
9391     ** vsprintf. This module adds the following:
9392     **
9393     ** * snprintf -- Works like sprintf, but has an extra argument
9394     ** which is the size of the buffer written to.
9395     **
9396     ** * mprintf -- Similar to sprintf. Writes output to memory
9397     ** obtained from malloc.
9398     **
9399     ** * xprintf -- Calls a function to dispose of output.
9400     **
9401     ** * nprintf -- No output, but returns the number of characters
9402     ** that would have been output by printf.
9403     **
9404     ** * A v- version (ex: vsnprintf) of every function is also
9405     ** supplied.
9406     **
9407     ** + A few extensions to the formatting notation are supported:
9408     **
9409     ** * The "=" flag (similar to "-") causes the output to be
9410     ** be centered in the appropriately sized field.
9411     **
9412     ** * The %b field outputs an integer in binary notation.
9413     **
9414     ** * The %c field now accepts a precision. The character output
9415     ** is repeated by the number of times the precision specifies.
9416     **
9417     ** * The %' field works like %c, but takes as its character the
9418     ** next character of the format string, instead of the next
9419     ** argument. For example, printf("%.78'-") prints 78 minus
9420     ** signs, the same as printf("%.78c",'-').
9421     **
9422     ** + When compiled using GCC on a SPARC, this version of printf is
9423     ** faster than the library printf for SUN OS 4.1.
9424     **
9425     ** + All functions are fully reentrant.
9426     **
9427     */
9428     /*
9429     ** Undefine COMPATIBILITY to make some slight changes in the way things
9430     ** work. I think the changes are an improvement, but they are not
9431     ** backwards compatible.
9432     */
9433     /* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */
9434    
9435     /*
9436     ** Characters that need to be escaped inside a TCL string.
9437     */
9438     static char NeedEsc[] = {
9439     1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1,
9440     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9441     0, 0, '"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9442     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9443     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9444     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[','\\', ']', 0, 0,
9445     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9446     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,
9447     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9448     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9449     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9450     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9451     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9452     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9453     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9454     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
9455     };
9456    
9457     /*
9458     ** Conversion types fall into various categories as defined by the
9459     ** following enumeration.
9460     */
9461     enum et_type { /* The type of the format field */
9462     etRADIX, /* Integer types. %d, %x, %o, and so forth */
9463     etFLOAT, /* Floating point. %f */
9464     etEXP, /* Exponentional notation. %e and %E */
9465     etGENERIC, /* Floating or exponential, depending on exponent. %g */
9466     etSIZE, /* Return number of characters processed so far. %n */
9467     etSTRING, /* Strings. %s */
9468     etPERCENT, /* Percent symbol. %% */
9469     etCHARX, /* Characters. %c */
9470     etERROR, /* Used to indicate no such conversion type */
9471     /* The rest are extensions, not normally found in printf() */
9472     etCHARLIT, /* Literal characters. %' */
9473     etTCLESCAPE, /* Strings with special characters escaped. %q */
9474     etMEMSTRING, /* A string which should be deleted after use. %z */
9475     etORDINAL /* 1st, 2nd, 3rd and so forth */
9476     };
9477    
9478     /*
9479     ** Each builtin conversion character (ex: the 'd' in "%d") is described
9480     ** by an instance of the following structure
9481     */
9482     typedef struct et_info { /* Information about each format field */
9483     int fmttype; /* The format field code letter */
9484     int base; /* The base for radix conversion */
9485     char *charset; /* The character set for conversion */
9486     int flag_signed; /* Is the quantity signed? */
9487     char *prefix; /* Prefix on non-zero values in alt format */
9488     enum et_type type; /* Conversion paradigm */
9489     } et_info;
9490    
9491     /*
9492     ** The following table is searched linearly, so it is good to put the
9493     ** most frequently used conversion types first.
9494     */
9495     static et_info fmtinfo[] = {
9496     { 'd', 10, "0123456789", 1, 0, etRADIX, },
9497     { 's', 0, 0, 0, 0, etSTRING, },
9498     { 'q', 0, 0, 0, 0, etTCLESCAPE, },
9499     { 'z', 0, 0, 0, 0, etMEMSTRING, },
9500     { 'c', 0, 0, 0, 0, etCHARX, },
9501     { 'o', 8, "01234567", 0, "0", etRADIX, },
9502     { 'u', 10, "0123456789", 0, 0, etRADIX, },
9503     { 'x', 16, "0123456789abcdef", 0, "x0", etRADIX, },
9504     { 'X', 16, "0123456789ABCDEF", 0, "X0", etRADIX, },
9505     { 'r', 10, "0123456789", 0, 0, etORDINAL, },
9506     { 'f', 0, 0, 1, 0, etFLOAT, },
9507     { 'e', 0, "e", 1, 0, etEXP, },
9508     { 'E', 0, "E", 1, 0, etEXP, },
9509     { 'g', 0, "e", 1, 0, etGENERIC, },
9510     { 'G', 0, "E", 1, 0, etGENERIC, },
9511     { 'i', 10, "0123456789", 1, 0, etRADIX, },
9512     { 'n', 0, 0, 0, 0, etSIZE, },
9513     { '%', 0, 0, 0, 0, etPERCENT, },
9514     { 'b', 2, "01", 0, "b0", etRADIX, }, /* Binary */
9515     { 'p', 10, "0123456789", 0, 0, etRADIX, }, /* Pointers */
9516     { '\'', 0, 0, 0, 0, etCHARLIT, }, /* Literal char */
9517     };
9518     #define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0]))
9519    
9520     /*
9521     ** If NOFLOATINGPOINT is defined, then none of the floating point
9522     ** conversions will work.
9523     */
9524     #ifndef etNOFLOATINGPOINT
9525     /*
9526     ** "*val" is a double such that 0.1 <= *val < 10.0
9527     ** Return the ascii code for the leading digit of *val, then
9528     ** multiply "*val" by 10.0 to renormalize.
9529     **
9530     ** Example:
9531     ** input: *val = 3.14159
9532     ** output: *val = 1.4159 function return = '3'
9533     **
9534     ** The counter *cnt is incremented each time. After counter exceeds
9535     ** 16 (the number of significant digits in a 64-bit float) '0' is
9536     ** always returned.
9537     */
9538     static int et_getdigit(double *val, int *cnt){
9539     int digit;
9540     double d;
9541     if( (*cnt)++ >= 16 ) return '0';
9542     digit = (int)*val;
9543     d = digit;
9544     digit += '0';
9545     *val = (*val - d)*10.0;
9546     return digit;
9547     }
9548     #endif
9549    
9550     #define etBUFSIZE 1000 /* Size of the output buffer */
9551    
9552     /*
9553     ** The root program. All variations call this core.
9554     **
9555     ** INPUTS:
9556     ** func This is a pointer to a function taking three arguments
9557     ** 1. A pointer to anything. Same as the "arg" parameter.
9558     ** 2. A pointer to the list of characters to be output
9559     ** (Note, this list is NOT null terminated.)
9560     ** 3. An integer number of characters to be output.
9561     ** (Note: This number might be zero.)
9562     **
9563     ** arg This is the pointer to anything which will be passed as the
9564     ** first argument to "func". Use it for whatever you like.
9565     **
9566     ** fmt This is the format string, as in the usual print.
9567     **
9568     ** ap This is a pointer to a list of arguments. Same as in
9569     ** vfprint.
9570     **
9571     ** OUTPUTS:
9572     ** The return value is the total number of characters sent to
9573     ** the function "func". Returns -1 on a error.
9574     **
9575     ** Note that the order in which automatic variables are declared below
9576     ** seems to make a big difference in determining how fast this beast
9577     ** will run.
9578     */
9579     int vxprintf(
9580     void (*func)(void*,char*,int),
9581     void *arg,
9582     const char *format,
9583     va_list ap
9584     ){
9585     register const char *fmt; /* The format string. */
9586     register int c; /* Next character in the format string */
9587     register char *bufpt; /* Pointer to the conversion buffer */
9588     register int precision; /* Precision of the current field */
9589     register int length; /* Length of the field */
9590     register int idx; /* A general purpose loop counter */
9591     int count; /* Total number of characters output */
9592     int width; /* Width of the current field */
9593     int flag_leftjustify; /* True if "-" flag is present */
9594     int flag_plussign; /* True if "+" flag is present */
9595     int flag_blanksign; /* True if " " flag is present */
9596     int flag_alternateform; /* True if "#" flag is present */
9597     int flag_zeropad; /* True if field width constant starts with zero */
9598     int flag_long; /* True if "l" flag is present */
9599     int flag_center; /* True if "=" flag is present */
9600     unsigned long longvalue; /* Value for integer types */
9601     double realvalue; /* Value for real types */
9602     et_info *infop; /* Pointer to the appropriate info structure */
9603     char buf[etBUFSIZE]; /* Conversion buffer */
9604     char prefix; /* Prefix character. "+" or "-" or " " or '\0'. */
9605     int errorflag = 0; /* True if an error is encountered */
9606     enum et_type xtype; /* Conversion paradigm */
9607     char *zMem; /* String to be freed */
9608     char *zExtra; /* Extra memory used for etTCLESCAPE conversions */
9609     static char spaces[] = " "
9610     " ";
9611     #define etSPACESIZE (sizeof(spaces)-1)
9612     #ifndef etNOFLOATINGPOINT
9613     int exp; /* exponent of real numbers */
9614     double rounder; /* Used for rounding floating point values */
9615     int flag_dp; /* True if decimal point should be shown */
9616     int flag_rtz; /* True if trailing zeros should be removed */
9617     int flag_exp; /* True to force display of the exponent */
9618     int nsd; /* Number of significant digits returned */
9619     #endif
9620    
9621     fmt = format; /* Put in a register for speed */
9622     count = length = 0;
9623     bufpt = 0;
9624     for(; (c=(*fmt))!=0; ++fmt){
9625     if( c!='%' ){
9626     register int amt;
9627     bufpt = (char *)fmt;
9628     amt = 1;
9629     while( (c=(*++fmt))!='%' && c!=0 ) amt++;
9630     (*func)(arg,bufpt,amt);
9631     count += amt;
9632     if( c==0 ) break;
9633     }
9634     if( (c=(*++fmt))==0 ){
9635     errorflag = 1;
9636     (*func)(arg,"%",1);
9637     count++;
9638     break;
9639     }
9640     /* Find out what flags are present */
9641     flag_leftjustify = flag_plussign = flag_blanksign =
9642     flag_alternateform = flag_zeropad = flag_center = 0;
9643     do{
9644     switch( c ){
9645     case '-': flag_leftjustify = 1; c = 0; break;
9646     case '+': flag_plussign = 1; c = 0; break;
9647     case ' ': flag_blanksign = 1; c = 0; break;
9648     case '#': flag_alternateform = 1; c = 0; break;
9649     case '0': flag_zeropad = 1; c = 0; break;
9650     case '=': flag_center = 1; c = 0; break;
9651     default: break;
9652     }
9653     }while( c==0 && (c=(*++fmt))!=0 );
9654     if( flag_center ) flag_leftjustify = 0;
9655     /* Get the field width */
9656     width = 0;
9657     if( c=='*' ){
9658     width = va_arg(ap,int);
9659     if( width<0 ){
9660     flag_leftjustify = 1;
9661     width = -width;
9662     }
9663     c = *++fmt;
9664     }else{
9665     while( isdigit(c) ){
9666     width = width*10 + c - '0';
9667     c = *++fmt;
9668     }
9669     }
9670     if( width > etBUFSIZE-10 ){
9671     width = etBUFSIZE-10;
9672     }
9673     /* Get the precision */
9674     if( c=='.' ){
9675     precision = 0;
9676     c = *++fmt;
9677     if( c=='*' ){
9678     precision = va_arg(ap,int);
9679     #ifndef etCOMPATIBILITY
9680     /* This is sensible, but SUN OS 4.1 doesn't do it. */
9681     if( precision<0 ) precision = -precision;
9682     #endif
9683     c = *++fmt;
9684     }else{
9685     while( isdigit(c) ){
9686     precision = precision*10 + c - '0';
9687     c = *++fmt;
9688     }
9689     }
9690     /* Limit the precision to prevent overflowing buf[] during conversion */
9691     if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;
9692     }else{
9693     precision = -1;
9694     }
9695     /* Get the conversion type modifier */
9696     if( c=='l' ){
9697     flag_long = 1;
9698     c = *++fmt;
9699     }else{
9700     flag_long = 0;
9701     }
9702     /* Fetch the info entry for the field */
9703     infop = 0;
9704     for(idx=0; idx<etNINFO; idx++){
9705     if( c==fmtinfo[idx].fmttype ){
9706     infop = &fmtinfo[idx];
9707     break;
9708     }
9709     }
9710     /* No info entry found. It must be an error. */
9711     if( infop==0 ){
9712     xtype = etERROR;
9713     }else{
9714     xtype = infop->type;
9715     }
9716     zExtra = 0;
9717    
9718     /*
9719     ** At this point, variables are initialized as follows:
9720     **
9721     ** flag_alternateform TRUE if a '#' is present.
9722     ** flag_plussign TRUE if a '+' is present.
9723     ** flag_leftjustify TRUE if a '-' is present or if the
9724     ** field width was negative.
9725     ** flag_zeropad TRUE if the width began with 0.
9726     ** flag_long TRUE if the letter 'l' (ell) prefixed
9727     ** the conversion character.
9728     ** flag_blanksign TRUE if a ' ' is present.
9729     ** width The specified field width. This is
9730     ** always non-negative. Zero is the default.
9731     ** precision The specified precision. The default
9732     ** is -1.
9733     ** xtype The class of the conversion.
9734     ** infop Pointer to the appropriate info struct.
9735     */
9736     switch( xtype ){
9737     case etORDINAL:
9738     case etRADIX:
9739     if( flag_long ) longvalue = va_arg(ap,long);
9740     else longvalue = va_arg(ap,int);
9741     #ifdef etCOMPATIBILITY
9742     /* For the format %#x, the value zero is printed "0" not "0x0".
9743     ** I think this is stupid. */
9744     if( longvalue==0 ) flag_alternateform = 0;
9745     #else
9746     /* More sensible: turn off the prefix for octal (to prevent "00"),
9747     ** but leave the prefix for hex. */
9748     if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;
9749     #endif
9750     if( infop->flag_signed ){
9751     if( *(long*)&longvalue<0 ){
9752     longvalue = -*(long*)&longvalue;
9753     prefix = '-';
9754     }else if( flag_plussign ) prefix = '+';
9755     else if( flag_blanksign ) prefix = ' ';
9756     else prefix = 0;
9757     }else prefix = 0;
9758     if( flag_zeropad && precision<width-(prefix!=0) ){
9759     precision = width-(prefix!=0);
9760     }
9761     bufpt = &buf[etBUFSIZE];
9762     if( xtype==etORDINAL ){
9763     long a,b;
9764     a = longvalue%10;
9765     b = longvalue%100;
9766     bufpt -= 2;
9767     if( a==0 || a>3 || (b>10 && b<14) ){
9768     bufpt[0] = 't';
9769     bufpt[1] = 'h';
9770     }else if( a==1 ){
9771     bufpt[0] = 's';
9772     bufpt[1] = 't';
9773     }else if( a==2 ){
9774     bufpt[0] = 'n';
9775     bufpt[1] = 'd';
9776     }else if( a==3 ){
9777     bufpt[0] = 'r';
9778     bufpt[1] = 'd';
9779     }
9780     }
9781     {
9782     register char *cset; /* Use registers for speed */
9783     register int base;
9784     cset = infop->charset;
9785     base = infop->base;
9786     do{ /* Convert to ascii */
9787     *(--bufpt) = cset[longvalue%base];
9788     longvalue = longvalue/base;
9789     }while( longvalue>0 );
9790     }
9791     length = (long)&buf[etBUFSIZE]-(long)bufpt;
9792     for(idx=precision-length; idx>0; idx--){
9793     *(--bufpt) = '0'; /* Zero pad */
9794     }
9795     if( prefix ) *(--bufpt) = prefix; /* Add sign */
9796     if( flag_alternateform && infop->prefix ){ /* Add "0" or "0x" */
9797     char *pre, x;
9798     pre = infop->prefix;
9799     if( *bufpt!=pre[0] ){
9800     for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x;
9801     }
9802     }
9803     length = (long)&buf[etBUFSIZE]-(long)bufpt;
9804     break;
9805     case etFLOAT:
9806     case etEXP:
9807     case etGENERIC:
9808     realvalue = va_arg(ap,double);
9809     #ifndef etNOFLOATINGPOINT
9810     if( precision<0 ) precision = 6; /* Set default precision */
9811     if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;
9812     if( realvalue<0.0 ){
9813     realvalue = -realvalue;
9814     prefix = '-';
9815     }else{
9816     if( flag_plussign ) prefix = '+';
9817     else if( flag_blanksign ) prefix = ' ';
9818     else prefix = 0;
9819     }
9820     if( infop->type==etGENERIC && precision>0 ) precision--;
9821     rounder = 0.0;
9822     #ifdef COMPATIBILITY
9823     /* Rounding works like BSD when the constant 0.4999 is used. Wierd! */
9824     for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);
9825     #else
9826     /* It makes more sense to use 0.5 */
9827     for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);
9828     #endif
9829     if( infop->type==etFLOAT ) realvalue += rounder;
9830     /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */
9831     exp = 0;
9832     if( realvalue>0.0 ){
9833     int k = 0;
9834     while( realvalue>=1e8 && k++<100 ){ realvalue *= 1e-8; exp+=8; }
9835     while( realvalue>=10.0 && k++<100 ){ realvalue *= 0.1; exp++; }
9836     while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; }
9837     while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; }
9838     if( k>=100 ){
9839     bufpt = "NaN";
9840     length = 3;
9841     break;
9842     }
9843     }
9844     bufpt = buf;
9845     /*
9846     ** If the field type is etGENERIC, then convert to either etEXP
9847     ** or etFLOAT, as appropriate.
9848     */
9849     flag_exp = xtype==etEXP;
9850     if( xtype!=etFLOAT ){
9851     realvalue += rounder;
9852     if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }
9853     }
9854     if( xtype==etGENERIC ){
9855     flag_rtz = !flag_alternateform;
9856     if( exp<-4 || exp>precision ){
9857     xtype = etEXP;
9858     }else{
9859     precision = precision - exp;
9860     xtype = etFLOAT;
9861     }
9862     }else{
9863     flag_rtz = 0;
9864     }
9865     /*
9866     ** The "exp+precision" test causes output to be of type etEXP if
9867     ** the precision is too large to fit in buf[].
9868     */
9869     nsd = 0;
9870     if( xtype==etFLOAT && exp+precision<etBUFSIZE-30 ){
9871     flag_dp = (precision>0 || flag_alternateform);
9872     if( prefix ) *(bufpt++) = prefix; /* Sign */
9873     if( exp<0 ) *(bufpt++) = '0'; /* Digits before "." */
9874     else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);
9875     if( flag_dp ) *(bufpt++) = '.'; /* The decimal point */
9876     for(exp++; exp<0 && precision>0; precision--, exp++){
9877     *(bufpt++) = '0';
9878     }
9879     while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
9880     *(bufpt--) = 0; /* Null terminate */
9881     if( flag_rtz && flag_dp ){ /* Remove trailing zeros and "." */
9882     while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
9883     if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
9884     }
9885     bufpt++; /* point to next free slot */
9886     }else{ /* etEXP or etGENERIC */
9887     flag_dp = (precision>0 || flag_alternateform);
9888     if( prefix ) *(bufpt++) = prefix; /* Sign */
9889     *(bufpt++) = et_getdigit(&realvalue,&nsd); /* First digit */
9890     if( flag_dp ) *(bufpt++) = '.'; /* Decimal point */
9891     while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
9892     bufpt--; /* point to last digit */
9893     if( flag_rtz && flag_dp ){ /* Remove tail zeros */
9894     while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
9895     if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
9896     }
9897     bufpt++; /* point to next free slot */
9898     if( exp || flag_exp ){
9899     *(bufpt++) = infop->charset[0];
9900     if( exp<0 ){ *(bufpt++) = '-'; exp = -exp; } /* sign of exp */
9901     else { *(bufpt++) = '+'; }
9902     if( exp>=100 ){
9903     *(bufpt++) = (exp/100)+'0'; /* 100's digit */
9904     exp %= 100;
9905     }
9906     *(bufpt++) = exp/10+'0'; /* 10's digit */
9907     *(bufpt++) = exp%10+'0'; /* 1's digit */
9908     }
9909     }
9910     /* The converted number is in buf[] and zero terminated. Output it.
9911     ** Note that the number is in the usual order, not reversed as with
9912     ** integer conversions. */
9913     length = (long)bufpt-(long)buf;
9914     bufpt = buf;
9915    
9916     /* Special case: Add leading zeros if the flag_zeropad flag is
9917     ** set and we are not left justified */
9918     if( flag_zeropad && !flag_leftjustify && length < width){
9919     int i;
9920     int nPad = width - length;
9921     for(i=width; i>=nPad; i--){
9922     bufpt[i] = bufpt[i-nPad];
9923     }
9924     i = prefix!=0;
9925     while( nPad-- ) bufpt[i++] = '0';
9926     length = width;
9927     }
9928     #endif
9929     break;
9930     case etSIZE:
9931     *(va_arg(ap,int*)) = count;
9932     length = width = 0;
9933     break;
9934     case etPERCENT:
9935     buf[0] = '%';
9936     bufpt = buf;
9937     length = 1;
9938     break;
9939     case etCHARLIT:
9940     case etCHARX:
9941     c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt);
9942     if( precision>=0 ){
9943     for(idx=1; idx<precision; idx++) buf[idx] = c;
9944     length = precision;
9945     }else{
9946     length =1;
9947     }
9948     bufpt = buf;
9949     break;
9950     case etSTRING:
9951     case etMEMSTRING:
9952     zMem = bufpt = va_arg(ap,char*);
9953     if( bufpt==0 ) bufpt = "(null)";
9954     length = strlen(bufpt);
9955     if( precision>=0 && precision<length ) length = precision;
9956     break;
9957     case etTCLESCAPE:
9958     {
9959     int i, j, n, c, k;
9960     char *arg = va_arg(ap,char*);
9961     if( arg==0 ) arg = "(NULL)";
9962     for(i=n=0; (c=arg[i])!=0; i++){
9963     k = NeedEsc[c&0xff];
9964     if( k==0 ){
9965     n++;
9966     }else if( k==1 ){
9967     n+=4;
9968     }else{
9969     n+=2;
9970     }
9971     }
9972     n++;
9973     if( n>etBUFSIZE ){
9974     bufpt = zExtra = Tcl_Alloc( n );
9975     }else{
9976     bufpt = buf;
9977     }
9978     for(i=j=0; (c=arg[i])!=0; i++){
9979     k = NeedEsc[c&0xff];
9980     if( k==0 ){
9981     bufpt[j++] = c;
9982     }else if( k==1 ){
9983     bufpt[j++] = '\\';
9984     bufpt[j++] = ((c>>6) & 3) + '0';
9985     bufpt[j++] = ((c>>3) & 7) + '0';
9986     bufpt[j++] = (c & 7) + '0';
9987     }else{
9988     bufpt[j++] = '\\';
9989     bufpt[j++] = k;
9990     }
9991     }
9992     bufpt[j] = 0;
9993     length = j;
9994     if( precision>=0 && precision<length ) length = precision;
9995     }
9996     break;
9997     case etERROR:
9998     buf[0] = '%';
9999     buf[1] = c;
10000     errorflag = 0;
10001     idx = 1+(c!=0);
10002     (*func)(arg,"%",idx);
10003     count += idx;
10004     if( c==0 ) fmt--;
10005     break;
10006     }/* End switch over the format type */
10007     /*
10008     ** The text of the conversion is pointed to by "bufpt" and is
10009     ** "length" characters long. The field width is "width". Do
10010     ** the output.
10011     */
10012     if( !flag_leftjustify ){
10013     register int nspace;
10014     nspace = width-length;
10015     if( nspace>0 ){
10016     if( flag_center ){
10017     nspace = nspace/2;
10018     width -= nspace;
10019     flag_leftjustify = 1;
10020     }
10021     count += nspace;
10022     while( nspace>=etSPACESIZE ){
10023     (*func)(arg,spaces,etSPACESIZE);
10024     nspace -= etSPACESIZE;
10025     }
10026     if( nspace>0 ) (*func)(arg,spaces,nspace);
10027     }
10028     }
10029     if( length>0 ){
10030     (*func)(arg,bufpt,length);
10031     count += length;
10032     }
10033     if( xtype==etMEMSTRING && zMem ){
10034     Tcl_Free(zMem);
10035     }
10036     if( flag_leftjustify ){
10037     register int nspace;
10038     nspace = width-length;
10039     if( nspace>0 ){
10040     count += nspace;
10041     while( nspace>=etSPACESIZE ){
10042     (*func)(arg,spaces,etSPACESIZE);
10043     nspace -= etSPACESIZE;
10044     }
10045     if( nspace>0 ) (*func)(arg,spaces,nspace);
10046     }
10047     }
10048     if( zExtra ){
10049     Tcl_Free(zExtra);
10050     }
10051     }/* End for loop over the format string */
10052     return errorflag ? -1 : count;
10053     } /* End of function */
10054    
10055     /*
10056     ** The following section of code handles the mprintf routine, that
10057     ** writes to memory obtained from malloc().
10058     */
10059    
10060     /* This structure is used to store state information about the
10061     ** write to memory that is currently in progress.
10062     */
10063     struct sgMprintf {
10064     char *zBase; /* A base allocation */
10065     char *zText; /* The string collected so far */
10066     int nChar; /* Length of the string so far */
10067     int nAlloc; /* Amount of space allocated in zText */
10068     };
10069    
10070     /*
10071     ** The xprintf callback function.
10072     **
10073     ** This routine add nNewChar characters of text in zNewText to
10074     ** the sgMprintf structure pointed to by "arg".
10075     */
10076     static void mout(void *arg, char *zNewText, int nNewChar){
10077     struct sgMprintf *pM = (struct sgMprintf*)arg;
10078     if( pM->nChar + nNewChar + 1 > pM->nAlloc ){
10079     pM->nAlloc = pM->nChar + nNewChar*2 + 1;
10080     if( pM->zText==pM->zBase ){
10081     pM->zText = Tcl_Alloc(pM->nAlloc);
10082     if( pM->zText && pM->nChar ) memcpy(pM->zText,pM->zBase,pM->nChar);
10083     }else{
10084     pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc);
10085     }
10086     }
10087     if( pM->zText ){
10088     memcpy(&pM->zText[pM->nChar], zNewText, nNewChar);
10089     pM->nChar += nNewChar;
10090     pM->zText[pM->nChar] = 0;
10091     }
10092     }
10093    
10094     /*
10095     ** mprintf() works like printf(), but allocations memory to hold the
10096     ** resulting string and returns a pointer to the allocated memory.
10097     */
10098     char *mprintf(const char *zFormat, ...){
10099     va_list ap;
10100     struct sgMprintf sMprintf;
10101     char *zNew;
10102     char zBuf[200];
10103    
10104     sMprintf.nChar = 0;
10105     sMprintf.nAlloc = sizeof(zBuf);
10106     sMprintf.zText = zBuf;
10107     sMprintf.zBase = zBuf;
10108     va_start(ap,zFormat);
10109     vxprintf(mout,&sMprintf,zFormat,ap);
10110     va_end(ap);
10111     sMprintf.zText[sMprintf.nChar] = 0;
10112     if( sMprintf.zText==sMprintf.zBase ){
10113     zNew = Tcl_Alloc( sMprintf.nChar+1 );
10114     if( zNew ) strcpy(zNew,zBuf);
10115     }else{
10116     zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);
10117     }
10118     return zNew;
10119     }
10120    
10121     /* This is the varargs version of mprintf.
10122     */
10123     char *vmprintf(const char *zFormat, va_list ap){
10124     struct sgMprintf sMprintf;
10125     char zBuf[200];
10126     sMprintf.nChar = 0;
10127     sMprintf.zText = zBuf;
10128     sMprintf.nAlloc = sizeof(zBuf);
10129     sMprintf.zBase = zBuf;
10130     vxprintf(mout,&sMprintf,zFormat,ap);
10131     sMprintf.zText[sMprintf.nChar] = 0;
10132     if( sMprintf.zText==sMprintf.zBase ){
10133     sMprintf.zText = Tcl_Alloc( strlen(zBuf)+1 );
10134     if( sMprintf.zText ) strcpy(sMprintf.zText,zBuf);
10135     }else{
10136     sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);
10137     }
10138     return sMprintf.zText;
10139     }
10140    
10141     /*
10142     ** Add text output to a Tcl_DString.
10143     **
10144     ** This routine is called by vxprintf(). It's job is to add
10145     ** nNewChar characters of text from zNewText to the Tcl_DString
10146     ** that "arg" is pointing to.
10147     */
10148     static void dstringout(void *arg, char *zNewText, int nNewChar){
10149     Tcl_DString *str = (Tcl_DString*)arg;
10150     Tcl_DStringAppend(str,zNewText,nNewChar);
10151     }
10152    
10153     /*
10154     ** Append formatted output to a DString.
10155     */
10156     char *Et_DStringAppendF(Tcl_DString *str, const char *zFormat, ...){
10157     va_list ap;
10158     va_start(ap,zFormat);
10159     vxprintf(dstringout,str,zFormat,ap);
10160     va_end(ap);
10161     return Tcl_DStringValue(str);
10162     }
10163    
10164     /*
10165     ** Make this variable true to trace all calls to EvalF
10166     */
10167     int Et_EvalTrace = 0;
10168    
10169     /*
10170     ** Eval the results of a string.
10171     */
10172     int Et_EvalF(Tcl_Interp *interp, const char *zFormat, ...){
10173     char *zCmd;
10174     va_list ap;
10175     int result;
10176     va_start(ap,zFormat);
10177     zCmd = vmprintf(zFormat,ap);
10178     if( Et_EvalTrace ) printf("%s\n",zCmd);
10179     result = Tcl_Eval(interp,zCmd);
10180     if( Et_EvalTrace ) printf("%d %s\n",result,Tcl_GetStringResult(interp));
10181     Tcl_Free(zCmd);
10182     return result;
10183     }
10184     int Et_GlobalEvalF(Tcl_Interp *interp, const char *zFormat, ...){
10185     char *zCmd;
10186     va_list ap;
10187     int result;
10188     va_start(ap,zFormat);
10189     zCmd = vmprintf(zFormat,ap);
10190     if( Et_EvalTrace ) printf("%s\n",zCmd);
10191     result = Tcl_GlobalEval(interp,zCmd);
10192     if( Et_EvalTrace ) printf("%d %s\n",result,Tcl_GetStringResult(interp));
10193     Tcl_Free(zCmd);
10194     return result;
10195     }
10196    
10197     /*
10198     ** Set the result of an interpreter using printf-like arguments.
10199     */
10200     void Et_ResultF(Tcl_Interp *interp, const char *zFormat, ...){
10201     Tcl_DString str;
10202     va_list ap;
10203    
10204     Tcl_DStringInit(&str);
10205     va_start(ap,zFormat);
10206     vxprintf(dstringout,&str,zFormat,ap);
10207     va_end(ap);
10208     Tcl_DStringResult(interp,&str);
10209     }
10210    
10211     #if ET_HAVE_OBJ
10212     /*
10213     ** Append text to a string object.
10214     */
10215     int Et_AppendObjF(Tcl_Obj *pObj, const char *zFormat, ...){
10216     va_list ap;
10217     int rc;
10218    
10219     va_start(ap,zFormat);
10220     rc = vxprintf((void(*)(void*,char*,int))Tcl_AppendToObj, pObj, zFormat, ap);
10221     va_end(ap);
10222     return rc;
10223     }
10224     #endif
10225    
10226    
10227     #if ET_WIN32
10228     /*
10229     ** This array translates all characters into themselves. Except
10230     ** for the \ which gets translated into /. And all upper-case
10231     ** characters are translated into lower case. This is used for
10232     ** hashing and comparing filenames, to work around the Windows
10233     ** bug of ignoring filename case and using the wrong separator
10234     ** character for directories.
10235     **
10236     ** The array is initialized by FilenameHashInit().
10237     **
10238     ** We also define a macro ET_TRANS() that actually does
10239     ** the character translation. ET_TRANS() is a no-op under
10240     ** unix.
10241     */
10242     static char charTrans[256];
10243     #define ET_TRANS(X) (charTrans[0xff&(int)(X)])
10244     #else
10245     #define ET_TRANS(X) (X)
10246     #endif
10247    
10248     /*
10249     ** Hash a filename. The value returned is appropriate for
10250     ** indexing into the Et_FileHashTable[] array.
10251     */
10252     static int FilenameHash(char *zName){
10253     int h = 0;
10254     while( *zName ){
10255     h = h ^ (h<<5) ^ ET_TRANS(*(zName++));
10256     }
10257     if( h<0 ) h = -h;
10258     return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0]));
10259     }
10260    
10261     /*
10262     ** Compare two filenames. Return 0 if they are the same and
10263     ** non-zero if they are different.
10264     */
10265     static int FilenameCmp(char *z1, char *z2){
10266     int diff;
10267     while( (diff = ET_TRANS(*z1)-ET_TRANS(*z2))==0 && *z1!=0){
10268     z1++;
10269     z2++;
10270     }
10271     return diff;
10272     }
10273    
10274     /*
10275     ** Initialize the file hash table
10276     */
10277     static void FilenameHashInit(void){
10278     int i;
10279     #if ET_WIN32
10280     for(i=0; i<sizeof(charTrans); i++){
10281     charTrans[i] = i;
10282     }
10283     for(i='A'; i<='Z'; i++){
10284     charTrans[i] = i + 'a' - 'A';
10285     }
10286     charTrans['\\'] = '/';
10287     #endif
10288     for(i=0; i<sizeof(Et_FileSet)/sizeof(Et_FileSet[0]) - 1; i++){
10289     struct EtFile *p;
10290     int h;
10291     p = &Et_FileSet[i];
10292     h = FilenameHash(p->zName);
10293     p->pNext = Et_FileHashTable[h];
10294     Et_FileHashTable[h] = p;
10295     }
10296     }
10297    
10298     /*
10299     ** Locate the text of a built-in file given its name.
10300     ** Return 0 if not found. Return this size of the file (not
10301     ** counting the null-terminator) in *pSize if pSize!=NULL.
10302     **
10303     ** If deshroud==1 and the file is shrouded, then descramble
10304     ** the text.
10305     */
10306     static char *FindBuiltinFile(char *zName, int deshroud, int *pSize){
10307     int h;
10308     struct EtFile *p;
10309    
10310     h = FilenameHash(zName);
10311     p = Et_FileHashTable[h];
10312     while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; }
10313     #if ET_SHROUD_KEY>0
10314     if( p && p->shrouded && deshroud ){
10315     char *z;
10316     int xor = ET_SHROUD_KEY;
10317     for(z=p->zData; *z; z++){
10318     if( *z>=0x20 ){ *z ^= xor; xor = (xor+1)&0x1f; }
10319     }
10320     p->shrouded = 0;
10321     }
10322     #endif
10323     if( p && pSize ){
10324     *pSize = p->nData;
10325     }
10326     return p ? p->zData : 0;
10327     }
10328    
10329     /*
10330     ** Add a new file to the list of built-in files.
10331     **
10332     ** This routine makes a copy of zFilename. But it does NOT make
10333     ** a copy of zData. It just holds a pointer to zData and uses
10334     ** that for all file access. So after calling this routine,
10335     ** you should never change zData!
10336     */
10337     void Et_NewBuiltinFile(
10338     char *zFilename, /* Name of the new file */
10339     char *zData, /* Data for the new file */
10340     int nData /* Number of bytes in the new file */
10341     ){
10342     int h;
10343     struct EtFile *p;
10344    
10345     p = (struct EtFile*)Tcl_Alloc( sizeof(struct EtFile) + strlen(zFilename) + 1);
10346     if( p==0 ) return;
10347     p->zName = (char*)&p[1];
10348     strcpy(p->zName, zFilename);
10349     p->zData = zData;
10350     p->nData = nData;
10351     p->shrouded = 0;
10352     h = FilenameHash(zFilename);
10353     p->pNext = Et_FileHashTable[h];
10354     Et_FileHashTable[h] = p;
10355     }
10356    
10357     /*
10358     ** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0
10359     ** and later, we make this an Obj command so that it can deal with
10360     ** binary data.
10361     */
10362     #if ET_HAVE_OBJ
10363     static int Et_NewBuiltinFileCmd(ET_OBJARGS){
10364     char *zData, *zNew;
10365     int nData;
10366     if( objc!=3 ){
10367     Tcl_WrongNumArgs(interp, 1, objv, "filename data");
10368     return TCL_ERROR;
10369     }
10370     zData = (char*)Tcl_GetByteArrayFromObj(objv[2], &nData);
10371     zNew = Tcl_Alloc( nData + 1 );
10372     if( zNew ){
10373     memcpy(zNew, zData, nData);
10374     zNew[nData] = 0;
10375     Et_NewBuiltinFile(Tcl_GetStringFromObj(objv[1], 0), zNew, nData);
10376     }
10377     return TCL_OK;
10378     }
10379     #else
10380     static int Et_NewBuiltinFileCmd(ET_TCLARGS){
10381     char *zData;
10382     int nData;
10383     if( argc!=3 ){
10384     Et_ResultF(interp,"wrong # args: should be \"%s FILENAME DATA\"", argv[0]);
10385     return TCL_ERROR;
10386     }
10387     nData = strlen(argv[2]) + 1;
10388     zData = Tcl_Alloc( nData );
10389     if( zData ){
10390     strcpy(zData, argv[2]);
10391     Et_NewBuiltinFile(argv[1], zData, nData);
10392     }
10393     return TCL_OK;
10394     }
10395     #endif
10396    
10397     /*
10398     ** The following section implements the InsertProc functionality. The
10399     ** new InsertProc feature of Tcl8.0.3 and later allows us to overload
10400     ** the usual system call commands for file I/O and replace them with
10401     ** commands that operate on the built-in files.
10402     */
10403     #ifdef ET_HAVE_INSERTPROC
10404    
10405     /*
10406     ** Each open channel to a built-in file is an instance of the
10407     ** following structure.
10408     */
10409     typedef struct Et_FileStruct {
10410     char *zData; /* All of the data */
10411     int nData; /* Bytes of data, not counting the null terminator */
10412     int cursor; /* How much of the data has been read so far */
10413     } Et_FileStruct;
10414    
10415     /*
10416     ** Close a previously opened built-in file.
10417     */
10418     static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){
10419     Et_FileStruct *p = (Et_FileStruct*)instanceData;
10420     Tcl_Free((char*)p);
10421     return 0;
10422     }
10423    
10424     /*
10425     ** Read from a built-in file.
10426     */
10427     static int Et_FileInput(
10428     ClientData instanceData, /* The file structure */
10429     char *buf, /* Write the data read here */
10430     int bufSize, /* Read this much data */
10431     int *pErrorCode /* Write the error code here */
10432     ){
10433     Et_FileStruct *p = (Et_FileStruct*)instanceData;
10434     *pErrorCode = 0;
10435     if( p->cursor+bufSize>p->nData ){
10436     bufSize = p->nData - p->cursor;
10437     }
10438     memcpy(buf, &p->zData[p->cursor], bufSize);
10439     p->cursor += bufSize;
10440     return bufSize;
10441     }
10442    
10443     /*
10444     ** Writes to a built-in file always return EOF.
10445     */
10446     static int Et_FileOutput(
10447     ClientData instanceData, /* The file structure */
10448     char *buf, /* Read the data from here */
10449     int toWrite, /* Write this much data */
10450     int *pErrorCode /* Write the error code here */
10451     ){
10452     *pErrorCode = 0;
10453     return 0;
10454     }
10455    
10456     /*
10457     ** Move the cursor around within the built-in file.
10458     */
10459     static int Et_FileSeek(
10460     ClientData instanceData, /* The file structure */
10461     long offset, /* Offset to seek to */
10462     int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */
10463     int *pErrorCode /* Write the error code here */
10464     ){
10465     Et_FileStruct *p = (Et_FileStruct*)instanceData;
10466     switch( mode ){
10467     case SEEK_CUR: offset += p->cursor; break;
10468     case SEEK_END: offset += p->nData; break;
10469     default: break;
10470     }
10471     if( offset<0 ) offset = 0;
10472     if( offset>p->nData ) offset = p->nData;
10473     p->cursor = offset;
10474     return offset;
10475     }
10476    
10477     /*
10478     ** The Watch method is a no-op
10479     */
10480     static void Et_FileWatch(ClientData instanceData, int mask){
10481     }
10482    
10483     /*
10484     ** The Handle method always returns an error.
10485     */
10486     static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){
10487     return TCL_ERROR;
10488     }
10489    
10490     /*
10491     ** This is the channel type that will access the built-in files.
10492     */
10493     static Tcl_ChannelType builtinChannelType = {
10494     "builtin", /* Type name. */
10495     NULL, /* Always non-blocking.*/
10496     Et_FileClose, /* Close proc. */
10497     Et_FileInput, /* Input proc. */
10498     Et_FileOutput, /* Output proc. */
10499     Et_FileSeek, /* Seek proc. */
10500     NULL, /* Set option proc. */
10501     NULL, /* Get option proc. */
10502     Et_FileWatch, /* Watch for events on console. */
10503     Et_FileHandle, /* Get a handle from the device. */
10504     };
10505    
10506     /*
10507     ** This routine attempts to do an open of a built-in file.
10508     */
10509     static Tcl_Channel Et_FileOpen(
10510     Tcl_Interp *interp, /* The TCL interpreter doing the open */
10511     char *zFilename, /* Name of the file to open */
10512     char *modeString, /* Mode string for the open (ignored) */
10513     int permissions /* Permissions for a newly created file (ignored) */
10514     ){
10515     char *zData;
10516     Et_FileStruct *p;
10517     int nData;
10518     char zName[50];
10519     Tcl_Channel chan;
10520     static int count = 1;
10521    
10522     zData = FindBuiltinFile(zFilename, 1, &nData);
10523     if( zData==0 ) return NULL;
10524     p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );
10525     if( p==0 ) return NULL;
10526     p->zData = zData;
10527     p->nData = nData;
10528     p->cursor = 0;
10529     sprintf(zName,"etbi_%x_%x",((int)Et_FileOpen)>>12,count++);
10530     chan = Tcl_CreateChannel(&builtinChannelType, zName,
10531     (ClientData)p, TCL_READABLE);
10532     return chan;
10533     }
10534    
10535     /*
10536     ** This routine does a stat() system call for a built-in file.
10537     */
10538     static int Et_FileStat(char *path, struct stat *buf){
10539     char *zData;
10540     int nData;
10541    
10542     zData = FindBuiltinFile(path, 0, &nData);
10543     if( zData==0 ){
10544     return -1;
10545     }
10546     memset(buf, 0, sizeof(*buf));
10547     buf->st_mode = 0400;
10548     buf->st_size = nData;
10549     return 0;
10550     }
10551    
10552     /*
10553     ** This routien does an access() system call for a built-in file.
10554     */
10555     static int Et_FileAccess(char *path, int mode){
10556     char *zData;
10557    
10558     if( mode & 3 ){
10559     return -1;
10560     }
10561     zData = FindBuiltinFile(path, 0, 0);
10562     if( zData==0 ){
10563     return -1;
10564     }
10565     return 0;
10566     }
10567     #endif /* ET_HAVE_INSERTPROC */
10568    
10569     /*
10570     ** An overloaded version of "source". First check for the file
10571     ** is one of the built-ins. If it isn't a built-in, then check the
10572     ** disk. But if ET_STANDALONE is set (which corresponds to the
10573     ** "Strict" option in the user interface) then never check the disk.
10574     ** This gives us a quick way to check for the common error of
10575     ** sourcing a file that exists on the development by mistake,
10576     ** and only discovering the mistake when you move the program
10577     ** to your customer's machine.
10578     */
10579     static int Et_Source(ET_TCLARGS){
10580     char *z;
10581    
10582     if( argc!=2 ){
10583     Et_ResultF(interp,"wrong # args: should be \"%s FILENAME\"", argv[0]);
10584     return TCL_ERROR;
10585     }
10586     z = FindBuiltinFile(argv[1], 1, 0);
10587     if( z ){
10588     int rc;
10589     rc = Tcl_Eval(interp,z);
10590     if (rc == TCL_ERROR) {
10591     char msg[200];
10592     sprintf(msg, "\n (file \"%.150s\" line %d)", argv[1],
10593     interp->errorLine);
10594     Tcl_AddErrorInfo(interp, msg);
10595     } else {
10596     rc = TCL_OK;
10597     }
10598     return rc;
10599     }
10600     #if ET_STANDALONE
10601     Et_ResultF(interp,"no such file: \"%s\"", argv[1]);
10602     return TCL_ERROR;
10603     #else
10604     return Tcl_EvalFile(interp,argv[1]);
10605     #endif
10606     }
10607    
10608     #ifndef ET_HAVE_INSERTPROC
10609     /*
10610     ** An overloaded version of "file exists". First check for the file
10611     ** in the file table, then go to disk.
10612     **
10613     ** We only overload "file exists" if we don't have InsertProc()
10614     ** procedures. If we do have InsertProc() procedures, they will
10615     ** handle this more efficiently.
10616     */
10617     static int Et_FileExists(ET_TCLARGS){
10618     int i, rc;
10619     Tcl_DString str;
10620     if( argc==3 && strncmp(argv[1],"exis",4)==0 ){
10621     if( FindBuiltinFile(argv[2], 0, 0)!=0 ){
10622     Tcl_SetResult(interp, "1", TCL_STATIC);
10623     return TCL_OK;
10624     }
10625     }
10626     Tcl_DStringInit(&str);
10627     Tcl_DStringAppendElement(&str,"Et_FileCmd");
10628     for(i=1; i<argc; i++){
10629     Tcl_DStringAppendElement(&str, argv[i]);
10630     }
10631     rc = Tcl_Eval(interp, Tcl_DStringValue(&str));
10632     Tcl_DStringFree(&str);
10633     return rc;
10634     }
10635     #endif
10636    
10637     /*
10638     ** This is the main Tcl interpreter. It's a global variable so it
10639     ** can be accessed easily from C code.
10640     */
10641     Tcl_Interp *Et_Interp = 0;
10642    
10643    
10644     #if ET_WIN32
10645     /*
10646     ** Implement the Et_MessageBox command on Windows platforms. We
10647     ** use the MessageBox() function from the Win32 API so that the
10648     ** error message will be displayed as a dialog box. Writing to
10649     ** standard error doesn't do anything on windows.
10650     */
10651     int Et_MessageBox(ET_TCLARGS){
10652     char *zMsg = "(Empty Message)";
10653     char *zTitle = "Message...";
10654    
10655     if( argc>1 ){
10656     zTitle = argv[1];
10657     }
10658     if( argc>2 ){
10659     zMsg = argv[2];
10660     }
10661     MessageBox(0, zMsg, zTitle, MB_ICONSTOP | MB_OK);
10662     return TCL_OK;
10663     }
10664     #endif
10665    
10666     /*
10667     ** A default implementation for "bgerror"
10668     */
10669     static char zBgerror[] =
10670     "proc Et_Bgerror err {\n"
10671     " global errorInfo tk_library\n"
10672     " if {[info exists errorInfo]} {\n"
10673     " set ei $errorInfo\n"
10674     " } else {\n"
10675     " set ei {}\n"
10676     " }\n"
10677     " if {[catch {bgerror $err}]==0} return\n"
10678     " if {[string length $ei]>0} {\n"
10679     " set err $ei\n"
10680     " }\n"
10681     " if {[catch {Et_MessageBox {Error} $err}]} {\n"
10682     " puts stderr $err\n"
10683     " }\n"
10684     " exit\n"
10685     "}\n"
10686     ;
10687    
10688     /*
10689     ** Do the initialization.
10690     **
10691     ** This routine is called after the interpreter is created, but
10692     ** before Et_PreInit() or Et_AppInit() have been run.
10693     */
10694     int Et_DoInit(Tcl_Interp *interp){
10695     extern int Et_PreInit(Tcl_Interp*);
10696     extern int Et_AppInit(Tcl_Interp*);
10697    
10698    
10699     /* Insert our alternative stat(), access() and open() procedures
10700     ** so that any attempt to work with a file will check our built-in
10701     ** scripts first.
10702     */
10703     TclStatInsertProc(Et_FileStat);
10704     TclAccessInsertProc(Et_FileAccess);
10705     TclOpenFileChannelInsertProc(Et_FileOpen);
10706    
10707     /* Initialize the hash-table for built-in scripts
10708     */
10709     FilenameHashInit();
10710    
10711    
10712     /* Overload the "file" and "source" commands
10713     */
10714     Tcl_CreateCommand(interp,"source",Et_Source,0,0);
10715    
10716    
10717     /* Define the variable Et_Interp to hold the interpreter.
10718     ** Not sure if this is ever used.
10719     */
10720     Et_Interp = interp;
10721    
10722     /* Not sure if these variables are used. Need to
10723     ** research.
10724     */
10725     Tcl_SetVar(interp,"tcl_library",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
10726     Tcl_SetVar(interp,"tcl_libPath",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
10727     Tcl_SetVar2(interp,"env","TCL_LIBRARY",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);
10728    
10729    
10730     /* Not sure if these variables are used. Need to research.
10731     */
10732     Tcl_SetVar(interp,"tk_library",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
10733     Tcl_SetVar2(interp,"env","TK_LIBRARY",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);
10734    
10735     /* Not sure of the purpose of this line. Need to research.
10736     */
10737     Tcl_Eval(interp,zBgerror);
10738    
10739    
10740     /* Not sure of the purpose of this line. Need to research.
10741     */
10742     Et_GlobalEvalF(interp,"set dir $tcl_library;source $dir/tclIndex;unset dir");
10743    
10744     /* Unsure of function of following lines. Need to research.
10745     */
10746     Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
10747     Tcl_SetVar(interp,"et_version",ET_VERSION,TCL_GLOBAL_ONLY);
10748    
10749     return TCL_OK;
10750    
10751     /* Put in a dummy goto, just to keep the compiler happy. Might want to keep
10752     ** the code below, just in case.
10753     */
10754     goto initerr;
10755    
10756     initerr:
10757     Et_EvalF(interp,"Et_Bgerror \"%q\"", Tcl_GetStringResult(interp));
10758     return TCL_ERROR;
10759     }
10760    
10761    
10762     #if ET_EXTENSION
10763     /*
10764     ** If the -extension flag is used, then generate code that will be
10765     ** turned into a loadable shared library or DLL, not a standalone
10766     ** executable.
10767     */
10768     int ET_EXTENSION_NAME(Tcl_Interp *interp){
10769     int i;
10770     #ifndef ET_HAVE_INSERTPROC
10771     Tcl_AppendResult(interp,
10772     "mktclapp can only generate extensions for Tcl/Tk version "
10773     "8.0.3 and later. This is version "
10774     TCL_MAJOR_VERSION "." TCL_MINOR_VERSION "." TCL_RELEASE_SERIAL, 0);
10775     return TCL_ERROR;
10776     #endif
10777     #ifdef ET_HAVE_INSERTPROC
10778     #ifdef USE_TCL_STUBS
10779     if( Tcl_InitStubs(interp,"8.0",0)==0 ){
10780     return TCL_ERROR;
10781     }
10782     if( Tk_InitStubs(interp,"8.0",0)==0 ){
10783     return TCL_ERROR;
10784     }
10785     #endif
10786     Et_Interp = interp;
10787     TclStatInsertProc(Et_FileStat);
10788     TclAccessInsertProc(Et_FileAccess);
10789     TclOpenFileChannelInsertProc(Et_FileOpen);
10790     FilenameHashInit();
10791     for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){
10792     Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);
10793     }
10794     #if ET_ENABLE_OBJ
10795     for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){
10796     Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);
10797     }
10798     #endif
10799     Tcl_LinkVar(interp,"Et_EvalTrace",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);
10800     Tcl_SetVar(interp,"et_version",ET_VERSION,TCL_GLOBAL_ONLY);
10801     #if ET_HAVE_APPINIT
10802     if( Et_AppInit(interp) == TCL_ERROR ){
10803     return TCL_ERROR;
10804     }
10805     #endif
10806     #ifdef ET_MAIN_SCRIPT
10807     if( Et_EvalF(interp,"source \"%q\"", ET_MAIN_SCRIPT)!=TCL_OK ){
10808     return TCL_ERROR;
10809     }
10810     #endif
10811     return TCL_OK;
10812     #endif /* ET_HAVE_INSERTPROC */
10813     }
10814     int ET_SAFE_EXTENSION_NAME(Tcl_Interp *interp){
10815     return ET_EXTENSION_NAME(interp);
10816     }
10817     #endif
10818    
10819    
10820     /*
10821     * $Log: appinit.c,v $
10822     * Revision 1.6 2002/04/23 06:26:42 dtashley
10823     * Minor changes in release year, name (to ESRG).
10824     *
10825     * Revision 1.5 2001/08/18 18:33:13 dtashley
10826     * Preparing for release of v1.05.
10827     *
10828     * Revision 1.4 2001/06/20 20:42:28 dtashley
10829     * Final changes before release of v1.04.
10830     *
10831     * Revision 1.3 2001/06/20 03:32:56 dtashley
10832     * Modifications for version 1.04.
10833     *
10834     * Revision 1.2 2001/06/20 02:56:04 dtashley
10835     * Conversion from binary mode to work under CVS.
10836     *
10837     * $History: appinit.c $
10838     *
10839     * ***************** Version 2 *****************
10840     * User: Dtashley Date: 1/03/01 Time: 2:03a
10841     * Updated in $/IjuScripter, IjuConsole/Source/Tk Base
10842     * Check-in in preparation for release of v1.03. Extraneous and redundant
10843     * calls removed.
10844     *
10845     * ***************** Version 1 *****************
10846     * User: Dtashley Date: 1/02/01 Time: 2:18a
10847     * Created in $/IjuScripter, IjuConsole/Source/Tk Base
10848     * Initial check-in.
10849     */
10850    
10851     /* End of APPINIT.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25