1 /*
2 * p64_tcl.c --
3 *
4 * FIXME: This file needs a description here.
5 *
6 * Copyright (c) 1996-2002 The Regents of the University of California.
7 * All rights reserved.
8 *
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions are met:
11 *
12 * A. Redistributions of source code must retain the above copyright notice,
13 * this list of conditions and the following disclaimer.
14 * B. Redistributions in binary form must reproduce the above copyright notice,
15 * this list of conditions and the following disclaimer in the documentation
16 * and/or other materials provided with the distribution.
17 * C. Neither the names of the copyright holders nor the names of its
18 * contributors may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
22 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
23 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
24 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
25 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 * POSSIBILITY OF SUCH DAMAGE.
32 */
33
34 const char tk_init_tcl_code[] = "\
35 proc tk_butEnter w {\n\
36 global tk_priv tk_strictMotif\n\
37 if {[lindex [$w config -state] 4] != \"disabled\"} {\n\
38 if {!$tk_strictMotif} {\n\
39 $w config -state active\n\
40 }\n\
41 set tk_priv(window) $w\n\
42 }\n\
43 }\n\
44 proc tk_butLeave w {\n\
45 global tk_priv tk_strictMotif\n\
46 if {[lindex [$w config -state] 4] != \"disabled\"} {\n\
47 if {!$tk_strictMotif} {\n\
48 $w config -state normal\n\
49 }\n\
50 }\n\
51 set tk_priv(window) \"\"\n\
52 }\n\
53 proc tk_butDown w {\n\
54 global tk_priv\n\
55 set tk_priv(relief) [lindex [$w config -relief] 4]\n\
56 set tk_priv(buttonWindow) $w\n\
57 if {[lindex [$w config -state] 4] != \"disabled\"} {\n\
58 $w config -relief sunken\n\
59 }\n\
60 }\n\
61 proc tk_butUp w {\n\
62 global tk_priv\n\
63 if {$w == $tk_priv(buttonWindow)} {\n\
64 $w config -relief $tk_priv(relief)\n\
65 if {($w == $tk_priv(window))\n\
66 && ([lindex [$w config -state] 4] != \"disabled\")} {\n\
67 uplevel #0 [list $w invoke]\n\
68 }\n\
69 set tk_priv(buttonWindow) \"\"\n\
70 }\n\
71 }\n\
72 proc tk_entryBackspace w {\n\
73 set x [expr {[$w index insert] - 1}]\n\
74 if {$x != -1} {$w delete $x}\n\
75 }\n\
76 proc tk_entryBackword w {\n\
77 set string [$w get]\n\
78 set curs [expr [$w index insert]-1]\n\
79 if {$curs < 0} return\n\
80 for {set x $curs} {$x > 0} {incr x -1} {\n\
81 if {([string first [string index $string $x] \" \\t\"] < 0)\n\
82 && ([string first [string index $string [expr $x-1]] \" \\t\"]\n\
83 >= 0)} {\n\
84 break\n\
85 }\n\
86 }\n\
87 $w delete $x $curs\n\
88 }\n\
89 proc tk_entrySeeCaret w {\n\
90 set c [$w index insert]\n\
91 set left [$w index @0]\n\
92 if {$left >= $c} {\n\
93 if {$c > 0} {\n\
94 $w view [expr $c-1]\n\
95 } else {\n\
96 $w view $c\n\
97 }\n\
98 return\n\
99 }\n\
100 while {([$w index @[expr [winfo width $w]-5]] < $c)\n\
101 && ($left < $c)} {\n\
102 set left [expr $left+1]\n\
103 $w view $left\n\
104 }\n\
105 }\n\
106 proc tk_listboxSingleSelect args {\n\
107 foreach w $args {\n\
108 bind $w <B1-Motion> {%W select from [%W nearest %y]} \n\
109 bind $w <Shift-1> {%W select from [%W nearest %y]}\n\
110 bind $w <Shift-B1-Motion> {%W select from [%W nearest %y]}\n\
111 }\n\
112 }\n\
113 proc tk_menuBar {w args} {\n\
114 global tk_priv\n\
115 if {$args == \"\"} {\n\
116 if [catch {set menus $tk_priv(menusFor$w)}] {\n\
117 return \"\"\n\
118 }\n\
119 return $menus\n\
120 }\n\
121 if [info exists tk_priv(menusFor$w)] {\n\
122 unset tk_priv(menusFor$w)\n\
123 unset tk_priv(menuBarFor[winfo toplevel $w])\n\
124 }\n\
125 if {$args == \"{}\"} {\n\
126 return\n\
127 }\n\
128 set tk_priv(menusFor$w) $args\n\
129 set tk_priv(menuBarFor[winfo toplevel $w]) $w\n\
130 bind $w <Any-Alt-KeyPress> {tk_traverseToMenu %W %A}\n\
131 bind $w <F10> {tk_firstMenu %W}\n\
132 bind $w <Any-ButtonRelease-1> tk_mbUnpost\n\
133 }\n\
134 proc tk_menus {w args} {\n\
135 error \"tk_menus is obsolete in Tk versions 3.0 and later; please change your scripts to use tk_menuBar instead\"\n\
136 }\n\
137 proc tk_bindForTraversal args {\n\
138 foreach w $args {\n\
139 bind $w <Any-Alt-KeyPress> {tk_traverseToMenu %W %A}\n\
140 bind $w <F10> {tk_firstMenu %W}\n\
141 }\n\
142 }\n\
143 proc tk_mbPost {w} {\n\
144 global tk_priv tk_strictMotif\n\
145 if {[lindex [$w config -state] 4] == \"disabled\"} {\n\
146 return\n\
147 }\n\
148 if {$w == $tk_priv(posted)} {\n\
149 grab -global $tk_priv(grab)\n\
150 return\n\
151 }\n\
152 set menu [lindex [$w config -menu] 4]\n\
153 if {$menu == \"\"} {\n\
154 return\n\
155 }\n\
156 if ![string match $w* $menu] {\n\
157 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\
158 }\n\
159 set cur $tk_priv(posted)\n\
160 if {$cur != \"\"} tk_mbUnpost\n\
161 set tk_priv(relief) [lindex [$w config -relief] 4]\n\
162 $w config -relief raised\n\
163 set tk_priv(posted) $w\n\
164 if {$tk_priv(focus) == \"\"} {\n\
165 set tk_priv(focus) [focus]\n\
166 }\n\
167 set tk_priv(activeBg) [lindex [$menu config -activebackground] 4]\n\
168 set tk_priv(activeFg) [lindex [$menu config -activeforeground] 4]\n\
169 if $tk_strictMotif {\n\
170 $menu config -activebackground [lindex [$menu config -background] 4]\n\
171 $menu config -activeforeground [lindex [$menu config -foreground] 4]\n\
172 }\n\
173 $menu activate none\n\
174 focus $menu\n\
175 $menu post [winfo rootx $w] [expr [winfo rooty $w]+[winfo height $w]]\n\
176 if [catch {set grab $tk_priv(menuBarFor[winfo toplevel $w])}] {\n\
177 set grab $w\n\
178 } else {\n\
179 if [lsearch $tk_priv(menusFor$grab) $w]<0 {\n\
180 set grab $w\n\
181 }\n\
182 }\n\
183 set tk_priv(cursor) [lindex [$grab config -cursor] 4]\n\
184 $grab config -cursor arrow\n\
185 set tk_priv(grab) $grab\n\
186 grab -global $grab\n\
187 }\n\
188 proc tk_mbUnpost {} {\n\
189 global tk_priv\n\
190 set w $tk_priv(posted)\n\
191 if {$w != \"\"} {\n\
192 catch {\n\
193 set menu [lindex [$w config -menu] 4]\n\
194 $menu unpost\n\
195 $menu config -activebackground $tk_priv(activeBg)\n\
196 $menu config -activeforeground $tk_priv(activeFg)\n\
197 $w config -relief $tk_priv(relief)\n\
198 }\n\
199 catch {$tk_priv(grab) config -cursor $tk_priv(cursor)}\n\
200 catch {focus $tk_priv(focus)}\n\
201 grab release $tk_priv(grab)\n\
202 set tk_priv(grab) \"\"\n\
203 set tk_priv(focus) \"\"\n\
204 set tk_priv(posted) {}\n\
205 }\n\
206 }\n\
207 proc tk_traverseToMenu {w char} {\n\
208 global tk_priv\n\
209 if {$char == \"\"} {\n\
210 return\n\
211 }\n\
212 set char [string tolower $char]\n\
213 foreach mb [tk_getMenuButtons $w] {\n\
214 if {[winfo class $mb] == \"Menubutton\"} {\n\
215 set char2 [string index [lindex [$mb config -text] 4] \\\n\
216 [lindex [$mb config -underline] 4]]\n\
217 if {[string compare $char [string tolower $char2]] == 0} {\n\
218 tk_mbPost $mb\n\
219 [lindex [$mb config -menu] 4] activate 0\n\
220 return\n\
221 }\n\
222 }\n\
223 }\n\
224 }\n\
225 proc tk_traverseWithinMenu {w char} {\n\
226 if {$char == \"\"} {\n\
227 return\n\
228 }\n\
229 set char [string tolower $char]\n\
230 set last [$w index last]\n\
231 if {$last == \"none\"} {\n\
232 return\n\
233 }\n\
234 for {set i 0} {$i <= $last} {incr i} {\n\
235 if [catch {set char2 [string index \\\n\
236 [lindex [$w entryconfig $i -label] 4] \\\n\
237 [lindex [$w entryconfig $i -underline] 4]]}] {\n\
238 continue\n\
239 }\n\
240 if {[string compare $char [string tolower $char2]] == 0} {\n\
241 tk_mbUnpost\n\
242 $w invoke $i\n\
243 return\n\
244 }\n\
245 }\n\
246 }\n\
247 proc tk_getMenuButtons w {\n\
248 global tk_priv\n\
249 set top [winfo toplevel $w]\n\
250 if [catch {set bar [set tk_priv(menuBarFor$top)]}] {\n\
251 return \"\"\n\
252 }\n\
253 return $tk_priv(menusFor$bar)\n\
254 }\n\
255 proc tk_nextMenu count {\n\
256 global tk_priv\n\
257 if {$tk_priv(posted) == \"\"} {\n\
258 return\n\
259 }\n\
260 set buttons [tk_getMenuButtons $tk_priv(posted)]\n\
261 set length [llength $buttons]\n\
262 for {set i 0} 1 {incr i} {\n\
263 if {$i >= $length} {\n\
264 return\n\
265 }\n\
266 if {[lindex $buttons $i] == $tk_priv(posted)} {\n\
267 break\n\
268 }\n\
269 }\n\
270 incr i $count\n\
271 while 1 {\n\
272 while {$i < 0} {\n\
273 incr i $length\n\
274 }\n\
275 while {$i >= $length} {\n\
276 incr i -$length\n\
277 }\n\
278 set mb [lindex $buttons $i]\n\
279 if {[lindex [$mb configure -state] 4] != \"disabled\"} {\n\
280 break\n\
281 }\n\
282 incr i $count\n\
283 }\n\
284 tk_mbUnpost\n\
285 tk_mbPost $mb\n\
286 [lindex [$mb config -menu] 4] activate 0\n\
287 }\n\
288 proc tk_nextMenuEntry count {\n\
289 global tk_priv\n\
290 if {$tk_priv(posted) == \"\"} {\n\
291 return\n\
292 }\n\
293 set menu [lindex [$tk_priv(posted) config -menu] 4]\n\
294 if {[$menu index last] == \"none\"} {\n\
295 return\n\
296 }\n\
297 set length [expr [$menu index last]+1]\n\
298 set i [$menu index active]\n\
299 if {$i == \"none\"} {\n\
300 set i 0\n\
301 } else {\n\
302 incr i $count\n\
303 }\n\
304 while 1 {\n\
305 while {$i < 0} {\n\
306 incr i $length\n\
307 }\n\
308 while {$i >= $length} {\n\
309 incr i -$length\n\
310 }\n\
311 if {[catch {$menu entryconfigure $i -state} state] == 0} {\n\
312 if {[lindex $state 4] != \"disabled\"} {\n\
313 break\n\
314 }\n\
315 }\n\
316 incr i $count\n\
317 }\n\
318 $menu activate $i\n\
319 }\n\
320 proc tk_invokeMenu {menu} {\n\
321 set i [$menu index active]\n\
322 if {$i != \"none\"} {\n\
323 tk_mbUnpost\n\
324 update idletasks\n\
325 $menu invoke $i\n\
326 }\n\
327 }\n\
328 proc tk_firstMenu w {\n\
329 set mb [lindex [tk_getMenuButtons $w] 0]\n\
330 if {$mb != \"\"} {\n\
331 tk_mbPost $mb\n\
332 [lindex [$mb config -menu] 4] activate 0\n\
333 }\n\
334 }\n\
335 proc tk_mbButtonDown w {\n\
336 global tk_priv\n\
337 if {[lindex [$w config -state] 4] == \"disabled\"} {\n\
338 return\n\
339 }\n\
340 if {$tk_priv(inMenuButton) == $w} {\n\
341 tk_mbPost $w\n\
342 }\n\
343 }\n\
344 proc tk_textSelectTo {w index} {\n\
345 global tk_priv\n\
346 case $tk_priv(selectMode) {\n\
347 char {\n\
348 if [$w compare $index < anchor] {\n\
349 set first $index\n\
350 set last anchor\n\
351 } else {\n\
352 set first anchor\n\
353 set last [$w index $index+1c]\n\
354 }\n\
355 }\n\
356 word {\n\
357 if [$w compare $index < anchor] {\n\
358 set first [$w index \"$index wordstart\"]\n\
359 set last [$w index \"anchor wordend\"]\n\
360 } else {\n\
361 set first [$w index \"anchor wordstart\"]\n\
362 set last [$w index \"$index wordend\"]\n\
363 }\n\
364 }\n\
365 line {\n\
366 if [$w compare $index < anchor] {\n\
367 set first [$w index \"$index linestart\"]\n\
368 set last [$w index \"anchor lineend + 1c\"]\n\
369 } else {\n\
370 set first [$w index \"anchor linestart\"]\n\
371 set last [$w index \"$index lineend + 1c\"]\n\
372 }\n\
373 }\n\
374 }\n\
375 $w tag remove sel 0.0 $first\n\
376 $w tag add sel $first $last\n\
377 $w tag remove sel $last end\n\
378 }\n\
379 proc tk_textBackspace w {\n\
380 $w delete insert-1c insert\n\
381 }\n\
382 proc tk_textIndexCloser {w a b c} {\n\
383 set a [$w index $a]\n\
384 set b [$w index $b]\n\
385 set c [$w index $c]\n\
386 if [$w compare $a <= $b] {\n\
387 return 1\n\
388 }\n\
389 if [$w compare $a >= $c] {\n\
390 return 0\n\
391 }\n\
392 scan $a \"%d.%d\" lineA chA\n\
393 scan $b \"%d.%d\" lineB chB\n\
394 scan $c \"%d.%d\" lineC chC\n\
395 if {$chC == 0} {\n\
396 incr lineC -1\n\
397 set chC [string length [$w get $lineC.0 $lineC.end]]\n\
398 }\n\
399 if {$lineB != $lineC} {\n\
400 return [expr {($lineA-$lineB) < ($lineC-$lineA)}]\n\
401 }\n\
402 return [expr {($chA-$chB) < ($chC-$chA)}]\n\
403 }\n\
404 proc tk_textResetAnchor {w index} {\n\
405 global tk_priv\n\
406 if {[$w tag ranges sel] == \"\"} {\n\
407 set tk_priv(selectMode) char\n\
408 $w mark set anchor $index\n\
409 return\n\
410 }\n\
411 if [tk_textIndexCloser $w $index sel.first sel.last] {\n\
412 if {$tk_priv(selectMode) == \"char\"} {\n\
413 $w mark set anchor sel.last\n\
414 } else {\n\
415 $w mark set anchor sel.last-1c\n\
416 }\n\
417 } else {\n\
418 $w mark set anchor sel.first\n\
419 }\n\
420 }\n\
421 scan [info tclversion] \"%d.%d\" a b\n\
422 if {$a != 7} {\n\
423 error \"wrong version of Tcl loaded ([info tclversion]): need 7.x\"\n\
424 }\n\
425 scan $tk_version \"%d.%d\" a b\n\
426 if {($a != 3) || ($b < 3)} {\n\
427 error \"wrong version of Tk loaded ($tk_version): need 3.3 or later\"\n\
428 }\n\
429 unset a b\n\
430 lappend auto_path $tk_library\n\
431 set tk_strictMotif 0\n\
432 bind Button <Any-Enter> {tk_butEnter %W}\n\
433 bind Button <Any-Leave> {tk_butLeave %W}\n\
434 bind Button <1> {tk_butDown %W}\n\
435 bind Button <ButtonRelease-1> {tk_butUp %W}\n\
436 bind Checkbutton <Any-Enter> {tk_butEnter %W}\n\
437 bind Checkbutton <Any-Leave> {tk_butLeave %W}\n\
438 bind Checkbutton <1> {tk_butDown %W}\n\
439 bind Checkbutton <ButtonRelease-1> {tk_butUp %W}\n\
440 bind Radiobutton <Any-Enter> {tk_butEnter %W}\n\
441 bind Radiobutton <Any-Leave> {tk_butLeave %W}\n\
442 bind Radiobutton <1> {tk_butDown %W}\n\
443 bind Radiobutton <ButtonRelease-1> {tk_butUp %W}\n\
444 bind Entry <1> {\n\
445 %W icursor @%x\n\
446 %W select from @%x\n\
447 if {[lindex [%W config -state] 4] == \"normal\"} {focus %W}\n\
448 }\n\
449 bind Entry <B1-Motion> {%W select to @%x}\n\
450 bind Entry <Shift-1> {%W select adjust @%x}\n\
451 bind Entry <Shift-B1-Motion> {%W select to @%x}\n\
452 bind Entry <2> {%W scan mark %x}\n\
453 bind Entry <B2-Motion> {%W scan dragto %x}\n\
454 bind Entry <Any-KeyPress> {\n\
455 if {\"%A\" != \"\"} {\n\
456 %W insert insert %A\n\
457 tk_entrySeeCaret %W\n\
458 }\n\
459 }\n\
460 bind Entry <Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}\n\
461 bind Entry <BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}\n\
462 bind Entry <Control-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}\n\
463 bind Entry <Control-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}\n\
464 bind Entry <Control-u> {%W delete 0 end}\n\
465 bind Entry <Control-v> {%W insert insert [selection get]; tk_entrySeeCaret %W}\n\
466 bind Entry <Control-w> {tk_entryBackword %W; tk_entrySeeCaret %W}\n\
467 tk_bindForTraversal Entry\n\
468 bind Listbox <1> {%W select from [%W nearest %y]}\n\
469 bind Listbox <B1-Motion> {%W select to [%W nearest %y]}\n\
470 bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}\n\
471 bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}\n\
472 bind Listbox <2> {%W scan mark %x %y}\n\
473 bind Listbox <B2-Motion> {%W scan dragto %x %y}\n\
474 bind Scrollbar <Any-Enter> {\n\
475 if $tk_strictMotif {\n\
476 set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]\n\
477 %W config -activeforeground [lindex [%W config -foreground] 4]\n\
478 }\n\
479 }\n\
480 bind Scrollbar <Any-Leave> {\n\
481 if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {\n\
482 %W config -activeforeground $tk_priv(activeFg)\n\
483 }\n\
484 }\n\
485 bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}\n\
486 bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}\n\
487 bind Scale <Any-Enter> {\n\
488 if $tk_strictMotif {\n\
489 set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]\n\
490 %W config -activeforeground [lindex [%W config -sliderforeground] 4]\n\
491 }\n\
492 }\n\
493 bind Scale <Any-Leave> {\n\
494 if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {\n\
495 %W config -activeforeground $tk_priv(activeFg)\n\
496 }\n\
497 }\n\
498 bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}\n\
499 bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}\n\
500 bind Menubutton <Any-Enter> {\n\
501 set tk_priv(inMenuButton) %W\n\
502 if {[lindex [%W config -state] 4] != \"disabled\"} {\n\
503 if {!$tk_strictMotif} {\n\
504 %W config -state active\n\
505 }\n\
506 }\n\
507 }\n\
508 bind Menubutton <Any-Leave> {\n\
509 set tk_priv(inMenuButton) {}\n\
510 if {[lindex [%W config -state] 4] == \"active\"} {\n\
511 %W config -state normal\n\
512 }\n\
513 }\n\
514 bind Menubutton <1> {tk_mbButtonDown %W}\n\
515 bind Menubutton <Any-ButtonRelease-1> {\n\
516 if {($tk_priv(posted) == \"%W\") && ($tk_priv(inMenuButton) == \"%W\")} {\n\
517 [lindex [$tk_priv(posted) config -menu] 4] activate 0\n\
518 } else {\n\
519 tk_mbUnpost\n\
520 }\n\
521 }\n\
522 bind Menubutton <B1-Enter> {\n\
523 set tk_priv(inMenuButton) %W\n\
524 if {([lindex [%W config -state] 4] != \"disabled\")\n\
525 && ($tk_priv(posted) != \"\")} {\n\
526 if {!$tk_strictMotif} {\n\
527 %W config -state active\n\
528 }\n\
529 tk_mbPost %W\n\
530 }\n\
531 }\n\
532 bind Menubutton <2> {\n\
533 if {($tk_priv(posted) == \"\")\n\
534 && ([lindex [%W config -state] 4] != \"disabled\")} {\n\
535 set tk_priv(dragging) %W\n\
536 [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y\n\
537 }\n\
538 }\n\
539 bind Menubutton <B2-Motion> {\n\
540 if {$tk_priv(dragging) != \"\"} {\n\
541 [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y\n\
542 }\n\
543 }\n\
544 bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) \"\"}\n\
545 bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}\n\
546 bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}\n\
547 bind Menu <Any-Motion> {\n\
548 if {$tk_priv(window) == \"%W\"} {\n\
549 %W activate @%y\n\
550 }\n\
551 }\n\
552 bind Menu <1> {\n\
553 if {$tk_priv(grab) != \"\"} {\n\
554 grab $tk_priv(grab)\n\
555 }\n\
556 }\n\
557 bind Menu <ButtonRelease-1> {tk_invokeMenu %W}\n\
558 bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}\n\
559 bind Menu <B2-Motion> {\n\
560 if {$tk_priv(posted) == \"\"} {\n\
561 %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]\n\
562 }\n\
563 }\n\
564 bind Menu <B2-Leave> { }\n\
565 bind Menu <B2-Enter> { }\n\
566 bind Menu <Escape> {tk_mbUnpost}\n\
567 bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}\n\
568 bind Menu <Left> {tk_nextMenu -1}\n\
569 bind Menu <Right> {tk_nextMenu 1}\n\
570 bind Menu <Up> {tk_nextMenuEntry -1}\n\
571 bind Menu <Down> {tk_nextMenuEntry 1}\n\
572 bind Menu <Return> {tk_invokeMenu %W}\n\
573 bind Text <1> {\n\
574 set tk_priv(selectMode) char\n\
575 %W mark set insert @%x,%y\n\
576 %W mark set anchor insert\n\
577 if {[lindex [%W config -state] 4] == \"normal\"} {focus %W}\n\
578 }\n\
579 bind Text <Double-1> {\n\
580 set tk_priv(selectMode) word\n\
581 %W mark set insert \"@%x,%y wordstart\"\n\
582 tk_textSelectTo %W insert\n\
583 }\n\
584 bind Text <Triple-1> {\n\
585 set tk_priv(selectMode) line\n\
586 %W mark set insert \"@%x,%y linestart\"\n\
587 tk_textSelectTo %W insert\n\
588 }\n\
589 bind Text <B1-Motion> {tk_textSelectTo %W @%x,%y}\n\
590 bind Text <Shift-1> {\n\
591 tk_textResetAnchor %W @%x,%y\n\
592 tk_textSelectTo %W @%x,%y\n\
593 }\n\
594 bind Text <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}\n\
595 bind Text <2> {%W scan mark %y}\n\
596 bind Text <B2-Motion> {%W scan dragto %y}\n\
597 bind Text <Any-KeyPress> {\n\
598 if {\"%A\" != \"\"} {\n\
599 %W insert insert %A\n\
600 %W yview -pickplace insert\n\
601 }\n\
602 }\n\
603 bind Text <Return> {%W insert insert \\n; %W yview -pickplace insert}\n\
604 bind Text <BackSpace> {tk_textBackspace %W; %W yview -pickplace insert}\n\
605 bind Text <Delete> {tk_textBackspace %W; %W yview -pickplace insert}\n\
606 bind Text <Control-h> {tk_textBackspace %W; %W yview -pickplace insert}\n\
607 bind Text <Control-d> {%W delete sel.first sel.last}\n\
608 bind Text <Control-v> {\n\
609 %W insert insert [selection get]\n\
610 %W yview -pickplace insert\n\
611 }\n\
612 tk_bindForTraversal Text\n\
613 set tk_priv(buttons) 0\n\
614 set tk_priv(buttonWindow) {}\n\
615 set tk_priv(dragging) {}\n\
616 set tk_priv(focus) {}\n\
617 set tk_priv(grab) {}\n\
618 set tk_priv(inMenuButton) {}\n\
619 set tk_priv(posted) {}\n\
620 set tk_priv(selectMode) char\n\
621 set tk_priv(window) {}\n\
622 proc tkerror err {\n\
623 global errorInfo\n\
624 set info $errorInfo\n\
625 if {[tk_dialog .tkerrorDialog \"Error in Tcl Script\" \\\n\
626 \"Error: $err\" error 0 OK \"See Stack Trace\"] == 0} {\n\
627 return\n\
628 }\n\
629 set w .tkerrorTrace\n\
630 catch {destroy $w}\n\
631 toplevel $w -class ErrorTrace\n\
632 wm minsize $w 1 1\n\
633 wm title $w \"Stack Trace for Error\"\n\
634 wm iconname $w \"Stack Trace\"\n\
635 button $w.ok -text OK -command \"destroy $w\"\n\
636 text $w.text -relief raised -bd 2 -yscrollcommand \"$w.scroll set\" \\\n\
637 -setgrid true -width 40 -height 10\n\
638 scrollbar $w.scroll -relief flat -command \"$w.text yview\"\n\
639 pack $w.ok -side bottom -padx 3m -pady 3m -ipadx 2m -ipady 1m\n\
640 pack $w.scroll -side right -fill y\n\
641 pack $w.text -side left -expand yes -fill both\n\
642 $w.text insert 0.0 $info\n\
643 $w.text mark set insert 0.0\n\
644 wm withdraw $w\n\
645 update idletasks\n\
646 set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \\\n\
647 - [winfo vrootx [winfo parent $w]]]\n\
648 set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \\\n\
649 - [winfo vrooty [winfo parent $w]]]\n\
650 wm geom $w +$x+$y\n\
651 wm deiconify $w\n\
652 }\n\
653 ";
654 const char p64_tcl_code[] = "\
655 proc build { width height } {\n\
656 video .video $width $height\n\
657 pack append . .video { top }\n\
658 return .video\n\
659 }\n\
660 ";
661
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.