home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / bind.test < prev    next >
Encoding:
Text File  |  1995-04-21  |  34.2 KB  |  1,265 lines
  1. # This file is a Tcl script to test out Tk's "bind" and "bindtags"
  2. # commands plus the procedures in tkBind.c.  It is organized in the
  3. # standard fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994 Sun Microsystems, Inc.
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11. # @(#) bind.test 1.17 95/04/21 14:08:02
  12.  
  13. if {[info commands testevent] == {}} {
  14.     puts "This application hasn't been compiled with the \"testevent\""
  15.     puts "command, so I can't run this test.  Are you sure you're using"
  16.     puts "tktest instead of wish?"
  17.     return
  18. }
  19.  
  20. if {[string compare test [info procs test]] != 0} {
  21.     source defs
  22. }
  23.  
  24. catch {destroy .b}
  25. toplevel .b -width 100 -height 50
  26. wm geom .b +0+0
  27. update idletasks
  28.  
  29. proc setup {} {
  30.     catch {destroy .b.f}
  31.     frame .b.f -class Test -width 150 -height 100
  32.     pack .b.f
  33.     focus -force .b.f
  34.     update
  35. }
  36. foreach i [bind Test] {
  37.     bind Test $i {}
  38. }
  39. foreach i [bind all] {
  40.     bind all $i {}
  41. }
  42.  
  43. test bind-1.1 {bind command} {
  44.     list [catch {bind} msg] $msg
  45. } {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
  46. test bind-1.2 {bind command} {
  47.     list [catch {bind a b c d} msg] $msg
  48. } {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
  49. test bind-1.3 {bind command} {
  50.     list [catch {bind .gorp} msg] $msg
  51. } {1 {bad window path name ".gorp"}}
  52. test bind-1.4 {bind command} {
  53.     list [catch {bind foo} msg] $msg
  54. } {0 {}}
  55. test bind-1.5 {bind command} {
  56.     list [catch {bind .b <gorp-> {}} msg] $msg
  57. } {0 {}}
  58. test bind-1.6 {bind command} {
  59.     catch {destroy .b.f}
  60.     frame .b.f
  61.     bind .b.f <Enter> {test script}
  62.     set result [bind .b.f <Enter>]
  63.     bind .b.f <Enter> {}
  64.     list $result [bind .b.f <Enter>]
  65. } {{test script} {}}
  66. test bind-1.7 {bind command} {
  67.     catch {destroy .b.f}
  68.     frame .b.f
  69.     bind .b.f <Enter> {test script}
  70.     bind .b.f <Enter> {+more text}
  71.     bind .b.f <Enter>
  72. } {test script
  73. more text}
  74. test bind-1.8 {bind command} {
  75.     list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b]
  76. } {1 {bad event type or keysym "gorp"} {}}
  77. test bind-1.9 {bind command} {
  78.     list [catch {bind .b <gorp->} msg] $msg
  79. } {0 {}}
  80. test bind-1.10 {bind command} {
  81.     catch {destroy .b.f}
  82.     frame .b.f
  83.     bind .b.f <Enter> {script 1}
  84.     bind .b.f <Leave> {script 2}
  85.     bind .b.f a {script for a}
  86.     bind .b.f b {script for b}
  87.     lsort [bind .b.f]
  88. } {<Enter> <Leave> a b}
  89.  
  90. test bind-2.1 {bindtags command} {
  91.     list [catch {bindtags} msg] $msg
  92. } {1 {wrong # args: should be "bindtags window ?tags?"}}
  93. test bind-2.2 {bindtags command} {
  94.     list [catch {bindtags a b c} msg] $msg
  95. } {1 {wrong # args: should be "bindtags window ?tags?"}}
  96. test bind-2.3 {bindtags command} {
  97.     list [catch {bindtags .foo} msg] $msg
  98. } {1 {bad window path name ".foo"}}
  99. test bind-2.4 {bindtags command} {
  100.     bindtags .b
  101. } {.b Toplevel all}
  102. test bind-2.5 {bindtags command} {
  103.     catch {destroy .b.f}
  104.     frame .b.f
  105.     bindtags .b.f
  106. } {.b.f Frame .b all}
  107. test bind-2.6 {bindtags command} {
  108.     catch {destroy .b.f}
  109.     frame .b.f
  110.     bindtags .b.f {{x y z} b c d}
  111.     bindtags .b.f
  112. } {{x y z} b c d}
  113. test bind-2.7 {bindtags command} {
  114.     catch {destroy .b.f}
  115.     frame .b.f
  116.     bindtags .b.f {x y z}
  117.     bindtags .b.f {}
  118.     bindtags .b.f
  119. } {.b.f Frame .b all}
  120. test bind-2.8 {bindtags command} {
  121.     catch {destroy .b.f}
  122.     frame .b.f
  123.     bindtags .b.f {x y z}
  124.     bindtags .b.f {a b c d}
  125.     bindtags .b.f
  126. } {a b c d}
  127. test bind-2.9 {bindtags command} {
  128.     catch {destroy .b.f}
  129.     frame .b.f
  130.     bindtags .b.f {a b c}
  131.     list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f]
  132. } {1 {unmatched open brace in list} {.b.f Frame .b all}}
  133. test bind-2.10 {bindtags command} {
  134.     catch {destroy .b.f}
  135.     frame .b.f
  136.     bindtags .b.f {a b c}
  137.     list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f]
  138. } {0 {} {a .gorp b}}
  139.  
  140. test bind-3.1 {TkFreeBindingTags procedure} {
  141.     catch {destroy .b.f}
  142.     frame .b.f
  143.     bindtags .b.f "a b c d"
  144.     destroy .b.f
  145. } {}
  146. test bind-3.2 {TkFreeBindingTags procedure} {
  147.     catch {destroy .b.f}
  148.     frame .b.f
  149.     catch {bindtags .b.f "a .gorp b .b.f"}
  150.     destroy .b.f
  151. } {}
  152.  
  153. bind all <Enter> {lappend x "%W enter all"}
  154. bind Test <Enter> {lappend x "%W enter frame"}
  155. bind Toplevel <Enter> {lappend x "%W enter toplevel"}
  156. bind xyz <Enter> {lappend x "%W enter xyz"}
  157. bind {a b} <Enter> {lappend x "%W enter {a b}"}
  158. bind .b <Enter>  {lappend x "%W enter .b"}
  159. test bind-4.1 {TkBindEventProc procedure} {
  160.     catch {destroy .b.f}
  161.     frame .b.f -class Test -width 150 -height 100
  162.     pack .b.f
  163.     update
  164.     bind .b.f <Enter> {lappend x "%W enter .b.f"}
  165.     set x {}
  166.     testevent .b.f Enter
  167.     set x
  168. } {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}}
  169. test bind-4.2 {TkBindEventProc procedure} {
  170.     catch {destroy .b.f}
  171.     frame .b.f -class Test -width 150 -height 100
  172.     pack .b.f
  173.     update
  174.     bind .b.f <Enter> {lappend x "%W enter .b.f"}
  175.     bindtags .b.f {.b.f {a b} xyz}
  176.     set x {}
  177.     testevent .b.f Enter
  178.     set x
  179. } {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}}
  180. test bind-4.3 {TkBindEventProc procedure} {
  181.     set x {}
  182.     testevent .b Enter
  183.     set x
  184. } {{.b enter .b} {.b enter toplevel} {.b enter all}}
  185. test bind-4.4 {TkBindEventProc procedure} {
  186.     catch {destroy .b.f}
  187.     frame .b.f -class Test -width 150 -height 100
  188.     pack .b.f
  189.     update
  190.     bindtags .b.f {.b.f .b.f2 .b.f3}
  191.     frame .b.f3 -width 50 -height 50
  192.     pack .b.f3
  193.     bind .b.f <Enter> {lappend x "%W enter .b.f"}
  194.     bind .b.f3 <Enter> {lappend x "%W enter .b.f3"}
  195.     set x {}
  196.     testevent .b.f Enter
  197.     destroy .b.f3
  198.     set x
  199. } {{.b.f enter .b.f} {.b.f enter .b.f3}}
  200. test bind-4.5 {TkBindEventProc procedure} {
  201.     # This tests memory allocation for objPtr;  it won't serve any useful
  202.     # purpose unless run with some sort of allocation checker turned on.
  203.     catch {destroy .b.f}
  204.     frame .b.f -class Test -width 150 -height 100
  205.     pack .b.f
  206.     update
  207.     bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z}
  208.     testevent .b.f Enter
  209. } {}
  210. bind all <Enter> {}
  211. bind Test <Enter> {}
  212. bind Toplevel <Enter> {}
  213. bind xyz <Enter> {}
  214. bind {a b} <Enter> {}
  215. bind .b <Enter> {}
  216.  
  217. test bind-5.1 {Tk_CreateBindingTable procedure} {
  218.     catch {destroy .b.c}
  219.     canvas .b.c
  220.     .b.c bind foo
  221. } {}
  222.  
  223. test bind-6.1 { Tk_DeleteBindTable procedure} {
  224.     catch {destroy .b.c}
  225.     canvas .b.c
  226.     .b.c bind foo <1> {string 1}
  227.     .b.c create rectangle 0 0 100 100
  228.     .b.c bind 1 <2> {string 2}
  229.     destroy .b.c
  230. } {}
  231.  
  232. test bind-7.1 {Tk_CreateBinding procedure} {
  233.     catch {destroy .b.c}
  234.     canvas .b.c
  235.     list [catch {.b.c bind foo <} msg] $msg
  236. } {1 {no event type or button # or keysym}}
  237. test bind-7.2 {Tk_CreateBinding procedure} {
  238.     catch {destroy .b.c}
  239.     canvas .b.c
  240.     .b.c bind foo <1> "button 1"
  241.     .b.c bind foo <1> "+more button 1"
  242.     .b.c bind foo <1>
  243. } {button 1
  244. more button 1}
  245. test bind-7.3 {Tk_CreateBinding procedure} {
  246.     catch {destroy .b.c}
  247.     canvas .b.c
  248.     .b.c bind foo <1> "+button 1"
  249.     .b.c bind foo <1>
  250. } {button 1}
  251.  
  252. test bind-8.1 {Tk_DeleteBinding procedure} {
  253.     catch {destroy .b.f}
  254.     frame .b.f -class Test -width 150 -height 100
  255.     list [catch {bind .b.f <} msg] $msg
  256. } {0 {}}
  257. test bind-8.2 {Tk_DeleteBinding procedure} {
  258.     catch {destroy .b.f}
  259.     frame .b.f -class Test -width 150 -height 100
  260.     foreach i {a b c d} {
  261.     bind .b.f $i "binding for $i"
  262.     }
  263.     set result {}
  264.     foreach i {b d a c} {
  265.     bind .b.f $i {}
  266.     lappend result [lsort [bind .b.f]]
  267.     }
  268.     set result
  269. } {{a c d} {a c} c {}}
  270. test bind-8.3 {Tk_DeleteBinding procedure} {
  271.     catch {destroy .b.f}
  272.     frame .b.f -class Test -width 150 -height 100
  273.     foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} {
  274.     bind .b.f $i "binding for $i"
  275.     }
  276.     set result {}
  277.     foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} {
  278.     bind .b.f $i {}
  279.     lappend result [lsort [bind .b.f]]
  280.     }
  281.     set result
  282. } {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
  283.  
  284. test bind-9.1 {Tk_GetBinding procedure} {
  285.     catch {destroy .b.c}
  286.     canvas .b.c
  287.     list [catch {.b.c bind foo <} msg] $msg
  288. } {1 {no event type or button # or keysym}}
  289. test bind-9.2 {Tk_GetBinding procedure} {
  290.     catch {destroy .b.c}
  291.     canvas .b.c
  292.     .b.c bind foo a Test
  293.     .b.c bind foo a
  294. } {Test}
  295.  
  296. test bind-10.1 {Tk_GetAllBindings procedure} {
  297.     catch {destroy .b.f}
  298.     frame .b.f -class Test -width 150 -height 100
  299.     foreach i "! a \\\{ ~ <Delete> <space> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" {
  300.     bind .b.f $i Test
  301.     }
  302.     lsort [bind .b.f]
  303. } {! <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~}
  304. test bind-10.2 {Tk_GetAllBindings procedure} {
  305.     catch {destroy .b.f}
  306.     frame .b.f -class Test -width 150 -height 100
  307.     foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" {
  308.     bind .b.f $i Test
  309.     }
  310.     lsort [bind .b.f]
  311. } {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>}
  312. test bind-10.3 {Tk_GetAllBindings procedure} {
  313.     catch {destroy .b.f}
  314.     frame .b.f -class Test -width 150 -height 100
  315.     foreach i "<Double-Triple-1> abcd a<Leave>b" {
  316.     bind .b.f $i Test
  317.     }
  318.     lsort [bind .b.f]
  319. } {<Triple-Button-1> a<Leave>b abcd}
  320.  
  321. test bind-11.1 {Tk_DeleteAllBindings procedure} {
  322.     catch {destroy .b.f}
  323.     frame .b.f -class Test -width 150 -height 100
  324.     destroy .b.f
  325. } {}
  326. test bind-11.2 {Tk_DeleteAllBindings procedure} {
  327.     catch {destroy .b.f}
  328.     frame .b.f -class Test -width 150 -height 100
  329.     foreach i "a b c <Meta-1> <Alt-a> <Control-a>" {
  330.     bind .b.f $i x
  331.     }
  332.     destroy .b.f
  333. } {}
  334.  
  335. bind Test <KeyPress> {lappend x "%W %K Test press any"}
  336. bind all <KeyPress> {lappend x "%W %K all press any"}
  337. bind Test a {lappend x "%W %K Test press a"}
  338. bind all x {lappend x "%W %K all press x"}
  339. test bind-12.1 {Tk_BindEvent procedure} {
  340.     setup
  341.     bind .b.f a {lappend x "%W %K .b.f press a"}
  342.     set x {}
  343.     testevent .b.f KeyPress -keysym a
  344.     testevent .b.f KeyPress -keysym b
  345.     testevent .b.f KeyPress -keysym x
  346.     set x
  347. } {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}}
  348. bind Test <KeyPress> {lappend x "%W %K Test press any"; break}
  349. bind all <KeyPress> {continue; lappend x "%W %K all press any"}
  350. test bind-12.2 {Tk_BindEvent procedure} {
  351.     setup
  352.     bind .b.f b {lappend x "%W %K .b.f press a"}
  353.     set x {}
  354.     testevent .b.f KeyPress -keysym b
  355.     set x
  356. } {{.b.f b .b.f press a} {.b.f b Test press any}}
  357. if {[info procs tkerror] == "tkerror"} {
  358.     rename tkerror {}
  359. }
  360. proc tkerror args {}
  361. bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test}
  362. test bind-12.3 {Tk_BindEvent procedure} {
  363.     setup
  364.     bind .b.f b {lappend x "%W %K .b.f press a"}
  365.     set x {}
  366.     testevent .b.f KeyPress -keysym b
  367.     update
  368.     list $x $errorInfo
  369. } {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test
  370.     while executing
  371. "error Test"
  372.     (command bound to event)}}
  373. rename tkerror {}
  374. test bind-12.4 {Tk_BindEvent procedure} {
  375.     proc foo {} {
  376.     set x 44
  377.     testevent .b.f KeyPress -keysym a
  378.     }
  379.     setup
  380.     bind .b.f a {lappend x "%W %K .b.f press a"}
  381.     set x {}
  382.     foo
  383.     set x
  384. } {{.b.f a .b.f press a} {.b.f a Test press a}}
  385. test bind-12.5 {Tk_BindEvent procedure} {
  386.     bind all <Destroy> {lappend x "%W destroyed"}
  387.     set x {}
  388.     list [catch {frame .b.g -gorp foo} msg] $msg $x
  389. } {1 {unknown option "-gorp"} {{.b.g destroyed}}}
  390. foreach i [bind all] {
  391.     bind all $i {}
  392. }
  393. foreach i [bind Test] {
  394.     bind all $i {}
  395. }
  396. test bind-12.6 {Tk_BindEvent procedure} {
  397.     setup
  398.     bind .b.f z {lappend x "%W z (.b.f binding)"}
  399.     bind Test z {lappend x "%W z (.b.f binding)"}
  400.     bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"}
  401.     set x {}
  402.     testevent .b.f KeyPress -keysym z
  403.     set x
  404. } {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
  405. test bind-12.7 {Tk_BindEvent procedure} {
  406.     setup
  407.     bind .b.f z {lappend x "%W z (.b.f binding)"}
  408.     bind Test z {lappend x "%W z (.b.f binding)"}
  409.     bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"}
  410.     set x {}
  411.     testevent .b.f KeyPress -keysym z
  412.     set x
  413. } {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
  414. test bind-12.8 {Tk_BindEvent procedure} {
  415.     setup
  416.     bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"}
  417.     bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"}
  418.     set x {}
  419.     testevent .b.f ButtonPress -button 1
  420.     testevent .b.f ButtonPress -button 2
  421.     set x
  422. } {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}}
  423.  
  424. test bind-13.1 {FindSequence procedure} {
  425.     list [catch {bind .b {} test} msg] $msg
  426. } {1 {no events specified in binding}}
  427. test bind-13.2 {FindSequence procedure} {
  428.     list [catch {bind .b \x7 test} msg] $msg
  429. } {1 {bad ASCII character 0x7}}
  430. test bind-13.3 {FindSequence procedure} {
  431.     list [catch {bind .b "\x7f" test} msg] $msg
  432. } {1 {bad ASCII character 0x7f}}
  433. test bind-13.4 {FindSequence procedure} {
  434.     list [catch {bind .b "\xc4" test} msg] $msg
  435. } {1 {bad ASCII character 0xc4}}
  436. test bind-13.5 {FindSequence procedure} {
  437.     list [catch {bind .b <> test} msg] $msg
  438. } {1 {no event type or button # or keysym}}
  439. test bind-13.6 {FindSequence procedure} {
  440.     catch {destroy .b.f}
  441.     frame .b.f -class Test -width 150 -height 100
  442.     bind .b.f <a---> {nothing}
  443.     bind .b.f
  444. } a
  445. test bind-13.7 {FindSequence procedure} {
  446.     list [catch {bind .b <a-- test} msg] $msg
  447. } {1 {missing ">" in binding}}
  448. test bind-13.8 {FindSequence procedure, multiple bindings} {
  449.     setup
  450.     bind .b.f <1> {lappend x single}
  451.     bind .b.f <Double-1> {lappend x double}
  452.     bind .b.f <Triple-1> {lappend x triple}
  453.     set x press
  454.     testevent .b.f ButtonPress -button 1
  455.     lappend x press
  456.     testevent .b.f ButtonPress -button 1
  457.     lappend x press
  458.     testevent .b.f ButtonPress -button 1
  459.     lappend x press
  460.     testevent .b.f ButtonPress -button 1
  461.     set x
  462. } {press single press double press triple press triple}
  463.  
  464. set i 1
  465. foreach check {
  466.     {{<Control- a>} <Control-Key-a>}
  467.     {<Shift-a> <Shift-Key-a>}
  468.     {<Lock-a> <Lock-Key-a>}
  469.     {<Meta---a> <Meta-Key-a>}
  470.     {<M-a> <Meta-Key-a>}
  471.     {<Alt-a> <Alt-Key-a>}
  472.     {<B1-a> <B1-Key-a>}
  473.     {<B2-a> <B2-Key-a>}
  474.     {<B3-a> <B3-Key-a>}
  475.     {<B4-a> <B4-Key-a>}
  476.     {<B5-a> <B5-Key-a>}
  477.     {<Button1-a> <B1-Key-a>}
  478.     {<Button2-a> <B2-Key-a>}
  479.     {<Button3-a> <B3-Key-a>}
  480.     {<Button4-a> <B4-Key-a>}
  481.     {<Button5-a> <B5-Key-a>}
  482.     {<M1-a> <Mod1-Key-a>}
  483.     {<M2-a> <Mod2-Key-a>}
  484.     {<M3-a> <Mod3-Key-a>}
  485.     {<M4-a> <Mod4-Key-a>}
  486.     {<M5-a> <Mod5-Key-a>}
  487.     {<Mod1-a> <Mod1-Key-a>}
  488.     {<Mod2-a> <Mod2-Key-a>}
  489.     {<Mod3-a> <Mod3-Key-a>}
  490.     {<Mod4-a> <Mod4-Key-a>}
  491.     {<Mod5-a> <Mod5-Key-a>}
  492.     {<Double-a> aa}
  493.     {<Triple-a> aaa}
  494.     {{<Double 1>} <Double-Button-1>}
  495.     {<Triple-1> <Triple-Button-1>}
  496.     {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
  497. } {
  498.     test bind-13.$i {modifier names} {
  499.     catch {destroy .b.f}
  500.     frame .b.f -class Test -width 150 -height 100
  501.     bind .b.f [lindex $check 0] foo
  502.     bind .b.f
  503.     } [lindex $check 1]
  504.     bind .b.f [lindex $check 1] {}
  505.     incr i
  506. }
  507.  
  508. foreach event [bind Test] {
  509.     bind Test $event {}
  510. }
  511. foreach event [bind all] {
  512.     bind all $event {}
  513. }
  514. test bind-14.1 {event names} {
  515.     catch {destroy .b.f}
  516.     frame .b.f -class Test -width 150 -height 100
  517.     bind .b.f <FocusIn> {nothing}
  518.     bind .b.f
  519. } <FocusIn>
  520. test bind-14.2 {event names} {
  521.     catch {destroy .b.f}
  522.     frame .b.f -class Test -width 150 -height 100
  523.     bind .b.f <FocusOut> {nothing}
  524.     bind .b.f
  525. } <FocusOut>
  526. test bind-14.3 {event names} {
  527.     setup
  528.     bind .b.f <Destroy> {lappend x "destroyed"}
  529.     set x [bind .b.f]
  530.     destroy .b.f
  531.     set x
  532. } {<Destroy> destroyed}
  533. set i 4
  534. foreach check { 
  535.     {Motion Motion}
  536.     {Button Button}
  537.     {ButtonPress Button}
  538.     {ButtonRelease ButtonRelease}
  539.     {Colormap Colormap}
  540.     {Enter Enter}
  541.     {Leave Leave}
  542.     {Expose Expose}
  543.     {Key Key}
  544.     {KeyPress Key}
  545.     {KeyRelease KeyRelease}
  546.     {Property Property}
  547.     {Circulate Circulate}
  548.     {Configure Configure}
  549.     {Gravity Gravity}
  550.     {Map Map}
  551.     {Reparent Reparent}
  552.     {Unmap Unmap}
  553.     {Visibility Visibility}
  554. } {
  555.     set event [lindex $check 0]
  556.     test bind-14.$i {event names} {
  557.     setup
  558.     bind .b.f <$event> "set x \"event $event\""
  559.     set x xyzzy
  560.     testevent .b.f $event -window .b.f
  561.     list $x [bind .b.f]
  562.     } [list "event $event" <[lindex $check 1]>]
  563.     incr i
  564. }
  565.  
  566. test bind-15.1 {button names} {
  567.     list [catch {bind .b <Expose-1> foo} msg] $msg
  568. } {1 {specified button "1" for non-button event}}
  569. test bind-16.1 {button names} {
  570.     list [catch {bind .b <Button-6> foo} msg] $msg
  571. } {1 {specified keysym "6" for non-key event}}
  572. set i 2
  573. foreach button {1 2 3 4 5} {
  574.     test bind-15.$i {button names} {
  575.     setup
  576.     bind .b.f <Button-$button> "lappend x \"button $button\""
  577.     set x [bind .b.f]
  578.     testevent .b.f ButtonPress -button $button
  579.     set x
  580.     } [list <Button-$button> "button $button"]
  581.     incr i
  582. }
  583.  
  584. test bind-17.1 {keysym names} {
  585.     list [catch {bind .b <Expose-a> foo} msg] $msg
  586. } {1 {specified keysym "a" for non-key event}}
  587. test bind-17.2 {keysym names} {
  588.     list [catch {bind .b <Gorp> foo} msg] $msg
  589. } {1 {bad event type or keysym "Gorp"}}
  590. test bind-17.3 {keysym names} {
  591.     list [catch {bind .b <Key-Stupid> foo} msg] $msg
  592. } {1 {bad event type or keysym "Stupid"}}
  593. test bind-17.4 {keysym names} {
  594.     catch {destroy .b.f}
  595.     frame .b.f -class Test -width 150 -height 100
  596.     bind .b.f <a> foo
  597.     bind .b.f
  598. } a
  599. set i 5
  600. foreach check {
  601.     {a 0 a}
  602.     {space 0 <Key-space>}
  603.     {Return 0 <Key-Return>}
  604.     {X 1 X}
  605. } {
  606.     set keysym [lindex $check 0]
  607.     test bind-16.$i {keysym names} {
  608.     setup
  609.     bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\""
  610.     bind .b.f <Key-x> "lappend x {bad binding match}"
  611.     set x [lsort [bind .b.f]]
  612.     testevent .b.f Key -keysym $keysym -state [lindex $check 1]
  613.     set x
  614.     } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
  615.     incr i
  616. }
  617.  
  618. if $doNonPortableTests {
  619.     setup
  620.     bind .b.f <KeyPress> {set x %K}
  621.     set i 1
  622.     foreach check {
  623.     {a 0 a}
  624.     {x 1 X}
  625.     {x 2 X}
  626.     {space 0 space}
  627.     {F1 1 F1}
  628.     } {
  629.     test bind-17.$i {GetKeySym procedure} {
  630.         set x nothing
  631.         testevent .b.f KeyPress -keysym [lindex $check 0] \
  632.             -state [lindex $check 1]
  633.         set x
  634.     } [lindex $check 2]
  635.     incr i
  636.     }
  637. }
  638.  
  639. test bind-18.1 {MatchPatterns procedure, ignoring type mismatches} {
  640.     setup
  641.     bind .b.f ab {set x 1}
  642.     set x 0
  643.     testevent .b.f Key -keysym a
  644.     testevent .b.f KeyRelease -keysym a
  645.     testevent .b.f Key -keysym b
  646.     testevent .b.f KeyRelease -keysym b
  647.     set x
  648. } 1
  649. test bind-18.2 {MatchPatterns procedure, ignoring type mismatches} {
  650.     setup
  651.     bind .b.f ab {set x 1}
  652.     set x 0
  653.     testevent .b.f Key -keysym a
  654.     testevent .b.f Enter
  655.     testevent .b.f KeyRelease -keysym a
  656.     testevent .b.f Leave
  657.     testevent .b.f Key -keysym b
  658.     testevent .b.f KeyRelease -keysym b
  659.     set x
  660. } 1
  661. test bind-18.3 {MatchPatterns procedure, ignoring type mismatches} {
  662.     setup
  663.     bind .b.f ab {set x 1}
  664.     set x 0
  665.     testevent .b.f Key -keysym a
  666.     testevent .b.f ButtonPress -button 1
  667.     testevent .b.f Key -keysym b
  668.     set x
  669. } 0
  670. test bind-18.4 {MatchPatterns procedure, ignoring type mismatches} {
  671.     setup
  672.     bind .b.f <Double-1> {set x 1}
  673.     set x 0
  674.     testevent .b.f ButtonPress -button 1
  675.     testevent .b.f ButtonRelease -button 1
  676.     testevent .b.f ButtonPress -button 1
  677.     testevent .b.f ButtonRelease -button 1
  678.     set x
  679. } 1
  680. test bind-18.5 {MatchPatterns procedure, ignoring type mismatches} {
  681.     setup
  682.     bind .b.f <Double-ButtonRelease> {set x 1}
  683.     set x 0
  684.     testevent .b.f ButtonPress -button 1
  685.     testevent .b.f ButtonRelease -button 1
  686.     testevent .b.f ButtonPress -button 2
  687.     testevent .b.f ButtonRelease -button 2
  688.     set x
  689. } 1
  690. test bind-18.6 {MatchPatterns procedure, ignoring type mismatches} {
  691.     setup
  692.     bind .b.f <Double-1> {set x 1}
  693.     set x 0
  694.     testevent .b.f ButtonPress -button 1
  695.     testevent .b.f Key -keysym a
  696.     testevent .b.f ButtonRelease -button 1
  697.     testevent .b.f ButtonPress -button 1
  698.     testevent .b.f ButtonRelease -button 1
  699.     set x
  700. } 0
  701. test bind-18.7 {MatchPatterns procedure, ignoring type mismatches} {
  702.     setup
  703.     bind .b.f <Double-1> {set x 1}
  704.     set x 0
  705.     testevent .b.f ButtonPress -button 1
  706.     testevent .b.f Key -keysym Shift_L
  707.     testevent .b.f ButtonRelease -button 1
  708.     testevent .b.f ButtonPress -button 1
  709.     testevent .b.f ButtonRelease -button 1
  710.     set x
  711. } 1
  712. test bind-18.8 {MatchPatterns procedure, ignoring type mismatches} {
  713.     setup
  714.     bind .b.f ab {set x 1}
  715.     set x 0
  716.     testevent .b.f Key -keysym a
  717.     testevent .b.f Key -keysym c
  718.     testevent .b.f Key -keysym b
  719.     set x
  720. } 0
  721. test bind-18.9 {MatchPatterns procedure, modifier checks} {
  722.     setup
  723.     bind .b.f <M1-M2-Key> {set x 1}
  724.     set x 0
  725.     testevent .b.f Key -keysym a -state 0x18
  726.     set x
  727. } 1
  728. test bind-18.10 {MatchPatterns procedure, modifier checks} {
  729.     setup
  730.     bind .b.f <M1-M2-Key> {set x 1}
  731.     set x 0
  732.     testevent .b.f Key -keysym a -state 0xfc
  733.     set x
  734. } 1
  735. test bind-18.11 {MatchPatterns procedure, modifier checks} {
  736.     setup
  737.     bind .b.f <M1-M2-Key> {set x 1}
  738.     set x 0
  739.     testevent .b.f Key -keysym a -state 0x8
  740.     set x
  741. } 0
  742. test bind-18.12 {MatchPatterns procedure, ignore modifier presses and releases} {
  743.     setup
  744.     bind .b.f aB {set x 1}
  745.     set x 0
  746.     testevent .b.f Key -keysym a
  747.     testevent .b.f Key -keysym Shift_L
  748.     testevent .b.f Key -keysym b -state 1
  749.     set x
  750. } 1
  751. test bind-18.13 {MatchPatterns procedure, checking detail} {
  752.     setup
  753.     bind .b.f ab {set x 1}
  754.     set x 0
  755.     testevent .b.f Key -keysym a
  756.     testevent .b.f Key -keysym c
  757.     set x
  758. } 0
  759. test bind-18.14 {MatchPatterns procedure, checking "nearby"} {
  760.     setup
  761.     bind .b.f <Double-1> {set x 1}
  762.     set x 0
  763.     testevent .b.f Button -button 1 -x 30 -y 40
  764.     testevent .b.f Button -button 1 -x 31 -y 39
  765.     set x
  766. } 1
  767. test bind-18.15 {MatchPatterns procedure, checking "nearby"} {
  768.     setup
  769.     bind .b.f <Double-1> {set x 1}
  770.     set x 0
  771.     testevent .b.f Button -button 1 -x 30 -y 40
  772.     testevent .b.f Button -button 1 -x 29 -y 41
  773.     set x
  774. } 1
  775. test bind-18.16 {MatchPatterns procedure, checking "nearby"} {
  776.     setup
  777.     bind .b.f <Double-1> {set x 1}
  778.     set x 0
  779.     testevent .b.f Button -button 1 -x 30 -y 40
  780.     testevent .b.f Button -button 1 -x 40 -y 40
  781.     set x
  782. } 0
  783. test bind-18.17 {MatchPatterns procedure, checking "nearby"} {
  784.     setup
  785.     bind .b.f <Double-1> {set x 1}
  786.     set x 0
  787.     testevent .b.f Button -button 1 -x 30 -y 40
  788.     testevent .b.f Button -button 1 -x 20 -y 40
  789.     set x
  790. } 0
  791. test bind-18.18 {MatchPatterns procedure, checking "nearby"} {
  792.     setup
  793.     bind .b.f <Double-1> {set x 1}
  794.     set x 0
  795.     testevent .b.f Button -button 1 -x 30 -y 40
  796.     testevent .b.f Button -button 1 -x 30 -y 30
  797.     set x
  798. } 0
  799. test bind-18.19 {MatchPatterns procedure, checking "nearby"} {
  800.     setup
  801.     bind .b.f <Double-1> {set x 1}
  802.     set x 0
  803.     testevent .b.f Button -button 1 -x 30 -y 40
  804.     testevent .b.f Button -button 1 -x 30 -y 50
  805.     set x
  806. } 0
  807. test bind-18.20 {MatchPatterns procedure, checking "nearby"} {
  808.     setup
  809.     bind .b.f <Double-1> {set x 1}
  810.     set x 0
  811.     testevent .b.f Button -button 1 -time 300
  812.     testevent .b.f Button -button 1 -time 700
  813.     set x
  814. } 1
  815. test bind-18.21 {MatchPatterns procedure, checking "nearby"} {
  816.     setup
  817.     bind .b.f <Double-1> {set x 1}
  818.     set x 0
  819.     testevent .b.f Button -button 1 -time 300
  820.     testevent .b.f Button -button 1 -time 900
  821.     set x
  822. } 0
  823. test bind-18.22 {MatchPatterns procedure, time wrap-around} {
  824.     setup
  825.     bind .b.f <Double-1> {set x 1}
  826.     set x 0
  827.     testevent .b.f Button -button 1 -time [expr -100]
  828.     testevent .b.f Button -button 1 -time 200
  829.     set x
  830. } 1
  831. test bind-18.23 {MatchPatterns procedure, time wrap-around} {
  832.     setup
  833.     bind .b.f <Double-1> {set x 1}
  834.     set x 0
  835.     testevent .b.f Button -button 1 -time [expr -100]
  836.     testevent .b.f Button -button 1 -time 500
  837.     set x
  838. } 0
  839. test bind-18.24 {MatchPatterns procedure, conflict resolution} {
  840.     setup
  841.     bind .b.f <KeyPress> {set x 0}
  842.     bind .b.f a {set x 1}
  843.     set x none
  844.     testevent .b.f Key -keysym a
  845.     set x
  846. } 1
  847. test bind-18.25 {MatchPatterns procedure, conflict resolution} {
  848.     setup
  849.     bind .b.f <KeyPress> {set x 0}
  850.     bind .b.f a {set x 1}
  851.     set x none
  852.     testevent .b.f Key -keysym b
  853.     set x
  854. } 0
  855. test bind-18.26 {MatchPatterns procedure, conflict resolution} {
  856.     setup
  857.     bind .b.f <KeyPress> {lappend x 0}
  858.     bind .b.f a {lappend x 1}
  859.     bind .b.f ba {lappend x 2}
  860.     set x none
  861.     testevent .b.f Key -keysym b
  862.     testevent .b.f KeyRelease -keysym b
  863.     testevent .b.f Key -keysym a
  864.     set x
  865. } {none 0 2}
  866. test bind-18.27 {MatchPatterns procedure, conflict resolution} {
  867.     setup
  868.     bind .b.f <ButtonPress> {set x 0}
  869.     bind .b.f <1> {set x 1}
  870.     set x none
  871.     testevent .b.f Button -button 1
  872.     set x
  873. } 1
  874. test bind-18.28 {MatchPatterns procedure, conflict resolution} {
  875.     setup
  876.     bind .b.f <M1-Key> {set x 0}
  877.     bind .b.f <M2-Key> {set x 1}
  878.     set x none
  879.     testevent .b.f Key -keysym a -state 0x18
  880.     set x
  881. } 1
  882. test bind-18.29 {MatchPatterns procedure, conflict resolution} {
  883.     setup
  884.     bind .b.f <M2-Key> {set x 0}
  885.     bind .b.f <M1-Key> {set x 1}
  886.     set x none
  887.     testevent .b.f Key -keysym a -state 0x18
  888.     set x
  889. } 1
  890. test bind-18.30 {MatchPatterns procedure, conflict resolution} {
  891.     setup
  892.     bind .b.f <1> {lappend x single}
  893.     bind Test <1> {lappend x single(Test)}
  894.     bind Test <Double-1> {lappend x double(Test)}
  895.     set x {}
  896.     testevent .b.f ButtonPress -button 1
  897.     testevent .b.f ButtonPress -button 1
  898.     testevent .b.f ButtonPress -button 1
  899.     set x
  900. } {single single(Test) single double(Test) single double(Test)}
  901. foreach i [bind Test] {
  902.     bind Test $i {}
  903. }
  904.  
  905. test bind-19.1 {ExpandPercents procedure} {
  906.     setup
  907.     bind .b.f <Enter> {set x abcd}
  908.     set x none
  909.     testevent .b.f Enter
  910.     set x
  911. } abcd
  912. test bind-19.2 {ExpandPercents procedure} {
  913.     setup
  914.     bind .b.f <Enter> {set x %#}
  915.     set x none
  916.     testevent .b.f Enter -serial 1234
  917.     set x
  918. } 1234
  919. test bind-19.3 {ExpandPercents procedure} {
  920.     setup
  921.     bind .b.f <Configure> {set x %a}
  922.     set x none
  923.     testevent .b.f Configure -above .b -window .b.f
  924.     set x
  925. } [winfo id .b]
  926. test bind-19.4 {ExpandPercents procedure} {
  927.     setup
  928.     bind .b.f <Button> {set x %b}
  929.     set x none
  930.     testevent .b.f Button -button 3
  931.     set x
  932. } 3
  933. test bind-19.5 {ExpandPercents procedure} {
  934.     setup
  935.     bind .b.f <Expose> {set x %c}
  936.     set x none
  937.     testevent .b.f Expose -count 47
  938.     set x
  939. } 47
  940. test bind-19.6 {ExpandPercents procedure} {
  941.     setup
  942.     bind .b.f <Enter> {set x %d}
  943.     set x none
  944.     testevent .b.f Enter -detail NotifyAncestor
  945.     set x
  946. } NotifyAncestor
  947. test bind-19.7 {ExpandPercents procedure} {
  948.     setup
  949.     bind .b.f <Enter> {set x %d}
  950.     set x none
  951.     testevent .b.f Enter -detail NotifyVirtual
  952.     set x
  953. } NotifyVirtual
  954. test bind-19.8 {ExpandPercents procedure} {
  955.     setup
  956.     bind .b.f <Enter> {set x %d}
  957.     set x none
  958.     testevent .b.f Enter -detail NotifyNonlinear
  959.     set x
  960. } NotifyNonlinear
  961. test bind-19.9 {ExpandPercents procedure} {
  962.     setup
  963.     bind .b.f <Enter> {set x %d}
  964.     set x none
  965.     testevent .b.f Enter -detail NotifyNonlinearVirtual
  966.     set x
  967. } NotifyNonlinearVirtual
  968. test bind-19.10 {ExpandPercents procedure} {
  969.     setup
  970.     bind .b.f <Enter> {set x %d}
  971.     set x none
  972.     testevent .b.f Enter -detail NotifyPointer
  973.     set x
  974. } NotifyPointer
  975. test bind-19.11 {ExpandPercents procedure} {
  976.     setup
  977.     bind .b.f <Enter> {set x %d}
  978.     set x none
  979.     testevent .b.f Enter -detail NotifyPointerRoot
  980.     set x
  981. } NotifyPointerRoot
  982. test bind-19.12 {ExpandPercents procedure} {
  983.     setup
  984.     bind .b.f <Enter> {set x %d}
  985.     set x none
  986.     testevent .b.f Enter -detail NotifyDetailNone
  987.     set x
  988. } NotifyDetailNone
  989. test bind-19.13 {ExpandPercents procedure} {
  990.     setup
  991.     bind .b.f <Enter> {set x %f}
  992.     set x none
  993.     testevent .b.f Enter -focus 1
  994.     set x
  995. } 1
  996. test bind-19.14 {ExpandPercents procedure} {
  997.     setup
  998.     bind .b.f <Expose> {set x "%x %y %w %h"}
  999.     set x none
  1000.     testevent .b.f Expose -x 24 -y 18 -width 147 -height 61
  1001.     set x
  1002. } {24 18 147 61}
  1003. test bind-19.15 {ExpandPercents procedure} {
  1004.     setup
  1005.     bind .b.f <Configure> {set x "%x %y %w %h"}
  1006.     set x none
  1007.     testevent .b.f Configure -x 24 -y 18 -width 147 -height 61 -window .b.f
  1008.     set x
  1009. } {24 18 147 61}
  1010. test bind-19.16 {ExpandPercents procedure} {
  1011.     setup
  1012.     bind .b.f <Key> {set x "%k"}
  1013.     set x none
  1014.     testevent .b.f Key -keycode 146
  1015.     set x
  1016. } 146
  1017. test bind-19.17 {ExpandPercents procedure} {
  1018.     setup
  1019.     bind .b.f <Enter> {set x "%m"}
  1020.     set x none
  1021.     testevent .b.f Enter -mode NotifyNormal
  1022.     set x
  1023. } NotifyNormal
  1024. test bind-19.18 {ExpandPercents procedure} {
  1025.     setup
  1026.     bind .b.f <Enter> {set x "%m"}
  1027.     set x none
  1028.     testevent .b.f Enter -mode NotifyGrab
  1029.     set x
  1030. } NotifyGrab
  1031. test bind-19.19 {ExpandPercents procedure} {
  1032.     setup
  1033.     bind .b.f <Enter> {set x "%m"}
  1034.     set x none
  1035.     testevent .b.f Enter -mode NotifyUngrab
  1036.     set x
  1037. } NotifyUngrab
  1038. test bind-19.20 {ExpandPercents procedure} {
  1039.     setup
  1040.     bind .b.f <Enter> {set x "%m"}
  1041.     set x none
  1042.     testevent .b.f Enter -mode NotifyWhileGrabbed
  1043.     set x
  1044. } NotifyWhileGrabbed
  1045. test bind-19.21 {ExpandPercents procedure} {
  1046.     setup
  1047.     bind .b.f <Map> {set x "%o"}
  1048.     set x none
  1049.     testevent .b.f Map -override 1 -window .b.f
  1050.     set x
  1051. } 1
  1052. test bind-19.22 {ExpandPercents procedure} {
  1053.     setup
  1054.     bind .b.f <Reparent> {set x "%o"}
  1055.     set x none
  1056.     testevent .b.f Reparent -override 13 -window .b.f
  1057.     set x
  1058. } 13
  1059. test bind-19.23 {ExpandPercents procedure} {
  1060.     setup
  1061.     bind .b.f <Configure> {set x "%o"}
  1062.     set x none
  1063.     testevent .b.f Configure -override 2 -window .b.f
  1064.     set x
  1065. } 2
  1066. test bind-19.24 {ExpandPercents procedure} {
  1067.     setup
  1068.     bind .b.f <Circulate> {set x "%p"}
  1069.     set x none
  1070.     testevent .b.f Circulate -place PlaceOnTop -window .b.f
  1071.     set x
  1072. } PlaceOnTop
  1073. test bind-19.25 {ExpandPercents procedure} {
  1074.     setup
  1075.     bind .b.f <Circulate> {set x "%p"}
  1076.     set x none
  1077.     testevent .b.f Circulate -place PlaceOnBottom -window .b.f
  1078.     set x
  1079. } PlaceOnBottom
  1080. test bind-19.26 {ExpandPercents procedure} {
  1081.     setup
  1082.     bind .b.f <Circulate> {set x "%p"}
  1083.     set x none
  1084.     testevent .b.f Circulate -place bogus -window .b.f
  1085.     set x
  1086. } ??
  1087. test bind-19.27 {ExpandPercents procedure} {
  1088.     setup
  1089.     bind .b.f <1> {set x "%s"}
  1090.     set x none
  1091.     testevent .b.f Button -button 1 -state 122
  1092.     set x
  1093. } 122
  1094. test bind-19.28 {ExpandPercents procedure} {
  1095.     setup
  1096.     bind .b.f <Enter> {set x "%s"}
  1097.     set x none
  1098.     testevent .b.f Enter -state 0x3ff
  1099.     set x
  1100. } 1023
  1101. test bind-19.29 {ExpandPercents procedure} {
  1102.     setup
  1103.     bind .b.f <Visibility> {set x "%s"}
  1104.     set x none
  1105.     testevent .b.f Visibility -state VisibilityPartiallyObscured
  1106.     set x
  1107. } VisibilityPartiallyObscured
  1108. test bind-19.30 {ExpandPercents procedure} {
  1109.     setup
  1110.     bind .b.f <Visibility> {set x "%s"}
  1111.     set x none
  1112.     testevent .b.f Visibility -state VisibilityUnobscured
  1113.     set x
  1114. } VisibilityUnobscured
  1115. test bind-19.31 {ExpandPercents procedure} {
  1116.     setup
  1117.     bind .b.f <Visibility> {set x "%s"}
  1118.     set x none
  1119.     testevent .b.f Visibility -state VisibilityFullyObscured
  1120.     set x
  1121. } VisibilityFullyObscured
  1122. test bind-19.32 {ExpandPercents procedure} {
  1123.     setup
  1124.     bind .b.f <Button> {set x "%t"}
  1125.     set x none
  1126.     testevent .b.f Button -time 4294
  1127.     set x
  1128. } 4294
  1129. test bind-19.33 {ExpandPercents procedure} {
  1130.     setup
  1131.     bind .b.f <Button> {set x "%x %y"}
  1132.     set x none
  1133.     testevent .b.f Button -x 881 -y 432
  1134.     set x
  1135. } {881 432}
  1136. test bind-19.34 {ExpandPercents procedure} {
  1137.     setup
  1138.     bind .b.f <Reparent> {set x "%x %y"}
  1139.     set x none
  1140.     testevent .b.f Reparent -x 882 -y 431 -window .b.f
  1141.     set x
  1142. } {882 431}
  1143. test bind-19.35 {ExpandPercents procedure} {
  1144.     setup
  1145.     bind .b.f <Enter> {set x "%x %y"}
  1146.     set x none
  1147.     testevent .b.f Enter -x 781 -y 632
  1148.     set x
  1149. } {781 632}
  1150. if $doNonPortableTests {
  1151.     test bind-19.36 {ExpandPercents procedure} {
  1152.     setup
  1153.     bind .b.f <Key> {lappend x "%A"}
  1154.     set x {}
  1155.     testevent .b.f Key -keysym a
  1156.     testevent .b.f Key -keysym A -state 1
  1157.     testevent .b.f Key -keysym Tab
  1158.     testevent .b.f Key -keysym Return
  1159.     testevent .b.f Key -keysym F1
  1160.     testevent .b.f Key -keysym Shift_L
  1161.     testevent .b.f Key -keysym space
  1162.     testevent .b.f Key -keysym dollar -state 1
  1163.     testevent .b.f Key -keysym braceleft -state 1
  1164.     set x
  1165.     } "a A {    } {\r} {{}} {{}} { } {\$} \\\{"
  1166. }
  1167. test bind-19.37 {ExpandPercents procedure} {
  1168.     setup
  1169.     bind .b.f <Configure> {set x "%B"}
  1170.     set x none
  1171.     testevent .b.f Configure -borderwidth 24 -window .b.f
  1172.     set x
  1173. } 24
  1174. test bind-19.38 {ExpandPercents procedure} {
  1175.     setup
  1176.     bind .b.f <Enter> {set x "%E"}
  1177.     set x none
  1178.     testevent .b.f Enter -sendevent 1
  1179.     set x
  1180. } 1
  1181. if $doNonPortableTests {
  1182.     test bind-19.39 {ExpandPercents procedure} {
  1183.     setup
  1184.     bind .b.f <Key> {lappend x %K}
  1185.     set x {}
  1186.     testevent .b.f Key -keysym a
  1187.     testevent .b.f Key -keysym A -state 1
  1188.     testevent .b.f Key -keysym Tab
  1189.     testevent .b.f Key -keysym F1
  1190.     testevent .b.f Key -keysym Shift_L
  1191.     testevent .b.f Key -keysym space
  1192.     testevent .b.f Key -keysym dollar -state 1
  1193.     testevent .b.f Key -keysym braceleft -state 1
  1194.     set x
  1195.     } {a A Tab F1 Shift_L space dollar braceleft}
  1196. }
  1197. test bind-19.40 {ExpandPercents procedure} {
  1198.     setup
  1199.     bind .b.f <Key> {set x "%N"}
  1200.     set x none
  1201.     testevent .b.f Key -keysym a
  1202.     set x
  1203. } 97
  1204. test bind-19.41 {ExpandPercents procedure} {
  1205.     setup
  1206.     bind .b.f <Key> {set x "%S"}
  1207.     set x none
  1208.     testevent .b.f Key -keysym a -subwindow .b
  1209.     set x
  1210. } [winfo id .b]
  1211. test bind-19.42 {ExpandPercents procedure} {
  1212.     setup
  1213.     bind .b.f <Key> {set x "%T"}
  1214.     set x none
  1215.     testevent .b.f Key
  1216.     set x
  1217. } 2
  1218. test bind-19.43 {ExpandPercents procedure} {
  1219.     setup
  1220.     bind .b.f <Key> {set x "%W"}
  1221.     set x none
  1222.     testevent .b.f Key
  1223.     set x
  1224. } .b.f
  1225. test bind-19.44 {ExpandPercents procedure} {
  1226.     setup
  1227.     bind .b.f <Button> {set x "%X %Y"}
  1228.     set x none
  1229.     testevent .b.f Button -rootx 422 -rooty 13
  1230.     set x
  1231. } {422 13}
  1232.  
  1233. proc tkerror msg {
  1234.     global x errorInfo
  1235.     set x [list $msg $errorInfo]
  1236. }
  1237. test bind-20.1 {Tk_BackgroundError procedure} {
  1238.     setup
  1239.     bind .b.f <Button> {error "This is a test"}
  1240.     set x none
  1241.     testevent .b.f Button
  1242.     update
  1243.     set x
  1244. } {{This is a test} {This is a test
  1245.     while executing
  1246. "error "This is a test""
  1247.     (command bound to event)}}
  1248. test bind-20.2 {Tk_BackgroundError procedure} {
  1249.     proc do {} {
  1250.     testevent .b.f Button
  1251.     }
  1252.     setup
  1253.     bind .b.f <Button> {error Message2}
  1254.     set x none
  1255.     do
  1256.     update
  1257.     set x
  1258. } {Message2 {Message2
  1259.     while executing
  1260. "error Message2"
  1261.     (command bound to event)}}
  1262. rename tkerror {}
  1263.  
  1264. destroy .b
  1265.